diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md index 48085ccba8..7a137bbb85 100644 --- a/.github/PULL_REQUEST_TEMPLATE.md +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -14,18 +14,16 @@ **Additional supporting information** +**Generative AI usage** + + **Test results, if applicable** - - +- [ ] r-test branch merging required diff --git a/.github/scripts/build_windows_executables.bat b/.github/scripts/build_windows_executables.bat index 3d4efe2846..d93c3ac5e8 100644 --- a/.github/scripts/build_windows_executables.bat +++ b/.github/scripts/build_windows_executables.bat @@ -35,6 +35,7 @@ devenv vs-build/TurbSim/TurbSim.vfproj /Build "Release|x64" devenv vs-build/UnsteadyAero/UnsteadyAero.sln /Build "Release|x64" @REM Build MATLAB solution last +rd /s /q .\build\lib devenv vs-build/FAST/FAST.sln /Build "Release_Matlab|x64" @REM Copy controllers to bin directory diff --git a/.github/workflows/automated-dev-tests.yml b/.github/workflows/automated-dev-tests.yml index 401d57bd23..4920d86cea 100644 --- a/.github/workflows/automated-dev-tests.yml +++ b/.github/workflows/automated-dev-tests.yml @@ -368,10 +368,12 @@ jobs: path: | ${{github.workspace}}/build/reg_tests/glue-codes/openfast-cpp ${{github.workspace}}/build/reg_tests/glue-codes/python + ${{github.workspace}}/build/reg_tests/glue-codes/other ${{github.workspace}}/build/reg_tests/modules/aerodyn ${{github.workspace}}/build/reg_tests/modules/moordyn ${{github.workspace}}/build/reg_tests/modules/inflowwind ${{github.workspace}}/build/reg_tests/modules/hydrodyn + ${{github.workspace}}/build/reg_tests/modules/seastate !${{github.workspace}}/build/reg_tests/glue-codes/openfast-cpp/5MW_Baseline diff --git a/.github/workflows/deploy.yml b/.github/workflows/deploy.yml index a7819ab029..94a795b802 100644 --- a/.github/workflows/deploy.yml +++ b/.github/workflows/deploy.yml @@ -149,30 +149,15 @@ jobs: shell: cmd run: .github/scripts/windows_devenv_test.bat - - name: Install Intel oneAPI BaseKit (Windows) + - name: Install Intel oneAPI Fortran Essentials (Windows) shell: cmd env: - URL: https://registrationcenter-download.intel.com/akdlm/IRC_NAS/7dff44ba-e3af-4448-841c-0d616c8da6e7/w_BaseKit_p_2024.1.0.595_offline.exe - COMPONENTS: intel.oneapi.win.mkl.devel + URL: https://registrationcenter-download.intel.com/akdlm/IRC_NAS/b626b5cf-8a15-40a4-be9a-9edabbb7cf17/intel-fortran-essentials-2025.3.0.333_offline.exe run: | curl.exe --output %TEMP%\webimage.exe --url %URL% --retry 5 --retry-delay 5 start /b /wait %TEMP%\webimage.exe -s -x -f webimage_extracted --log extract.log del %TEMP%\webimage.exe - webimage_extracted\bootstrapper.exe -s --action install --components=%COMPONENTS% --eula=accept -p=NEED_VS2017_INTEGRATION=0 -p=NEED_VS2019_INTEGRATION=0 -p=NEED_VS2022_INTEGRATION=1 --log-dir=. - set installer_exit_code=%ERRORLEVEL% - rd /s/q "webimage_extracted" - exit /b %installer_exit_code% - - - name: Install Intel oneAPI HPCKit (Windows) - shell: cmd - env: - URL: https://registrationcenter-download.intel.com/akdlm/IRC_NAS/c95a3b26-fc45-496c-833b-df08b10297b9/w_HPCKit_p_2024.1.0.561_offline.exe - COMPONENTS: intel.oneapi.win.ifort-compiler - run: | - curl.exe --output %TEMP%\webimage.exe --url %URL% --retry 5 --retry-delay 5 - start /b /wait %TEMP%\webimage.exe -s -x -f webimage_extracted --log extract.log - del %TEMP%\webimage.exe - webimage_extracted\bootstrapper.exe -s --action install --components=%COMPONENTS% --eula=accept -p=NEED_VS2017_INTEGRATION=0 -p=NEED_VS2019_INTEGRATION=0 -p=NEED_VS2022_INTEGRATION=1 --log-dir=. + webimage_extracted\bootstrapper.exe -s --action install --eula=accept -p=NEED_VS2017_INTEGRATION=0 -p=NEED_VS2019_INTEGRATION=0 -p=NEED_VS2022_INTEGRATION=1 --log-dir=. set installer_exit_code=%ERRORLEVEL% rd /s/q "webimage_extracted" exit /b %installer_exit_code% diff --git a/CMakeLists.txt b/CMakeLists.txt index b7de977d57..f0b92ff991 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -125,6 +125,11 @@ if (OPENMP) set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} ${OpenMP_CXX_FLAGS}") link_libraries("${OpenMP_CXX_LIBRARIES}") endif() +elseif (NOT BLA_VENDOR) + # If we're not using OpenMP, and a specific BLAS vendor has not been set, + # set MKL threading to sequential to avoid potential issues with + # small calculations taking longer due to threading overhead (turbsim). + set(MKL_THREADING "sequential") endif() #------------------------------------------------------------------------------- diff --git a/README.rst b/README.rst index f63e070680..6787bf7a10 100644 --- a/README.rst +++ b/README.rst @@ -16,7 +16,7 @@ OpenFAST is a wind turbine simulation tool which builds on FAST v8. FAST.Farm extends the capability of OpenFAST to simulate multi-turbine wind farms. They were created with the goal of being community models developed and used by research laboratories, academia, and industry. They are managed by a dedicated team at the -National Renewable Energy Lab. Our objective is to ensure that OpenFAST and FAST.Farm +National Laboratory of the Rockies. Our objective is to ensure that OpenFAST and FAST.Farm are sustainable software that are well tested and well documented. If you'd like to contribute, see the `Developer Documentation `_ and any open GitHub issues with the @@ -30,11 +30,11 @@ tag. Part of the WETO Stack ---------------------- -OpenFAST is primarily developed with the support of the U.S. Department of Energy and is part of the `WETO Software Stack `_. For more information and other integrated modeling software, see: +OpenFAST is primarily developed with the support of the U.S. Department of Energy and is part of the `WETO Software Stack `_. For more information and other integrated modeling software, see: -* `Portfolio Overview `_ -* `Entry Guide `_ -* `OpenFAST Workshop `_ +* `Portfolio Overview `_ +* `Entry Guide `_ +* `OpenFAST Workshop `_ FAST v8 - OpenFAST @@ -155,8 +155,8 @@ Please use `GitHub Issues `_ to: * report bugs * request code enhancements -Users and developers may also be interested in the NREL National Wind -Technology Center (NWTC) `phpBB Forum `_, +Users and developers may also be interested in the NLR National Wind +Technology Center (NWTC) `Forum `_, which is still maintained and has a long history of FAST-related questions and answers. @@ -164,9 +164,9 @@ Acknowledgments --------------- OpenFAST and FAST.Farm are maintained and developed by researchers and software -engineers at the `National Renewable Energy Laboratory `_ -(NREL), with support from the US Department of Energy's Wind Energy Technology -Office. NREL gratefully acknowledges development contributions from the following +engineers at the `National Laboratory of the Rockies `_ +(NLR), with support from the US Department of Energy's Wind Energy Technology +Office. NLR gratefully acknowledges development contributions from the following organizations: * Envision Energy USA, Ltd diff --git a/docs/conf.py b/docs/conf.py index c63f31292c..06a4c7e2f2 100644 --- a/docs/conf.py +++ b/docs/conf.py @@ -20,6 +20,7 @@ import sys import subprocess import re +import datetime #sys.path.append(os.path.abspath('_extensions/')) @@ -127,18 +128,18 @@ def runDoxygen(sourcfile, doxyfileIn, doxyfileOut): master_doc = 'index' # General information about the project. -project = u'OpenFAST' -copyright = u'2023, National Renewable Energy Laboratory' -author = u'OpenFAST Team' +project = f'OpenFAST' +copyright = f'{datetime.date.today().year}, National Renewable Energy Laboratory' +author = f'OpenFAST Team' # The version info for the project you're documenting, acts as replacement for # |version| and |release|, also used in various other places throughout the # built documents. # # The short X.Y version. -version = u'4.1' +version = f'4.1' # The full version, including alpha/beta/rc tags. -release = u'v4.1.2' +release = f'v4.1.2' # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. @@ -226,8 +227,8 @@ def runDoxygen(sourcfile, doxyfileIn, doxyfileOut): ( master_doc, 'Openfast.tex', - u'OpenFAST Documentation', - u'National Renewable Energy Laboratory', + f'OpenFAST Documentation', + f'National Renewable Energy Laboratory', 'manual' ), ] @@ -241,7 +242,7 @@ def runDoxygen(sourcfile, doxyfileIn, doxyfileOut): ( master_doc, 'openfast', - u'OpenFAST Documentation', + f'OpenFAST Documentation', [author], 1 ) @@ -257,7 +258,7 @@ def runDoxygen(sourcfile, doxyfileIn, doxyfileOut): ( master_doc, 'OpenFAST', - u'OpenFAST Documentation', + f'OpenFAST Documentation', author, 'OpenFAST', 'One line description of project.', diff --git a/docs/index.rst b/docs/index.rst index 9dd5504e5f..56a4b46189 100644 --- a/docs/index.rst +++ b/docs/index.rst @@ -27,7 +27,7 @@ and underlying modules are mostly written in Fortran (adhering to the 2003 standard), and modules can also be written in C or C++. It was created with the goal of being a community model developed and used by research laboratories, academia, and industry. It is -managed by a dedicated team at the National Renewable Energy Lab. +managed by a dedicated team at the National Lab of the Rockies. Our objective is to ensure that OpenFAST is well tested, well documented, and self-sustaining software. To that end, we are continually improving the documentation and test coverage for existing code, and we diff --git a/docs/source/install/install_vs_windows.rst b/docs/source/install/install_vs_windows.rst index a682d4d5e4..d5a309f64c 100644 --- a/docs/source/install/install_vs_windows.rst +++ b/docs/source/install/install_vs_windows.rst @@ -11,21 +11,21 @@ Prerequisites 1. A version of Visual Studio (VS). - - Currently VS 2013 Professional and VS 2015 Community Edition have been tested with OpenFAST. + - NOTE: not all VS Studio versions are supported by the Intel compilers. In general, the Fortran compiler must be newer than Visual Studio. A list of Intel Fortran compatible VS versions and specific installation notes are found `here `_. - - A list of Intel Fortran compatible VS versions and specific installation notes are found `here `_. + - Currently VS 2019 Community Edition, VS 2022 Professional, and VS 2022 Community Edition have been tested with OpenFAST. Download VS 2022 Community `here `__. - - The included C/C++ project files for MAP++ and the Registry are compatible with VS 2013, but will upgrade seemlessly to a newer version of VS. + - When installing Visual Studio, select the ``Desktop development with C++`` under ``Workloads``. - - If you download and install `Visual Studio 2015 Community Edition `__, you will need to be sure and select the ``C/C++ component`` using the ``Customize`` option. + - Note: The included C/C++ project files for MAP++ and the Registry are compatible with VS 2019, but will upgrade seemlessly to a newer version of VS. 2. Intel Fortran Compiler - - Currently only version 2017.1 has been tested with OpenFAST, but any newer version should be compatible. + - We recommend compiling with the IFX compiler from Intel. This is included in the ``Intel Fortran Essentials`` installation package. Currently tested with version 2025.3 - - You can download an Intel Fortran compiler `here `__. + - You can download ``Intel Fortran Essentials`` `here `__. Note: do not install the ``oneAPI HPC Toolkit`` - - Only install Intel Fortran after you have completed your Visual Studio installation. + - Only install Intel Fortran after you have completed your Visual Studio installation. Note that Intel Fortran must be compatible with your version of Visual Studio. See `here `__ for compatibility tables. 3. Git for Windows diff --git a/docs/source/testing/index.rst b/docs/source/testing/index.rst index 77fea3c218..cc91f40846 100644 --- a/docs/source/testing/index.rst +++ b/docs/source/testing/index.rst @@ -38,10 +38,9 @@ pushing new commits will trigger the tests. Obtaining and configuring the test suite ---------------------------------------- Portions of the test suite are linked to the OpenFAST repository through a -`git submodule`. Specifically, the following two repositories are included: +`git submodule`. Specifically, the following repository is included: - `r-test `__ -- `pFUnit `__ .. tip:: @@ -56,8 +55,8 @@ build process with an additional CMake flag: # BUILD_TESTING - Build the testing tree (Default: OFF) cmake .. -DBUILD_TESTING:BOOL=ON -Aside from this flag, the default CMake configuration is suitable for most systems. -See the :ref:`understanding_cmake` section for more details on configuring -the CMake targets. While the unit tests must be built with CMake due to its external -dependencies, the regression test may be executed without CMake, as described in -:ref:`python_driver`. +Aside from this flag, the default CMake configuration is suitable for most +systems. See the :ref:`understanding_cmake` section for more details on +configuring the CMake targets. While the unit tests must be built with CMake due +to its dependency on `test_drive` (included in the source code), the regression +test may be executed without CMake, as described in :ref:`python_driver`. diff --git a/docs/source/testing/unit_test.rst b/docs/source/testing/unit_test.rst index 0b3cb15a0a..8e421df93d 100644 --- a/docs/source/testing/unit_test.rst +++ b/docs/source/testing/unit_test.rst @@ -113,4 +113,3 @@ Some useful topics to consider when developing and testing for OpenFAST are: - `Test driven development `__ - `Separation of concerns `__ -- `pFUnit usage `__ diff --git a/docs/source/user/aerodyn-aeroacoustics/App-usage.rst b/docs/source/user/aerodyn-aeroacoustics/App-usage.rst index 7d9394bed5..e3c0fe656a 100644 --- a/docs/source/user/aerodyn-aeroacoustics/App-usage.rst +++ b/docs/source/user/aerodyn-aeroacoustics/App-usage.rst @@ -112,20 +112,22 @@ Finally, the set Outputs contains a few options for the output data: levels are reported with (True) or without (False) the A-weighting correction; see :numref:`aa-sec-ModelUsage`. -- **NAAOutFile** – Integer 1/2/3: flag to set the desired output file. When +- **NAAOutFile** – Integer 1/2/3/4: flag to set the desired output file. When set to 1, a value of overall sound pressure level at every **DT_AA** time step per observer is printed to file. When set to 2, the first output is accompanied by a second file where the total sound pressure level spectrum is printed per time step per observer. When set to - 3, the two first outputs are accompanied by a third file where the + 3, the two first output files are accompanied by a third file where the sound pressure level spectrum per noise mechanism is printed per time step per observer. When set to 4, a fourth file is generated with the values of overall sound pressure levels per node, per blade, per observer, and per time step. -- The following line contains the file name used to store the outputs. - The file name is attached with a 1, 2, 3, and 4 flag based on the - **NAAOutFile** options. +- The following line, **AAOutFile**, contains the root name for the files + used to store the outputs. If set to "default", the default output file + root name will be used. + The file name is appended with a 1, 2, 3, and 4 flag based on the + **NAAOutFile** options. The file must be closed by an END command. diff --git a/docs/source/user/aerodyn-aeroacoustics/example/AeroAcousticsInput.dat b/docs/source/user/aerodyn-aeroacoustics/example/AeroAcousticsInput.dat index 4a2bae7582..3b75a8b14b 100644 --- a/docs/source/user/aerodyn-aeroacoustics/example/AeroAcousticsInput.dat +++ b/docs/source/user/aerodyn-aeroacoustics/example/AeroAcousticsInput.dat @@ -24,6 +24,6 @@ True RoundedTip - Logical indicating rounded tip (flag) [Only used if ====== Outputs ==================================================================================== False AWeighting - A-weighting Flag (flag) 3 NrOutFile - Number of Output files. 1 for Time Dependent Overall SPL, 2 for both 1 and Frequency and Time Dependent SPL as well, or 3 for both 1 and 2 and Acoustics mechanism dependent, 4 for 1-3 and the overall sound pressure levels per blade per node per observer -"IEA_LB_RWT-AeroAcoustics_" AAOutFile - No Extension needed the resulting file will have .out Name of file containing +"IEA_LB_RWT-AeroAcoustics_" AAOutFile - No Extension needed; the resulting file(s) will end in #.out. Use "Default" to use the default output file name from OpenFAST. END of input file (the word "END" must appear in the first 3 columns of this last OutList line) --------------------------------------------------------------------------------------- diff --git a/docs/source/user/elastodyn/input.rst b/docs/source/user/elastodyn/input.rst index c6a7c3b264..1af07ef9b3 100644 --- a/docs/source/user/elastodyn/input.rst +++ b/docs/source/user/elastodyn/input.rst @@ -181,7 +181,9 @@ Mass and Inertia **HubMass** - Hub mass (kg) -**HubIner** - Hub inertia about rotor axis [3 blades] or teeter axis [2 blades] (kg m^2) +**HubIner** - Hub inertia about rotor axis (2 or 3-blades) (kg m^2) + +**HubIner_Teeter** - Hub inertia about teeter axis (2-blades) (kg m^2) **GenIner** - Generator inertia about HSS (kg m^2) diff --git a/docs/source/user/fast.farm/InputFiles.rst b/docs/source/user/fast.farm/InputFiles.rst index 334b9ec0c6..d51bb97b40 100644 --- a/docs/source/user/fast.farm/InputFiles.rst +++ b/docs/source/user/fast.farm/InputFiles.rst @@ -637,11 +637,14 @@ These are used only if WAT=2. **WAT_DxDyDz**: [three floats, comma separated] Distances (in meters) between points in the x, y, and z directions of the WAT_BoxFile These are used only if WAT=2. -When **WAT=1** the dimensions in each directions are taken as :math:`dx=dy=dz=0.03*\text{RotorDiamRef}`. +When **WAT=1** the dimensions will be set to **[dX_high, dY_high, dZ_high]** if +that is the same for all turbines, otherwise the dimeinaiona will be calculated +using the guidance with :math:`dx=dy=dz=0.03*\text{RotorDiamRef}`. + **WAT_ScaleBox**: [flag] When set to True, the input turbulence box is scaled so that it has zero mean and unit standard deviation at every node. -DEFAULT is False. +DEFAULT is True. **WAT_k_Def** [five floats, comma separated] :math:`[k_\text{def}, k_\text{FMin}, k_\text{DMin}, k_\text{DMax}, e]` Tuning parameters for quasi-steady wake deficit effect in the wake-added diff --git a/docs/source/user/hydrodyn/input_files.rst b/docs/source/user/hydrodyn/input_files.rst index b93aaa8035..a1a12a4ba3 100644 --- a/docs/source/user/hydrodyn/input_files.rst +++ b/docs/source/user/hydrodyn/input_files.rst @@ -561,9 +561,9 @@ flow is directed away from the endplate where flow separation is expected, not when the relative flow is impinging on the endplate where flow separation is unlikely. Option 0 is suitable for strip-theory-only members, whereas option 1 might be better suited for -hybrid potential-flow members with drag force. Note that option 1 +hybrid potential-flow members with drag force. Note that option 0 uses a leading coefficient of 1/4 when computing the drag force, while -option 2 uses the more common leading coefficient of 1/2 since drag +option 1 uses the more common leading coefficient of 1/2 since drag is usually only applied to one of the two endplates of the member instead of on both. @@ -715,6 +715,27 @@ Members Each member in your model will have hydrodynamic coefficients, which are specified using one of the three models (**MCoefMod**). Model 1 uses a single set of coefficients found in the SIMPLE HYDRODYNAMIC COEFFICIENTS sections. Model 2 is depth-based, and is determined via the table found in the DEPTH-BASED HYDRODYNAMIC COEFFICIENTS sections. Model 3 specifies coefficients for a particular member, by referring to the MEMBER-BASED HYDRODYNAMIC COEFFICIENTS sections. Depending on **MSecGeom**, HydroDyn will either use the hydrodynamic coefficients from the input tables for circular sections or rectangular sections as appropriate. The **MHstLMod** switch controls the computation of hydrostatic loads on strip-theory members when **PropPot** = FALSE. Setting **MHstLMod** to 0 disables hydrostatic load. If set to 1, hydrostatic loads will be computed analytically. This approach is efficient, but it only works for fully submerged or surface-piercing members that are far from horizontal without partially wetted endplates. For nearly horizontal members close to the free surface or members that experience partially wetted endplates, a semi-numerical approach for hydrostatic load can be selected by setting **MHstLMod** to 2. This approach works with any member positioning in relation to the free surface at the cost of slightly longer computing time. Note that for members with rectangular cross sections, **MHstLMod** must be either 0 or 2. The analytical approach with **MHstLMod** set to 1 is not available for rectangular members. The **PropPot** flag indicates whether the corresponding member is included in the potential-flow solution. When **PropPot** = TRUE, only viscous-drag loads and ballasting loads will be computed for that member, with the assumption that all other load components are already included in the potential-flow solution. +In addition to the required inputs for each member explained above, we have several optional inputs for more advanced transverse drag modeling for rectangular members. These are **FDMod**, **VnCOffA**, **VnCOffB**, **FDLoFScA**, and **FDLoFScB**, as shown in the example below. For each rectangular member (**MSecGeom** = 2), users can either omit all these optional inputs together, in which case the simple default drag formulation will be used, or provide all five optional inputs to enable more advanced drag formulation. It is not allowed to provide only a subset of these optional inputs, while omitting others. These inputs are not relevant to members with circular cross sections (**MSecGeom** = 1) and should be omitted for these members. HydroDyn will simply ignore these optional inputs if provided for a circular member, and a warning will be displayed at the start of the simulation. + +The first optional input **FDMod** can be 0, 1, or 2. Setting **FDMod** to 0 leads to the default transverse drag formulation for rectangular members. The two components of the distributed transverse drag force normal to Side A and normal to Side B are both computed using the flow and structure velocities along the axis/centerline of the member based on **CdA** and **CdB** defined previously. This is referred to as a centerline-based formulation. Consistent with the transverse drag along cylindrical members, a lead coefficient of 1/2 is used in the expression for the drag force in both directions. + +When **FDMod** is set to 1, a face-based drag formulation is used. In this case, four side-normal drag components are computed using the flow and structure velocities at the midpoints of the four sides of the rectangular section instead of at the center. On each side, only the normal components of the flow and structure velocities are used to compute the drag force. The components parallel to the side are ignored. This is analogous to the modeling of drag force on member endplates at the joints with **AxFDMod** set to 0, if we interpret each of the four side walls of a rectangular member as an array of endplates placed along the length of the member. Also analogous to endplate drag force, a lead coefficient of 1/4 instead of 1/2 is used when computing the drag force on each side. This is to account for the fact that we now have two drag components on the pair of sides normal to Side A and two drag components on the other pair of sides normal to Side B. This change in the lead coefficient ensures a degree of consistency with the default model of **FDMod** = 0. + +Setting **FDMod** to 2 also leads to a face-based drag formulation being used. However, drag force will only be applied on the sides where the relative flow is directed away from the structure, i.e., the suction side, where flow separation is expected, not on the sides the relative flow is impinging on where flow separation is unlikely. This is again analogous to the modeling of endplate drag force at the joints with **AxFDMod** set to 1. This suction-side-only formulation is expected to work better for hybrid members modeled by potential-flow theory. Note that with **FDMod** set to 2, a lead coefficient of 1/2 instead of 1/4 is again used for each side. This is because for each pair of parallel sides, typically only one side, the suction side, will have a non-zero drag force, not both. This change in the lead coefficient is again included to ensure a degree of consistency with the other two drag formulations. + +With **FDMod** set to either 1 or 2, users can optional enable high-pass filtering of the relative flow velocity when computing the transverse drag force. The cutoff frequency of the high-pass filter can be set through **VnCOffA** for the drag components normal to Side A and **VnCOffB** for the drag components normal to Side B. These inputs are analogous to **AxVnCOff** for the endplate drag force at the joints. The two weighting factors **FDLoFScA** for the drag components normal to Side A and **FDLoFScB** for the drag components normal to Side B control the proportion of drag force computed using the unfiltered relative flow velocity. Both inputs should be between 0 and 1. When set to 1, the drag force is computed purely based on the unfiltered relative flow velocity, equivalent to no velocity filtering. When set to 0, the drag force is computed purely based on the high-pass filtered relative flow velocity. Again, these inputs are analogous to **AxFDLoFSc** for the member endplate drag forces at the joints. The velocity filtering allows the user to attenuate the drag force in response to low-frequency motion. When applied to the drag force on rectangular pontoons, this option can help improve the predictions of low-frequency heave and pitch resonance motions of a floater if properly tuned. To disable velocity filtering, users can either set **FDLoFScA** and **FDLoFScB** to 1 or set **VnCOffA** and **VnCOffB** to a number equal to or less than zero. Velocity filtering is not supported with the centerline-based approach, and the relevant inputs will be ignored if **FDMod** = 0. + +If the optional inputs are omitted for a rectangular member, the default centerline-based drag formulation with **FDMod** = 0 will be used, and velocity filtering will not be applied. Irrespective of the choice of **FDMod** and velocity filtering, the member drag coefficients can be set using any of the three **MCoefMod** options without any additional restrictions. Finally, note that these optional inputs only affect the computation of distributed transverse drag forces perpendicular to the member axis. They do not affect the distributed axial drag force along the member axis. + +.. code:: + + -------------------- MEMBERS ------------------------------------------------- + 2 NMembers - Number of members (-) + MemberID MJointID1 MJointID2 MPropSetID1 MPropSetID2 MSecGeom MSpinOrient MDivSize MCoefMod MHstLMod PropPot FDMod VnCOffA VnCOffB FDLoFScA FDLoFScB [MCoefMod=1: use simple coeff table, 2: use depth-based coeff table, 3: use member-based coeff table] [PropPot/=0 if member is modeled with potential-flow theory] + (-) (-) (-) (-) (-) (switch) (deg) (m) (switch) (switch) (flag) (switch) (Hz) (Hz) (-) (-) + 1 1 2 1 1 1 0 0.5 1 2 FALSE ! Circular members should not have any optional inputs. If provided, these inputs will be ignored. + 2 3 4 1 2 2 60 0.5 2 2 FALSE 2 0.05 0.05 0.5 0.5 ! A rectangular member with optional inputs for drag. + .. TODO 7.5.2 is the theory section which does not yet exist. .. Section 7.5.2 discusses the difference between the user-supplied discretization and the simulation discretization. diff --git a/docs/source/user/index.rst b/docs/source/user/index.rst index f2d22f797d..f06e595df3 100644 --- a/docs/source/user/index.rst +++ b/docs/source/user/index.rst @@ -32,6 +32,7 @@ This section contains documentation for the OpenFAST module-coupling environment TurbSim FAST.Farm C++ API + WaveTank Additional module documentation diff --git a/docs/source/user/moordyn/index.rst b/docs/source/user/moordyn/index.rst index 140df93874..9d5d60d15e 100644 --- a/docs/source/user/moordyn/index.rst +++ b/docs/source/user/moordyn/index.rst @@ -12,6 +12,6 @@ usage of MoorDyn at the FAST.Farm level and links to publications with the relevant theory. -The user guide can be downloaded below. +Examples of how to use MoorDynF and MoorDynC can be found here: -`Official User's Guide `_ +`MoorDyn Example Uses `_ diff --git a/docs/source/user/other/index.rst b/docs/source/user/other/index.rst new file mode 100644 index 0000000000..4aba57b5bd --- /dev/null +++ b/docs/source/user/other/index.rst @@ -0,0 +1,40 @@ +.. _WaveTank: + +WaveTank +======== + +The WaveTank glue-code is an experimental code for coupling hardware-in-the-loop +MHK models in a wavetank to software simulating the MHK turbine loads that +cannot be physically modeled in the wave tank. The *OpenFAST* modules +*SeaState*, *AeroDyn*, *MoorDyn*, and *InflowWind* are statically linked into a +single dynamic library (``cmake`` target ``wavetanktesting_c_binding``) with a +c-binding based interface. This library can be called from *LabView* or another +code. + +Inputs to the library include the time and motions, including the velocities and +accelerations, located at a single reference poitn at each time step. The +resulting forces and moments are returned to the calling code. + +Restrictions +~~~~~~~~~~~~ +The current setup WaveTank library has several restrictions: + +- rigid structure including platform, tower, and nacelle +- no yaw DOF +- rigid rotor +- constant rotor RPM for entire simulation +- no option for controller interfacing at present +- visualization limitted to *AeroDyn* and *SeaState* +- Current implementation only supports floating MHK turbines (``MHK = 2``). Other modes are present but not fully implemented. + + + + +Input File +~~~~~~~~~~ + + +.. toctree:: + :maxdepth: 2 + + wavetank_input.rst diff --git a/docs/source/user/other/wavetank_input.rst b/docs/source/user/other/wavetank_input.rst new file mode 100644 index 0000000000..5ef7490064 --- /dev/null +++ b/docs/source/user/other/wavetank_input.rst @@ -0,0 +1,242 @@ +.. _WaveTank-Input: + +Input File +---------- + +This document describes the WaveTank configuration input file (``wavetankconfig_input.txt``) used to set up and run the WaveTank model for marine hydrokinetic (MHK) turbine testing. + +- The file is read by the WaveTank library during initialization. + +Conventions and Units +--------------------- + +- SI units are used throughout: m, s, kg, N, Pa. +- Angles are in degrees unless otherwise specified. +- Rotational speed is in rpm where noted. +- Positions and heights are referenced to Mean Sea Level (MSL) unless otherwise noted. +- Input files for modules may be relative or absolute paths. + +File and Simulation Control +--------------------------- + +OutRootName (string) + Root name used when writing summary or other files. + Example: ``FRM1Q_Floating_tank_test``. + +DT (s) + Nominal timestep for WaveTank internal scheduling. Currently unused/reserved. + +TMax (s) + Maximum simulation time for WaveTank internal scheduling. Currently unused/reserved. + +MHK (switch) + MHK turbine type switch: + + - 0: Not an MHK turbine + - 1: Fixed MHK turbine + - 2: Floating MHK turbine + + Only the floating option (2) is supported at present. + +InterpOrd (-) + Interpolation order for internal data interpolation. Currently unused/reserved. + +DebugLevel (switch) + Controls logging and visualization detail: + + - 0: none + - 1: I/O summary + - 2: + positions/orientations passed + - 3: + input file + - 4: + all meshes + +.. note:: + Parameters marked “unused” are reserved for future development and are currently ignored by the code path. + +Froude Scaling (disabled) +------------------------- + +The following parameters may appear but are typically commented out. Froude scaling is not complete in the current code. Do not use unless explicitly enabled. + +ScaleFact (-) + Froude scaling factor λ = (full-size dimension) / (model-size dimension). Expected > 1 for scale-model testing. + +DensFact (-) + Density ratio ρ_full / ρ_model, used with Froude scaling of forces/moments. + +Environment +----------- + +Gravity (m/s^2) + Gravitational acceleration. + +WtrDens (kg/m^3) + Water (working fluid) density. + +WtrVisc (m^2/s) + Kinematic viscosity of the working fluid. + +SpdSound (m/s) + Speed of sound in the working fluid. + +Patm (Pa) + Atmospheric pressure. Used for cavitation checks. + +Pvap (Pa) + Vapor pressure of the working fluid. Used for cavitation checks. + +WtrDpth (m) + Water depth. + +MSL2SWL (m) + Offset between still-water level (SWL) and mean sea level (MSL); positive upward. + +Sea State +--------- + +SS_InputFile (string) + Path to SeaState input file defining wave conditions. Ensure path is valid relative to the run directory or use an absolute path. + +WaveTimeShift (s) + Time shift applied to the SeaState wave time series to adjust phase and match tank conditions. + +MoorDyn +------- + +MD_InputFile (string) + Path to MoorDyn input file defining mooring system properties and connections. + +AeroDyn and InflowWind +---------------------- + +AD_InputFile (string) + Path to AeroDyn input file defining aerodynamic model configuration (used for hydro/aero coupling as applicable in MHK context). + +IfW_InputFile (string) + Path to InflowWind input file defining inflow conditions for the rotor (e.g., currents or wind, depending on model setup). + +Turbine Geometry and Reference Frames +------------------------------------- + +NumBl (-) + Number of blades on the rotor. + +HubRad (m) + Distance from the rotor apex to the blade root. + +PreCone (deg) + Blade cone angle. + +OverHang (m) + Distance from the yaw axis (tower centerline) to the rotor apex. Negative values indicate rotor apex aft of the yaw axis under the model’s convention. + +ShftTilt (deg) + Rotor shaft tilt angle. + +Twr2Shft (m) + Vertical distance from tower-top to the rotor shaft center (nacelle center). Negative values are below tower-top. + +TowerHt (m) + Height of the tower relative to MSL. Tower is vertically aligned with ``TowerBsPt`` (sloped towers not supported). + +TowerBsPt (m, m, m) + Tower base location relative to the platform reference position in x and y, and relative to MSL in z: + + - x: along surge axis + - y: along sway axis + - z: height relative to MSL + +PtfmRefPos (m, m, m) + Platform reference point position relative to MSL. All platform motions and loads connect at this point. + +PtfmRefOrient (deg, deg, deg) + Platform reference orientation given as Euler angles [roll, pitch, yaw]. + +Turbine Initial Conditions +-------------------------- + +RotSpeed (rpm) + Initial rotational speed of the rotor (in rotor coordinates). + +NacYaw (deg) + Initial or fixed nacelle yaw angle. + +BldPitch (deg) + Initial blade 1 pitch angle. If a multi-blade model is used, blade pitch control typically applies per blade in other modules; here this initializes blade 1. + +Azimuth (deg) + Initial rotor azimuth angle. + +Wave Buoy +--------- + +WaveBuoyLoc (m, m) + Location of the wave elevation measurement buoy in the tank coordinate frame. SeaState data is returned at each timestep at this location. + +Output +------ + +SendScreenToFile (flag) + If true, send screen output to a file named ``.screen.log``. + +OutFile (switch) + Controls tabular output of channels: + + - 0: no output file of channels + - 1: output file in text format (written at default DT) + +OutFmt (string) + Format specifier for text tabular output channels (excluding the time channel). Uses a Fortran-like format string. + Example: ``ES20.6E2``. + +VTK Visualization Output +------------------------ + +WrVTK_Dir (string) + Output directory for VTK visualization files. + +WrVTK (switch) + VTK visualization data output: + + - 0: none + - 1: initialization data only + - 2: animation + - 3: mode shapes + +WrVTK_type (switch) + Type of VTK visualization data: + + - 1: surfaces + - 2: basic meshes (lines/points) + - 3: all meshes (debug) + +.. note:: + Only lines/points may be supported in some builds. If surfaces are not + supported, use ``WrVTK_type = 2`` to visualize line/point data. + +WrVTK_DT (s) + Timestep for writing VTK files. + +VTKNacDim (m, m, m, m, m, m) + Nacelle dimensions for VTK surface rendering in the format ``[x0, y0, z0, Lx, Ly, Lz]``: + + - ``x0, y0, z0``: nacelle origin offsets + - ``Lx, Ly, Lz``: nacelle extents along x, y, z + +Implementation Notes and Best Practices +--------------------------------------- + +- Only floating MHK (``MHK = 2``) is currently supported; other MHK modes will + not perform as expected. +- Ensure external file paths (*SeaState*, *MoorDyn*, *AeroDyn*, *InflowWind*) + are valid relative to the working directory or specify absolute paths. +- Coordinate conventions: + + - Positions and heights are referenced to MSL unless otherwise noted. + - The platform reference point (``PtfmRefPos``) is the coupling point for + motions and loads. + - The tower base is defined relative to ``PtfmRefPos`` in x and y, and to MSL + in z. + +- Choose ``OutFmt`` to balance precision and file size. The example ``ES20.6E2`` + is suitable for scientific notation with fixed width. diff --git a/docs/source/user/servodyn-stc/StC_Theory.rst b/docs/source/user/servodyn-stc/StC_Theory.rst index ea6608f380..f452065fb5 100644 --- a/docs/source/user/servodyn-stc/StC_Theory.rst +++ b/docs/source/user/servodyn-stc/StC_Theory.rst @@ -473,7 +473,7 @@ Therefore :math:`\ddot{z}_{_{TMD_Z/P_N}}` is governed by the equations -The forces :math:`F_{X_{_{TMD_Z/O_N}}}` and :math:`F_{Z_{_{TMD_Z/O_N}}}` +The forces :math:`F_{X_{_{TMD_Z/O_N}}}` and :math:`F_{Y_{_{TMD_Z/O_N}}}` are solved noting :math:`\ddot{x}_{_{TMD_Z/P_N}} = \ddot{y}_{_{TMD_Z/P_N}} = 0`: @@ -565,11 +565,11 @@ first-order equations of the form A(\vec{u}) = \left[ \begin{array}{cccccc} 0& 1 &0&0&0&0 \\ - (\dot{\phi}_{_{P/O_N}}^2 + \dot{\psi}_{_{P/O_N}}^2-\frac{k_x}{m_x}) & - (\frac{c_x}{m_x}) &0&0&0&0 \\ + (\dot{\phi}_{_{N/O_N}}^2 + \dot{\psi}_{_{N/O_N}}^2-\frac{k_x}{m_x}) & - (\frac{c_x}{m_x}) &0&0&0&0 \\ 0&0&0& 1 &0&0 \\ - 0&0& (\dot{\theta}_{_{P/O_N}}^2 + \dot{\psi}_{_{P/O_N}}^2-\frac{k_y}{m_y}) & - (\frac{c_y}{m_y}) &0&0 \\ + 0&0& (\dot{\theta}_{_{N/O_N}}^2 + \dot{\psi}_{_{N/O_N}}^2-\frac{k_y}{m_y}) & - (\frac{c_y}{m_y}) &0&0 \\ 0&0&0&0&0& 1 \\ - 0&0&0&0& (\dot{\theta}_{_{P/O_N}}^2 + \dot{\phi}_{_{P/O_N}}^2-\frac{k_z}{m_z}) & - (\frac{c_z}{m_z}) \\ + 0&0&0&0& (\dot{\theta}_{_{N/O_N}}^2 + \dot{\phi}_{_{N/O_N}}^2-\frac{k_z}{m_z}) & - (\frac{c_z}{m_z}) \\ \end{array} \right] and @@ -615,9 +615,9 @@ The output includes reaction forces corresponding to \begin{aligned} \vec{F}_{_{P_G}} = R^T_{_{N/G}} & \left[ \begin{array}{l} - k_x {x}_{_{TMD/P_N}} + c_x \dot{x}_{_{TMD/P_N}} - F_{StopFrc_{X}} - F_{ext_x} - F_{X_{_{TMD_Y/O_N}}} - F_{X_{_{TMD_Z/O_N}}} \\ - k_y {y}_{_{TMD/P_N}} + c_y \dot{y}_{_{TMD/P_N}} - F_{StopFrc_{Y}} - F_{ext_y} - F_{Y_{_{TMD_X/O_N}}} - F_{Y_{_{TMD_Z/O_N}}} \\ - k_z {z}_{_{TMD/P_N}} + c_z \dot{z}_{_{TMD/P_N}} - F_{StopFrc_{Z}} - F_{ext_z} - F_{Z_{_{TMD_X/O_N}}} - F_{Z_{_{TMD_Y/O_N}}} - F_{Z_{PreLoad}} + k_x {x}_{_{TMD_X/P_N}} + c_x \dot{x}_{_{TMD_X/P_N}} - F_{StopFrc_{X}} - F_{ext_x} - F_{X_{_{TMD_Y/O_N}}} - F_{X_{_{TMD_Z/O_N}}} \\ + k_y {y}_{_{TMD_Y/P_N}} + c_y \dot{y}_{_{TMD_Y/P_N}} - F_{StopFrc_{Y}} - F_{ext_y} - F_{Y_{_{TMD_X/O_N}}} - F_{Y_{_{TMD_Z/O_N}}} \\ + k_z {z}_{_{TMD_Z/P_N}} + c_z \dot{z}_{_{TMD_Z/P_N}} - F_{StopFrc_{Z}} - F_{ext_z} - F_{Z_{_{TMD_X/O_N}}} - F_{Z_{_{TMD_Y/O_N}}} - F_{Z_{PreLoad}} \end{array} \right] \end{aligned} diff --git a/glue-codes/fast-farm/src/FASTWrapper.f90 b/glue-codes/fast-farm/src/FASTWrapper.f90 index 65b8e90f1a..3207a139b2 100644 --- a/glue-codes/fast-farm/src/FASTWrapper.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper.f90 @@ -76,6 +76,8 @@ SUBROUTINE FWrap_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init TYPE(FAST_ExternInitType) :: ExternInitData INTEGER(IntKi) :: j,k,nb + REAL(ReKi) :: p0(3) ! hub location (in FAST with 0,0,0 as turbine reference) + REAL(R8Ki) :: orientation(3,3) ! temp orientation array INTEGER(IntKi) :: ErrStat2 ! local error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message @@ -196,12 +198,19 @@ SUBROUTINE FWrap_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ) if (Failed()) return; - ! set node initial position/orientation - ! shortcut for - ! call MeshPositionNode(m%ADRotorDisk(k), j, [0,0,r(j)], errStat2, errMsg2) - m%ADRotorDisk(k)%Position(3,:) = p%r ! this will get overwritten later, but we check that we have no zero-length elements in MeshCommit() + ! set node initial position/orientation + ! NOTE: the mesh data for ADRotorDisk gets overwritten before use so it isn't actually important + ! that this match the method used later in the code. We can't use the method from later + ! in the code since the `hub_theta_x_root` is not known at this point. So instead, we + ! will use the input blade root orientation to set the direction. This does not result + ! in a flat disk, but should allow the mesh mapping to work. + p0 = m%Turbine%AD%Input(1)%rotors(1)%HubMotion%Position(:,1) + m%Turbine%AD%Input(1)%rotors(1)%HubMotion%TranslationDisp(:,1) + m%ADRotorDisk(k)%RefOrientation(:,:,1) = m%Turbine%AD%Input(1)%rotors(1)%BladeRootMotion(k)%Orientation(:,:,1) + do j=1,p%nr + m%ADRotorDisk(k)%Position(:,j) = p0 + p%r(j)*m%ADRotorDisk(k)%RefOrientation(3,:,1) + end do m%ADRotorDisk(k)%TranslationDisp = 0.0_R8Ki ! this happens by default, anyway.... - + ! create line2 elements do j=1,p%nr-1 call MeshConstructElement( m%ADRotorDisk(k), ELEMENT_LINE2, errStat2, errMsg2, p1=j, p2=j+1 ); if (Failed()) return; diff --git a/glue-codes/fast-farm/src/FAST_Farm_IO.f90 b/glue-codes/fast-farm/src/FAST_Farm_IO.f90 index 53b85ad30b..00b38e6505 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_IO.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_IO.f90 @@ -168,7 +168,23 @@ SUBROUTINE Farm_PrintSum( farm, WD_InputFileData, ErrStat, ErrMsg ) end select WRITE (UnSum,'(2X,A)') 'Calibrated parameter for wake meandering (-): '//trim(Num2LStr(farm%AWAE%p%C_Meander)) -!FIXME: add summary info about WAT + if (farm%p%WAT == 0) then + write (UnSum,'(/,2X,A)') 'Wake added turbulence: off' + else + write (UnSum,'(/,2X,A)') 'Wake-Added Turbulence (WAT):' + write (UnSum,'(4X,A,3(I8,1X))') 'WAT_NxNyNz: ',farm%p%WAT_NxNyNz(1:3) + write (UnSum,'(4X,A,3(f9.3))') 'WAT_DxDyDz: ',farm%p%WAT_DxDyDz(1:3) + if (farm%p%WAT_ScaleBox) then + write (UnSum,'(4X,A,A)') 'WAT_ScaleBox: ','.TRUE.' + else + write (UnSum,'(4X,A,A)') 'WAT_ScaleBox: ','.FALSE.' + endif + write (UnSum,'(4X,A)') 'coefficients:' + write (UnSum,'(16X,A)') 'k_c f_min D_min D_max e' + write (UnSum,'(A12,5(f9.3))') 'k_Def', WD_InputFileData%WAT_k_Def_k_c, WD_InputFileData%WAT_k_Def_FMin, WD_InputFileData%WAT_k_Def_DMin, WD_InputFileData%WAT_k_Def_DMax, WD_InputFileData%WAT_k_Def_Exp + write (UnSum,'(A12,5(f9.3))') 'k_Grad',WD_InputFileData%WAT_k_Grad_k_c,WD_InputFileData%WAT_k_Grad_FMin,WD_InputFileData%WAT_k_Grad_DMin,WD_InputFileData%WAT_k_Grad_DMax,WD_InputFileData%WAT_k_Grad_Exp + endif + WRITE (UnSum,'(/,A)' ) 'Time Steps' WRITE (UnSum,'(2X,A)') 'Component Time Step Subcyles' @@ -837,7 +853,7 @@ SUBROUTINE Farm_ReadPrimaryFile( InputFile, p, WD_InitInp, AWAE_InitInp, OutList CALL ReadVar( UnIn, InputFile, p%WAT_BoxFile, 'WAT_BoxFile', "Filepath to the file containing the u-component of the turbulence box (either predefined or user-defined) (quoted string)", ErrStat2, ErrMsg2, UnEc ); if(failed()) return call ReadAry( UnIn, InputFile, p%WAT_NxNyNz, 3, "WAT_NxNyNz", "Number of points in the x, y, and z directions of the WAT_BoxFile [used only if WAT=2] (m)", ErrStat2, ErrMsg2, UnEc ); if(failed()) return call ReadAry( UnIn, InputFile, p%WAT_DxDyDz, 3, "WAT_DxDyDz", "Distance (in meters) between points in the x, y, and z directions of the WAT_BoxFile [used only if WAT=2] (m)", ErrStat2, ErrMsg2, UnEc ); if(failed()) return - call ReadVarWDefault( UnIn, InputFile, p%WAT_ScaleBox, "WAT_ScaleBox", "Flag to scale the input turbulence box to zero mean and unit standard deviation at every node", .False., ErrStat2, ErrMsg2, UnEc); if(failed()) return + call ReadVarWDefault( UnIn, InputFile, p%WAT_ScaleBox, "WAT_ScaleBox", "Flag to scale the input turbulence box to zero mean and unit standard deviation at every node", .True., ErrStat2, ErrMsg2, UnEc); if(failed()) return call ReadAryWDefault( UnIn, InputFile, TmpRAry5, 5, "WAT_k_Def", & "Calibrated parameters for the influence of the maximum wake deficit on wake-added turbulence (set of 5 parameters: k_Def , DMin, DMax, FMin, Exp) (-) [>=0.0, >=0.0, >DMin, >=0.0 and <=1.0, >=0.0] or DEFAULT [DEFAULT=[0.6, 0.0, 0.0, 2.0, 1.0 ]]", & (/0.6_ReKi, 0.0_ReKi, 0.0_ReKi, 2.0_ReKi, 1.00_ReKi/), ErrStat2, ErrMsg2, UnEc); if(failed()) return @@ -1086,9 +1102,9 @@ SUBROUTINE Farm_ValidateInput( p, WD_InitInp, AWAE_InitInp, ErrStat, ErrMsg ) ! summary table call WrScr(' Wake-Added Turbulence (WAT): coefficients:') call WrScr(' k_c f_min D_min D_max e') - write(tmpStr,'(A6,A6,6(f9.3))') '','k_Def', WD_InitInp%WAT_k_Def_k_c, WD_InitInp%WAT_k_Def_FMin, WD_InitInp%WAT_k_Def_DMin, WD_InitInp%WAT_k_Def_DMax, WD_InitInp%WAT_k_Def_Exp + write(tmpStr,'(A12,5(f9.3))') 'k_Def', WD_InitInp%WAT_k_Def_k_c, WD_InitInp%WAT_k_Def_FMin, WD_InitInp%WAT_k_Def_DMin, WD_InitInp%WAT_k_Def_DMax, WD_InitInp%WAT_k_Def_Exp call WrScr(tmpStr) - write(tmpStr,'(A6,A6,6(f9.3))') '','k_Grad',WD_InitInp%WAT_k_Grad_k_c,WD_InitInp%WAT_k_Grad_FMin,WD_InitInp%WAT_k_Grad_DMin,WD_InitInp%WAT_k_Grad_DMax,WD_InitInp%WAT_k_Grad_Exp + write(tmpStr,'(A12,5(f9.3))') 'k_Grad',WD_InitInp%WAT_k_Grad_k_c,WD_InitInp%WAT_k_Grad_FMin,WD_InitInp%WAT_k_Grad_DMin,WD_InitInp%WAT_k_Grad_DMax,WD_InitInp%WAT_k_Grad_Exp call WrScr(tmpStr) endif diff --git a/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 b/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 index 555a6169a1..344241616b 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 @@ -345,8 +345,7 @@ SUBROUTINE WAT_init( p, WAT_IfW, AWAE_InitInput, ErrStat, ErrMsg ) call MannLibDims(BoxFileRoot, p%RotorDiamRef, p%WAT_NxNyNz, p%WAT_DxDyDz, ErrStat2, ErrMsg2); if (Failed()) return write(sDummy, '(3(I8,1X))') p%WAT_NxNyNz call WrScr(' WAT: NxNyNz set to: '//trim(sDummy)//' (inferred from filename)') - write(sDummy, '(3(F8.3,1X))') p%WAT_DxDyDz - call WrScr(' WAT: DxDyDz set to: '//trim(sDummy)//' (based on rotor diameter)') + call Set_WAT_DxDyDz() ! Use turbine high res deltas if all same endif ! Sanity check if (any(p%WAT_NxNyNz<2)) then @@ -481,7 +480,7 @@ subroutine MannLibDims(BoxFileRoot,RotorDiamRef,Nxyz,Dxyz,ErrStat3,ErrMsg3) ErrStat3 = ErrID_None ErrMsg3 = "" - ! Set Dxyz + ! Calculate Dxyz based on guidance Dxyz=real(RotorDiamRef,ReKi)*ScaleFact ! --- Create a string made of digits and "x" only, starting from the end of the filename @@ -518,6 +517,38 @@ subroutine MannLibDims(BoxFileRoot,RotorDiamRef,Nxyz,Dxyz,ErrStat3,ErrMsg3) ErrStat3=ErrID_None ErrMsg3 ="" end subroutine MannLibDims + subroutine Set_WAT_DxDyDz() + real(ReKi) :: TmpDx,TmpDy,TmpDz + logical :: HResDimsSame + ! If Mod_AmbWind<2, we don't read high res discretizations + if (AWAE_InitInput%InputFileData%Mod_AmbWind < 2) then + write(sDummy, '(3(F8.3,1X))') p%WAT_DxDyDz + call WrScr(' WAT: DxDyDz set to: '//trim(sDummy)//' (calculated based on guidance for Mod_AmbWind==1)') + return + endif + ! Check if all turbines use the same high res deltas + HResDimsSame = .true. + TmpDx = AWAE_InitInput%InputFileData%dX_high(1) + TmpDy = AWAE_InitInput%InputFileData%dY_high(1) + TmpDz = AWAE_InitInput%InputFileData%dZ_high(1) + do i=2,size(AWAE_InitInput%InputFileData%dX_high) + if (.not. EqualRealNos(TmpDx,AWAE_InitInput%InputFileData%dX_high(i))) HResDimsSame = .false. + if (.not. EqualRealNos(TmpDy,AWAE_InitInput%InputFileData%dY_high(i))) HResDimsSame = .false. + if (.not. EqualRealNos(TmpDz,AWAE_InitInput%InputFileData%dZ_high(i))) HResDimsSame = .false. + enddo + ! if all turbines use same high res spacing, use that for WAT spacing + if (HResDimsSame) then + p%WAT_DxDyDz(1) = TmpDx + p%WAT_DxDyDz(2) = TmpDy + p%WAT_DxDyDz(3) = TmpDz + write(sDummy, '(3(F8.3,1X))') p%WAT_DxDyDz + call WrScr(' WAT: DxDyDz set to: '//trim(sDummy)//' (using high res grid resolution)') + ! otherwise fall back to calculated values from MannLibDims + else + write(sDummy, '(3(F8.3,1X))') p%WAT_DxDyDz + call WrScr(' WAT: DxDyDz set to: '//trim(sDummy)//' (high res grids are not identical for all turbines, calculated based on guidance instead)') + endif + end subroutine Set_WAT_DxDyDz end subroutine WAT_init !> Remove mean from all grid nodes and set standard deviation to 1 at all nodes diff --git a/glue-codes/labview/CMakeLists.txt b/glue-codes/labview/CMakeLists.txt index b14ef7ae4b..490a014a8e 100644 --- a/glue-codes/labview/CMakeLists.txt +++ b/glue-codes/labview/CMakeLists.txt @@ -14,15 +14,29 @@ # limitations under the License. # -add_library(wavetanktestinglib SHARED +if (GENERATE_TYPES) + generate_f90_types(src/WaveTank_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/WaveTank_Types.f90 -noextrap) +endif() + +add_library(wavetanktesting_c_binding SHARED + src/WaveTank_Types.f90 + src/WaveTank_IO.f90 + src/WaveTank_Struct.f90 src/WaveTank.f90 ) -target_link_libraries(wavetanktestinglib aerodyn_inflow_c_binding moordyn_c_binding seastate_c_binding nwtclibs versioninfolib) +target_link_libraries( + wavetanktesting_c_binding + aerodyn_inflow_c_bind_static + moordyn_c_bind_static + seastate_c_bind_static + nwtclibs + versioninfolib +) if(APPLE OR UNIX) - target_compile_definitions(wavetanktestinglib PRIVATE IMPLICIT_DLLEXPORT) + target_compile_definitions(wavetanktesting_c_binding PRIVATE IMPLICIT_DLLEXPORT) endif() -install(TARGETS wavetanktestinglib +install(TARGETS wavetanktesting_c_binding EXPORT "${CMAKE_PROJECT_NAME}Libraries" RUNTIME DESTINATION bin LIBRARY DESTINATION lib diff --git a/glue-codes/labview/examples/WaveTank.vi b/glue-codes/labview/examples/WaveTank.vi new file mode 100644 index 0000000000..dbfcd8ded2 Binary files /dev/null and b/glue-codes/labview/examples/WaveTank.vi differ diff --git a/glue-codes/labview/src/OPENFAST_RT_DLL.f90 b/glue-codes/labview/src/OPENFAST_RT_DLL.f90 deleted file mode 100644 index 50cee2773f..0000000000 --- a/glue-codes/labview/src/OPENFAST_RT_DLL.f90 +++ /dev/null @@ -1,125 +0,0 @@ -! OPENFAST_RT_DLL.f90 -! (c) 2009, 2012 National Renewable Energy Laboratory -! Paul Fleming, National Wind Technology Center, September 2009, 2012 -! Bonnie Jonkman, National Wind Technology Center, October 2012 -! -! Modification of OPENFAST for Labview RT -! Also includes code from OPENFAST_Simulink Adaptation -!==================================================================================== - -subroutine OPENFAST_RT_DLL_INIT (FileName_RT_Byte, FLen) - - ! Expose subroutine OPENFAST_RT_DLL_INIT to users of this DLL - ! - !DEC$ ATTRIBUTES DLLEXPORT::FAST_RT_DLL_INIT - -USE NWTC_Library -USE General, ONLY : PriFile, Cmpl4LV - -USE OPENFAST_IO_Subs ! OPENFAST_Input(), OPENFAST_Begin() -USE OPENFASTSubs ! OPENFAST_Initialize() - - ! This sub-routine is called by RT to initialize all internal variables - -IMPLICIT NONE - -INTEGER, PARAMETER :: MaxFileNameLen = 100 -INTEGER(B1Ki) :: FileName_RT_Byte(MaxFileNameLen) ! FileName_RT_Byte - -CHARACTER(MaxFileNameLen) :: FileName_RT_Char ! FileName_RT_Byte converted to ASCII characters -INTEGER :: FLen ! trim length of FileName_RT_Byte -INTEGER :: I ! temporary loop counter - - -IF ( FLen > MaxFileNameLen ) CALL ProgAbort('File name is too long in OPENFAST_RT_DLL_INIT.') -DO I=1,FLen - FileName_RT_Char(I:I) = ACHAR(FileName_RT_Byte(I)) -END DO -!EQUIVALENCE(FileName_RT_Byte2,FileName_RT_Char) !Make the character filename equivalent to incoming filename byte array - -!FileName_RT_Byte2(:) = FileName_RT_Byte(:) - - - -!Assign PriFile based on passed in string -PriFile = FileName_RT_Char(1:FLen) - - - ! Open and read input files, initialize global parameters. -CALL OPENFAST_Begin( PriFile, RootName, DirRoot ) - - -!Set compiler flag for Simulink -Cmpl4LV = .TRUE. - -CALL OPENFAST_Input() - - ! Set up initial values for all degrees of freedom. -CALL OPENFAST_Initialize(p,x,y,OtherState) - - -end subroutine OPENFAST_RT_DLL_INIT - - - - -!==================================================================================== -subroutine OPENFAST_RT_DLL_SIM (BlPitchCom_RT, YawPosCom_RT, YawRateCom_RT, ElecPwr_RT, GenTrq_RT, OutData_RT, Time_RT, HSSBrFrac_RT) - - - ! Expose subroutine OPENFAST_RT_DLL_SIM to users of this DLL - ! - !DEC$ ATTRIBUTES DLLEXPORT::FAST_RT_DLL_SIM - - -USE SimCont !ZTime - -! These are needed for FirstTime = .FALSE. -USE DriveTrain ! GenTrq and now also HSSBrFrac -USE TurbCont ! BlPitch -USE TurbConf ! NumBl -USE Blades ! TipNode -USE Precision ! ReKi -USE Features ! CompAero -USE Output ! for WrOutHdr - -USE OPENFASTSubs ! TimeMarch() - -IMPLICIT NONE - - ! This sub-routine implements n-iterations of time step and returns outputs to Labview RT - - ! Variables -REAL(ReKi), INTENT(IN) :: GenTrq_RT ! Mechanical generator torque. -REAL(ReKi), INTENT(IN) :: ElecPwr_RT ! Electrical power -REAL(ReKi), INTENT(IN) :: YawPosCom_RT ! Yaw position -REAL(ReKi), INTENT(IN) :: YawRateCom_RT ! Yaw rate -REAL(ReKi), INTENT(IN) :: BlPitchCom_RT (*) -REAL(ReKi), INTENT(OUT) :: OutData_RT (*) -REAL(ReKi), INTENT(OUT) :: Time_RT -REAL(ReKi), INTENT(IN) :: HSSBrFrac_RT ! Brake Fraction - - !Copy in inputs from RT - BlPitchCom = BlPitchCom_RT(1:NumBl) - YawPosCom = YawPosCom_RT - YawRateCom = YawRateCom_RT - ElecPwr = ElecPwr_RT - GenTrq= GenTrq_RT - HSSBrFrac = HSSBrFrac_RT - - ! Set the command pitch angles to the actual pitch angles since we have no - ! built-in pitch actuator: - BlPitch = BlPitchCom - - -!Run simulation -Call TimeMarch( p_StrD, x_StrD, OtherSt_StrD, y_StrD, ErrStat, ErrMsg ) - - -!Copy outputs -OutData_RT(1:p_StrD%NumOuts) = OutData(1:p_StrD%NumOuts) -Time_RT = ZTime; -OutData_RT(p_StrD%NumOuts+1) = TMax; -OutData_RT(p_StrD%NumOuts+2) = Time_RT; - -end subroutine OPENFAST_RT_DLL_SIM diff --git a/glue-codes/labview/src/README.txt b/glue-codes/labview/src/README.txt new file mode 100644 index 0000000000..1952663266 --- /dev/null +++ b/glue-codes/labview/src/README.txt @@ -0,0 +1,17 @@ +2025.11.10 + +This is a work in progress. Some things are not complete or functional yet: + + +Froude scaling is not complete, nor is it tested!!!! + +At present, only some inputs are scaled, but equations +have not been verified yet. This has been disabled by +removing the reading of the `*Fact` input lines in the +input file parsing and input file. + +TODO: + - verify equations in FroudeScaling* functions + - scale resulting forces / moments + - add scaled time, pos, vel, acc, frc, mom to output + channels and add subscripting to differentiate diff --git a/glue-codes/labview/src/WaveTank.f90 b/glue-codes/labview/src/WaveTank.f90 index 7be10ee85f..08f272a639 100644 --- a/glue-codes/labview/src/WaveTank.f90 +++ b/glue-codes/labview/src/WaveTank.f90 @@ -1,224 +1,831 @@ - +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2025 National Renewable Energy Laboratory +! +! This file is a module specific to an experimental wave tank at NREL. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!********************************************************************************************************************************** +! +! This code is designed to connect with LabView for a specific wave tank test case and likely will not work for other purposes. +! +! For this test, a physical platform is deployed in a wave tank with cable acutators that are controlled through LabView. This +! module is called to provide some loads that are not present in the physical tank setup. These include the following: +! - rotor loading from a fixed RPM MHK rotor from AeroDyn. This is calculated from either steady current provided by SeaState +! - Mooring loads from MoorDyn +! +! +!********************************************************************************************************************************** MODULE WaveTankTesting - USE ISO_C_BINDING - USE NWTC_Library - ! USE Precision - USE MoorDyn_C - USE SeaState_C_Binding - USE NWTC_C_Binding, ONLY: IntfStrLen, SetErr - - IMPLICIT NONE - SAVE - - PUBLIC :: WaveTank_Init - - REAL(C_DOUBLE) :: dt_c = 0.01_C_DOUBLE ! 100 hertz - REAL(C_FLOAT) :: g_c = 9.8065_C_FLOAT - REAL(C_FLOAT) :: rho_c = 1025.0_C_FLOAT - REAL(C_FLOAT) :: depth_c = 200.0_C_FLOAT - REAL(C_FLOAT), DIMENSION(6) :: ptfminit_c = 0.0_C_FLOAT - INTEGER(C_INT) :: interporder_c = 2 ! 1: linear (uses two time steps) or 2: quadratic (uses three time steps) - - INTEGER(C_INT) :: N_CAMERA_POINTS - - INTEGER(C_INT) :: load_period = 20 ! seconds - -CONTAINS - -SUBROUTINE SetErrStat_C(ErrStatLocal, ErrMessLocal, ErrStatGlobal, ErrMessGlobal, RoutineName) - -INTEGER(C_INT), INTENT(IN ) :: ErrStatLocal ! Error status of the operation -CHARACTER(*, KIND=C_CHAR), INTENT(IN ) :: ErrMessLocal ! Error message if ErrStat /= ErrID_None -INTEGER(C_INT), INTENT(INOUT) :: ErrStatGlobal ! Error status of the operation -CHARACTER(KIND=C_CHAR), INTENT(INOUT) :: ErrMessGlobal ! Error message if ErrStat /= ErrID_None -CHARACTER(*), INTENT(IN ) :: RoutineName ! Name of the routine error occurred in - -IF ( ErrStatLocal == ErrID_None ) RETURN - -IF (ErrStatGlobal /= ErrID_None) ErrMessGlobal = TRIM(ErrMessGlobal)//new_line('a') -ErrMessGlobal = TRIM(ErrMessGlobal)//TRIM(RoutineName)//':'//TRIM(ErrMessLocal) -ErrStatGlobal = MAX(ErrStatGlobal,ErrStatLocal) - -END SUBROUTINE - -SUBROUTINE WaveTank_Init( & - MD_InputFile_c, & - SS_InputFile_c, & - AD_InputFile_c, & - IfW_InputFile_c, & - n_camera_points_c, & - ErrStat_c, & - ErrMsg_c & -) BIND (C, NAME='WaveTank_Init') + use ISO_C_BINDING + use NWTC_Library + use SeaState_C_Binding, ONLY: SeaSt_C_PreInit, SeaSt_C_Init, SeaSt_C_CalcOutput, SeaSt_C_End, MaxOutPts, SeaSt_C_GetWaveFieldPointer, SeaSt_C_GetSurfElev + use SeaSt_WaveField_Types, ONLY: SeaSt_WaveFieldType + use AeroDyn_Inflow_C_BINDING, ONLY: ADI_C_PreInit, ADI_C_SetupRotor, ADI_C_Init, ADI_C_End, MaxADIOutputs, ADI_C_SetRotorMotion, ADI_C_UpdateStates, ADI_C_CalcOutput, ADI_C_GetRotorLoads + use MoorDyn_C, ONLY: MD_C_Init, MD_C_End, MD_C_SetWaveFieldData, MD_C_UpdateStates, MD_C_CalcOutput + use NWTC_C_Binding, ONLY: IntfStrLen, SetErrStat_C, SetErrStat_F2C, ErrMsgLen_C, StringConvert_F2C, FileNameFromCString, AbortErrLev_C + use WaveTank_Types + use WaveTank_IO + use WaveTank_Struct + + implicit none + save + + public :: WaveTank_Init + public :: WaveTank_CalcStep + public :: WaveTank_End + + ! output to screen or to file (LabView doesn't capture console output nicely) + integer(IntKi) :: ScreenLogOutput_Un = -1 + character(1024) :: ScreenLogOutput_File + + ! Simulation data storage + type(SimSettingsType), target :: SimSettings + + ! IO data storage for CalcStep + type(CalcStepIOdataType) :: CalcStepIO + real(c_double) :: TimePrev_c + + ! Output file writing: headers, units, data, filename, fileunit etc. + type(WrOutputDataType) :: WrOutputData + + ! Structural model data storage + type(MeshesMotionType), target :: MeshMotions ! motion meshes (inputs) + type(MeshesLoadsType ), target :: MeshLoads ! load meshes (output) + type(MeshesMapsType ) :: MeshMaps ! mappings + type(StructTmpType ) :: StructTmp ! temporary data - avoids reallocation + + ! time stuff + integer(IntKi) :: VTKn_Global ! global timestep for VTK + integer(IntKi) :: VTKn_last ! last global timestep for VTK + + +!TODO: +! - add echo file +! - add summary file +! - add scaling +! - Input for scaling already in place +! - add info into summary file on scaling +! - add unscaled interface IO outputs to file as well as the regular IO currently in there +! - add pre and post scaling routines for time, pos, vel, acc, force/moment + + +contains + +subroutine WaveTank_Init( & + WT_InputFile_C, & + RootName_C, & + VTKdir_C, & + ErrStat_C, & + ErrMsg_C & +) bind (C, name='WaveTank_Init') #ifndef IMPLICIT_DLLEXPORT !DEC$ ATTRIBUTES DLLEXPORT :: WaveTank_Init !GCC$ ATTRIBUTES DLLEXPORT :: WaveTank_Init #endif -CHARACTER(KIND=C_CHAR), INTENT(IN ), TARGET :: MD_InputFile_c(IntfStrLen) -CHARACTER(KIND=C_CHAR), INTENT(IN ), TARGET :: SS_InputFile_c(IntfStrLen) -CHARACTER(KIND=C_CHAR), INTENT(IN ), TARGET :: AD_InputFile_c(IntfStrLen) -CHARACTER(KIND=C_CHAR), INTENT(IN ), TARGET :: IfW_InputFile_c(IntfStrLen) -INTEGER(C_INT), INTENT(IN ) :: n_camera_points_c -INTEGER(C_INT), INTENT( OUT) :: ErrStat_C -CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_C(ErrMsgLen_C) - -! Local variables -integer(c_int) :: numchannels_c -character(kind=c_char) :: outputchannelnames_c(100000) -character(kind=c_char) :: outputchannelunits_c(100000) -integer(c_int) :: input_file_passed = 0 ! We're passing paths to input files rather than input strings for all modules -! character(kind=c_char), pointer :: filestring_c(IntfStrLen) ! Point to input file path input argument - -print *, MD_InputFile_c -print *, SS_InputFile_c -print *, AD_InputFile_c -print *, IfW_InputFile_c - -N_CAMERA_POINTS = n_camera_points_c - -! filestring_c => MD_InputFile_c -! call MD_C_Init( & -! input_file_passed, & -! filestring_c, & -! IntfStrLen, & -! dt_c, & -! g_c, & -! rho_c, & -! depth_c, & -! ptfminit_c, & -! interporder_c, & -! numchannels_c, & -! outputchannelnames_c, & -! outputchannelunits_c, & -! ErrStat_C, ErrMsg_C & -! ) - -! call ADI_C_Init( & -! ADinputFilePassed, & ! integer(c_int), intent(in ) :: ADinputFilePassed !< Write VTK outputs [0: none, 1: init only, 2: animation] -! ADinputFileString_C, & ! type(c_ptr), intent(in ) :: ADinputFileString_C !< Input file as a single string with lines deliniated by C_NULL_CHAR -! ADinputFileStringLength_C, & ! integer(c_int), intent(in ) :: ADinputFileStringLength_C !< lenght of the input file string -! IfWinputFilePassed, & ! integer(c_int), intent(in ) :: IfWinputFilePassed !< Write VTK outputs [0: none, 1: init only, 2: animation] -! IfWinputFileString_C, & ! type(c_ptr), intent(in ) :: IfWinputFileString_C !< Input file as a single string with lines deliniated by C_NULL_CHAR -! IfWinputFileStringLength_C, & ! integer(c_int), intent(in ) :: IfWinputFileStringLength_C !< lenght of the input file string -! OutRootName_C, & ! character(kind=c_char), intent(in ) :: OutRootName_C(IntfStrLen) !< Root name to use for echo files and other -! OutVTKDir_C, & ! character(kind=c_char), intent(in ) :: OutVTKDir_C(IntfStrLen) !< Directory to put all vtk output -! gravity_C, & ! real(c_float), intent(in ) :: gravity_C !< Gravitational acceleration (m/s^2) -! defFldDens_C, & ! real(c_float), intent(in ) :: defFldDens_C !< Air density (kg/m^3) -! defKinVisc_C, & ! real(c_float), intent(in ) :: defKinVisc_C !< Kinematic viscosity of working fluid (m^2/s) -! defSpdSound_C, & ! real(c_float), intent(in ) :: defSpdSound_C !< Speed of sound in working fluid (m/s) -! defPatm_C, & ! real(c_float), intent(in ) :: defPatm_C !< Atmospheric pressure (Pa) [used only for an MHK turbine cavitation check] -! defPvap_C, & ! real(c_float), intent(in ) :: defPvap_C !< Vapour pressure of working fluid (Pa) [used only for an MHK turbine cavitation check] -! WtrDpth_C, & ! real(c_float), intent(in ) :: WtrDpth_C !< Water depth (m) -! MSL2SWL_C, & ! real(c_float), intent(in ) :: MSL2SWL_C !< Offset between still-water level and mean sea level (m) [positive upward] -! InterpOrder_C, & ! integer(c_int), intent(in ) :: InterpOrder_C !< Interpolation order to use (must be 1 or 2) -! DT_C, & ! real(c_double), intent(in ) :: DT_C !< Timestep used with AD for stepping forward from t to t+dt. Must be constant. -! TMax_C, & ! real(c_double), intent(in ) :: TMax_C !< Maximum time for simulation -! storeHHVel, & ! integer(c_int), intent(in ) :: storeHHVel !< Store hub height time series from IfW -! WrVTK_in, & ! integer(c_int), intent(in ) :: WrVTK_in !< Write VTK outputs [0: none, 1: init only, 2: animation] -! WrVTK_inType, & ! integer(c_int), intent(in ) :: WrVTK_inType !< Write VTK outputs as [1: surface, 2: lines, 3: both] -! WrVTK_inDT, & ! real(c_double), intent(in ) :: WrVTK_inDT !< Timestep between VTK writes -! VTKNacDim_in, & ! real(c_float), intent(in ) :: VTKNacDim_in(6) !< Nacelle dimension passed in for VTK surface rendering [0,y0,z0,Lx,Ly,Lz] (m) -! VTKHubRad_in, & ! real(c_float), intent(in ) :: VTKHubrad_in !< Hub radius for VTK surface rendering -! wrOuts_C, & -! DT_Outs_C, & -! NumChannels_C, & -! OutputChannelNames_C, & -! OutputChannelUnits_C, & -! ErrStat_C, ErrMsg_C & -! ) - - -! ! Input file info -! integer(c_int), intent(in ) :: ADinputFilePassed !< Write VTK outputs [0: none, 1: init only, 2: animation] -! type(c_ptr), intent(in ) :: ADinputFileString_C !< Input file as a single string with lines deliniated by C_NULL_CHAR -! integer(c_int), intent(in ) :: ADinputFileStringLength_C !< lenght of the input file string -! integer(c_int), intent(in ) :: IfWinputFilePassed !< Write VTK outputs [0: none, 1: init only, 2: animation] -! type(c_ptr), intent(in ) :: IfWinputFileString_C !< Input file as a single string with lines deliniated by C_NULL_CHAR -! integer(c_int), intent(in ) :: IfWinputFileStringLength_C !< lenght of the input file string -! character(kind=c_char), intent(in ) :: OutRootName_C(IntfStrLen) !< Root name to use for echo files and other -! character(kind=c_char), intent(in ) :: OutVTKDir_C(IntfStrLen) !< Directory to put all vtk output -! ! Environmental -! real(c_float), intent(in ) :: gravity_C !< Gravitational acceleration (m/s^2) -! real(c_float), intent(in ) :: defFldDens_C !< Air density (kg/m^3) -! real(c_float), intent(in ) :: defKinVisc_C !< Kinematic viscosity of working fluid (m^2/s) -! real(c_float), intent(in ) :: defSpdSound_C !< Speed of sound in working fluid (m/s) -! real(c_float), intent(in ) :: defPatm_C !< Atmospheric pressure (Pa) [used only for an MHK turbine cavitation check] -! real(c_float), intent(in ) :: defPvap_C !< Vapour pressure of working fluid (Pa) [used only for an MHK turbine cavitation check] -! real(c_float), intent(in ) :: WtrDpth_C !< Water depth (m) -! real(c_float), intent(in ) :: MSL2SWL_C !< Offset between still-water level and mean sea level (m) [positive upward] -! ! Interpolation -! integer(c_int), intent(in ) :: InterpOrder_C !< Interpolation order to use (must be 1 or 2) -! ! Time -! real(c_double), intent(in ) :: DT_C !< Timestep used with AD for stepping forward from t to t+dt. Must be constant. -! real(c_double), intent(in ) :: TMax_C !< Maximum time for simulation -! ! Flags -! integer(c_int), intent(in ) :: storeHHVel !< Store hub height time series from IfW -! ! VTK -! integer(c_int), intent(in ) :: WrVTK_in !< Write VTK outputs [0: none, 1: init only, 2: animation] -! integer(c_int), intent(in ) :: WrVTK_inType !< Write VTK outputs as [1: surface, 2: lines, 3: both] -! real(c_double), intent(in ) :: WrVTK_inDT !< Timestep between VTK writes -! real(c_float), intent(in ) :: VTKNacDim_in(6) !< Nacelle dimension passed in for VTK surface rendering [0,y0,z0,Lx,Ly,Lz] (m) -! real(c_float), intent(in ) :: VTKHubrad_in !< Hub radius for VTK surface rendering -! integer(c_int), intent(in ) :: wrOuts_C !< Write ADI output file -! real(c_double), intent(in ) :: DT_Outs_C !< Timestep to write output file from ADI -! ! Output -! integer(c_int), intent( out) :: NumChannels_C !< Number of output channels requested from the input file -! character(kind=c_char), intent( out) :: OutputChannelNames_C(ChanLen*MaxADIOutputs+1) !< NOTE: if MaxADIOutputs is sufficiently large, we may overrun the buffer on the Python side. -! character(kind=c_char), intent( out) :: OutputChannelUnits_C(ChanLen*MaxADIOutputs+1) -! integer(c_int), intent( out) :: ErrStat_C !< Error status -! character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) !< Error message (C_NULL_CHAR terminated) - -! Set compiler flag for Labview -! Cmpl4LV = .TRUE. - -END SUBROUTINE WaveTank_Init - -! delta_time, & -SUBROUTINE WaveTank_CalcOutput( & - frame_number, & - positions_x, & - positions_y, & - positions_z, & - rotation_matrix, & - loads, & - ErrStat_c, & - ErrMsg_c & -) BIND (C, NAME='WaveTank_CalcOutput') + character(c_char), intent(in ) :: WT_InputFile_C(IntfStrLen) + character(kind=c_char), intent( out) :: RootName_C(IntfStrLen) + character(kind=c_char), intent( out) :: VTKdir_C(IntfStrLen) + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + + integer(c_int) :: ErrStat_C2 + character(kind=c_char, len=ErrMsgLen_C) :: ErrMsg_C2 + integer(IntKi) :: ErrStat_F2 + character(ErrMsgLen) :: ErrMsg_F2 + character(1024) :: InputFile + integer(IntKi) :: i,k + integer(c_int), allocatable :: tmpMeshPtToBladeNum(:) + type(FileInfoType) :: FileInfo_In !< The derived type for holding the full input file for parsing -- we may pass this in the future + + ! debug level for passing to modules. Backing down the level by 1 for modules + integer(IntKi) :: DebugLevelMod + + ! local C variables for transferring names + character(kind=c_char) :: WrVTK_Dir_C(IntfStrLen) + character(kind=c_char) :: OutRootName_C(IntfStrLen) + + ! The length of these arrays much match what is set in the corresponding C binding modules, or be larger + character(kind=c_char) :: SS_WriteOutputHdr_C(ChanLen*MaxOutPts+1) + character(kind=c_char) :: SS_WriteOutputUnt_C(ChanLen*MaxOutPts+1) + character(kind=c_char) :: MD_WriteOutputHdr_C(ChanLen*1000) ! probably oversized + character(kind=c_char) :: MD_WriteOutputUnt_C(ChanLen*1000) ! probably oversized + character(kind=c_char) :: ADI_WriteOutputHdr_C(ChanLen*MaxADIOutputs+1) + character(kind=c_char) :: ADI_WriteOutputUnt_C(ChanLen*MaxADIOutputs+1) + + ! Filename conversions -- read in as fortran strings, but sent to other modules as c_char arrays + character(kind=c_char) :: SS_InputFile_C(IntfStrLen) + character(kind=c_char), target :: MD_InputFile_C(IntfStrLen) + character(kind=c_char), target :: AD_InputFile_C(IntfStrLen) + character(kind=c_char), target :: IfW_InputFile_C(IntfStrLen) + + ! temporary storage of number of output channels + integer(c_int) :: SS_NumChannels_C + integer(c_int) :: MD_NumChannels_C + integer(c_int) :: ADI_NumChannels_C + + ! set constants + call NWTC_Init() + + ! Initialize error handling + ErrStat_C = ErrID_None + ErrMsg_C = " "//C_NULL_CHAR + + InputFile = transfer(WT_InputFile_C, InputFile) + i = index(InputFile, char(0)) + InputFile = InputFile(1:i) + call ProcessComFile(InputFile, FileInfo_In, ErrStat_F2, ErrMsg_F2); if (Failed()) return + call ParseInputFile(FileInfo_In, SimSettings, ErrStat_F2, ErrMsg_F2); if (Failed()) return + + ! return rootname + RootName_C = c_null_char + RootName_C = transfer(trim(SimSettings%Sim%OutRootName),RootName_C) + + ! If SendScreenToFile - send to file .screen.log if true + if (SimSettings%Outs%SendScreenToFile) then + call GetNewUnit(ScreenLogOutput_Un, ErrStat_F2, ErrMsg_F2); if (Failed()) return + ScreenLogOutput_File = trim(SimSettings%Sim%OutRootName)//'.screen.log' + call OpenFOutFile(ScreenLogOutput_Un, ScreenLogOutput_File, ErrStat_F2, ErrMsg_F2); if (Failed()) return + call SetConsoleUnit(ScreenLogOutput_Un) ! this will redirect all screen output to a file instead + endif + + ! validate the settings now that the screen can be written to file + call ValidateInputFile(SimSettings, ErrStat_F2, ErrMsg_F2); if (Failed()) return + + ! debugging + if (SimSettings%Sim%DebugLevel > 0_c_int) call ShowPassedData() + if (SimSettings%Sim%DebugLevel > 2_c_int) call Print_FileInfo_Struct(CU,FileInfo_In) + + ! set debug level for modules (backing off by 1 to allow just checking wavetank io) + DebugLevelMod = max( 0_IntKi, SimSettings%Sim%DebugLevel-1_IntKi) + + ! VTK directory + WrVTK_Dir_C = c_null_char + WrVTK_Dir_C = transfer( trim(SimSettings%Viz%WrVTK_Dir), WrVTK_Dir_C ) + ! return VTKdir + VTKdir_C = c_null_char + if (SimSettings%Viz%WrVTK > 0_c_int) VTKdir_C = WrVTK_Dir_C + + ! Set a previous time (used in calcstep) + TimePrev_c = -SimSettings%Sim%DT ! we need this at T=0 + + !------------------------------ + ! Allocate temp storage + !------------------------------ + call AllocTmpStorage(ErrStat_F2, ErrMsg_F2) + if (Failed()) return + + + !------------------------------ + ! Build struct model + !------------------------------ + call StructCreate(SimSettings, MeshMotions, MeshLoads, MeshMaps, StructTmp, ErrStat_F2, ErrMsg_F2) + if (Failed()) return + + ! output VTK for struct model (if requested) + if (SimSettings%Viz%WrVTK > 0_c_int) then + ! create directory if doesn't exist + call MKDIR( trim(SimSettings%Viz%WrVTK_Dir) ) + ! write mesh refs + call WrVTK_Struct_Ref(SimSettings, MeshMotions, MeshLoads, ErrStat_F2, ErrMsg_F2) + if (Failed()) return + endif + + ! map the structural meshes (write vtk first in case of issues) + call StructCreateMeshMaps(SimSettings, MeshMotions, MeshLoads, MeshMaps, ErrStat_F2, ErrMsg_F2) + if (Failed()) return + + + !------------------------------ + ! Setup and initialize SeaState + !------------------------------ + call SeaSt_C_PreInit( & + SimSettings%Env%Gravity, & + SimSettings%Env%WtrDens, & + SimSettings%Env%WtrDpth, & + SimSettings%Env%MSL2SWL, & + DebugLevelMod, & + WrVTK_Dir_C, & + SimSettings%Viz%WrVTK, & + SimSettings%Viz%WrVTK_DT, & + ErrStat_C2, ErrMsg_C2 ) + if (Failed_c('SeaSt_C_PreInit')) return + + SS_InputFile_C = c_null_char + SS_InputFile_C = transfer(trim(SimSettings%ModSettings%SS_InputFile ), SS_InputFile_C ) + OutRootName_C = transfer(trim(SimSettings%Sim%OutRootName)//'.SeaSt'//c_null_char, OutRootName_C) + call SeaSt_C_Init( & + SS_InputFile_C, & + OutRootName_C, & + SimSettings%Sim%TMax, & + SimSettings%Sim%DT, & + SimSettings%ModSettings%WaveTimeShift, & + SS_NumChannels_C, & + SS_WriteOutputHdr_C, & + SS_WriteOutputUnt_C, & + ErrStat_C2, ErrMsg_C2 ) + if (Failed_c('SeaSt_C_Init')) return + + ! store channel info + WrOutputData%NumChans_SS = int(SS_NumChannels_c,IntKi) + call TransferOutChanNamesUnits(WrOutputData%NumChans_SS, 'WriteOutputHdr_SS', SS_WriteOutputHdr_c, WrOutputData%WriteOutputHdr_SS,ErrStat_F2,ErrMsg_F2); if (Failed()) return + call TransferOutChanNamesUnits(WrOutputData%NumChans_SS, 'WriteOutputUnt_SS', SS_WriteOutputUnt_c, WrOutputData%WriteOutputUnt_SS,ErrStat_F2,ErrMsg_F2); if (Failed()) return + + + !------------------------------ + ! Set the SeaState Wave Field pointer onto MoorDyn + !------------------------------ + call WaveTank_SetWaveFieldPointer(ErrStat_C2, ErrMsg_C2) + if (Failed_c('WaveTank_SetWaveFieldPointer')) return + + + !------------------------------ + ! Setup and initialize MoorDyn + !------------------------------ + ! set the platform position/orientation + call SetMDTmpMotion() +!FIXME: this interface will change!!! -- Split with PreInit +!FIXME: add WrVTK_Dir_C, SimSettings%Viz%WrVTK, SimSettings%Viz%WrVTK_DT + MD_InputFile_C = c_null_char + MD_InputFile_C = transfer(trim(SimSettings%ModSettings%MD_InputFile ), MD_InputFile_C ) + OutRootName_C = transfer(trim(SimSettings%Sim%OutRootName)//'.MD'//c_null_char, OutRootName_C) + call MD_C_Init( & + 0_c_int, & !< InputFilePassed: 0 for file, 1 for string + c_loc(MD_InputFile_C(1)), & + int(IntfStrLen,c_int), & !< InputFileStringLength_C + SimSettings%Sim%DT, & + SimSettings%Env%Gravity, & + SimSettings%Env%WtrDens, & + SimSettings%Env%WtrDpth, & + StructTmp%PtfmPosAng_c, & + SimSettings%Sim%InterpOrd, & + MD_NumChannels_C, & + MD_WriteOutputHdr_C, & + MD_WriteOutputUnt_C, & + ErrStat_C2, ErrMsg_C2 & + ) +!FIXME: add this when updating MD interface +! DebugLevelMod, & + if (Failed_c('MD_C_Init')) return + + ! store channel info + WrOutputData%NumChans_MD = int(MD_NumChannels_c,IntKi) + call TransferOutChanNamesUnits(WrOutputData%NumChans_MD, 'WriteOutputHdr_MD', MD_WriteOutputHdr_c, WrOutputData%WriteOutputHdr_MD,ErrStat_F2,ErrMsg_F2); if (Failed()) return + call TransferOutChanNamesUnits(WrOutputData%NumChans_MD, 'WriteOutputUnt_MD', MD_WriteOutputUnt_c, WrOutputData%WriteOutputUnt_MD,ErrStat_F2,ErrMsg_F2); if (Failed()) return + + !------------------------------ + ! Setup and initialize AeroDyn+Inflow + !------------------------------ + call ADI_C_PreInit( & + 1_c_int, & ! only one turbine + 0_c_int, & ! transpose DCM inside ADI (0=false) + 1_c_int, & ! PointLoadOutput - use line to point load mapping -- necessary for mapping to blade root without an actual blade structure + SimSettings%Env%Gravity, & + SimSettings%Env%WtrDens, & + SimSettings%Env%WtrVisc, & + SimSettings%Env%SpdSound, & + SimSettings%Env%Patm, & + SimSettings%Env%Pvap, & + SimSettings%Env%WtrDpth, & + SimSettings%Env%MSL2SWL, & + SimSettings%Sim%MHK, & + 0_c_int, & ! externFlowfield_in + WrVTK_Dir_C, & ! vtk directory to use + SimSettings%Viz%WrVTK, & ! VTK visualization data output: (switch) {0=none; 1=initialization data only; 2=animation; 3=mode shapes} + SimSettings%Viz%WrVTK_Type, & ! Type of VTK visualization data: (switch) {1=surfaces; 2=basic meshes (lines/points); 3=all meshes (debug)} [unused if WrVTK=0] + SimSettings%Viz%WrVTK_DT, & ! timestep of VTK writing + SimSettings%Viz%VTKNacDim, & ! Nacelle dimension passed in for VTK surface rendering [0,y0,z0,Lx,Ly,Lz] (m) + SimSettings%TrbCfg%HubRad, & ! Hub radius for VTK surface rendering + DebugLevelMod, & + ErrStat_C2, ErrMsg_C2 & + ) + call SetErrStat_C(ErrStat_C2, ErrMsg_C2, ErrStat_C, ErrMsg_C, 'ADI_C_PreInit') + if (ErrStat_C >= AbortErrLev_C) then + call CleanUp() + return + endif + + ! Nacelle motion + call SetADITmpNacMotion() + + ! Hub motion + call SetADITmpHubMotion() + + ! Blade motion + call SetADITmpBldMotion() + + ! Mapping - one mesh point for each blade + call AllocAry(tmpMeshPtToBladeNum, 2, "tmpMeshPtToBladeNum", ErrStat_F2, ErrMsg_F2); if (Failed()) return + do k=1,SimSettings%TrbCfg%NumBl + tmpMeshPtToBladeNum(k) = k + enddo + + ! Setup the rotor + call ADI_C_SetupRotor(1_c_int, 1_c_int, & ! iWT -- turbine number, IsHAWT=True + StructTmp%PtfmPosAng_c(1:3), & ! Only x,y,z location, no orientation + StructTmp%HubPos_c, StructTmp%HubDCM_c, & ! HubPos, Hub orientation DCM, + StructTmp%NacPos_c, StructTmp%NacDCM_c, & ! NacPos, Nac orientation DCM, + int(SimSettings%TrbCfg%NumBl,c_int), & ! NumBlades + StructTmp%BldPos_c, StructTmp%BldDCM_c, & ! Blade root positions, blade root orientation DCM (flattened, concatenated) + int(SimSettings%TrbCfg%NumBl,c_int), & ! Num mesh points (only one per blade) + StructTmp%BldPos_c, StructTmp%BldDCM_c, & ! Blade root positions, blade root orientation DCM (flattened, concatenated) + tmpMeshPtToBladeNum, & ! MeshPtToBladeNum + ErrStat_C2, ErrMsg_C2 ) + if (Failed_c('ADI_C_SetupRotor')) return + + AD_InputFile_C = c_null_char + AD_InputFile_C = transfer(trim(SimSettings%ModSettings%AD_InputFile ), AD_InputFile_C ) + IfW_InputFile_C = c_null_char + IfW_InputFile_C = transfer(trim(SimSettings%ModSettings%IfW_InputFile), IfW_InputFile_C) + OutRootName_C = transfer(trim(SimSettings%Sim%OutRootName)//'.ADI'//c_null_char, OutRootName_C) + call ADI_C_Init( & + 0, & ! ADinputFilePassed; 0 for file, 1 for string + c_loc(AD_InputFile_C(1)), & ! ADinputFileString_C; Input file as a single string with lines delineated by C_NULL_CHAR + IntfStrLen, & ! ADinputFileStringLength_C; length of the input file string + 0, & ! IfWinputFilePassed; 0 for file, 1 for string + c_loc(IfW_InputFile_C(1)), & ! IfWinputFileString_C; Input file as a single string with lines delineated by C_NULL_CHAR + IntfStrLen, & ! IfWinputFileStringLength_C; length of the input file string + OutRootName_C, & ! Root name to use for echo files and other + SimSettings%Sim%InterpOrd, & ! interpolation order for extrap/interp + SimSettings%Sim%DT, & ! DT for simulation (used in checks only) + SimSettings%Sim%TMax, & ! Max time for simulation (not used here) + 0_c_int, & ! storeHHVel - Store hub height time series from IfW -- set to false since not used here + 1_c_int, & ! wrOuts_C -- Write ADI output file -- hard code to true for now + SimSettings%Sim%DT, & ! Timestep to write output file from ADI + ADI_NumChannels_C, ADI_WriteOutputHdr_C, ADI_WriteOutputUnt_C, & + ErrStat_C2, ErrMsg_C2) + if (Failed_c('ADI_C_Init')) return + + ! store channel info + WrOutputData%NumChans_ADI = int(ADI_NumChannels_c,IntKi) + call TransferOutChanNamesUnits(WrOutputData%NumChans_ADI, 'WriteOutputHdr_ADI', ADI_WriteOutputHdr_c, WrOutputData%WriteOutputHdr_ADI, ErrStat_F2, ErrMsg_F2); if (Failed()) return + call TransferOutChanNamesUnits(WrOutputData%NumChans_ADI, 'WriteOutputUnt_ADI', ADI_WriteOutputUnt_c, WrOutputData%WriteOutputUnt_ADI, ErrStat_F2, ErrMsg_F2); if (Failed()) return + + + !------------------------------ + ! Assemble data for output file + !------------------------------ + if (SimSettings%Outs%OutFile > 0_IntKi) then + WrOutputData%OutName = trim(SimSettings%Sim%OutRootName)//'.out' + call InitOutputFile(WrOutputData,ErrStat_F2,ErrMsg_F2); if (Failed()) return + + ! allocate storage for output channels from each of the modules, and c_float versions + call AllocAry(WrOutputData%OutData_SS, WrOutputData%Numchans_SS, 'OutData_SS', ErrStat_F2, ErrMsg_F2); if (Failed()) return + call AllocAry(WrOutputData%OutData_SS_c, WrOutputData%Numchans_SS, 'OutData_SS_c', ErrStat_F2, ErrMsg_F2); if (Failed()) return + call AllocAry(WrOutputData%OutData_MD, WrOutputData%Numchans_MD, 'OutData_MD', ErrStat_F2, ErrMsg_F2); if (Failed()) return + call AllocAry(WrOutputData%OutData_MD_c, WrOutputData%Numchans_MD, 'OutData_MD_c', ErrStat_F2, ErrMsg_F2); if (Failed()) return + call AllocAry(WrOutputData%OutData_ADI, WrOutputData%Numchans_ADI, 'OutData_ADI', ErrStat_F2, ErrMsg_F2); if (Failed()) return + call AllocAry(WrOutputData%OutData_ADI_c, WrOutputData%Numchans_ADI, 'OutData_ADI_c', ErrStat_F2, ErrMsg_F2); if (Failed()) return + endif + + !------------------------------ + ! Final cleanup + !------------------------------ + ! Initialize time counting for VTK + VTKn_Global = 0_IntKi + VTKn_last = -1_IntKi + call ShowReturnData() + +contains + logical function Failed_c(txt) + character(*), intent(in) :: txt + call SetErrStat_C(ErrStat_C2, ErrMsg_C2, ErrStat_C, ErrMsg_C, txt) + Failed_c = ErrStat_C >= AbortErrLev_C + if (Failed_c) call CleanUp() + end function Failed_c + logical function Failed() + call SetErrStat_F2C(ErrStat_F2, ErrMsg_F2, ErrStat_C, ErrMsg_C) + Failed = ErrStat_C >= AbortErrLev_C + if (Failed) call Cleanup() + end function Failed + subroutine Cleanup() + call NWTC_Library_DestroyFileInfoType(FileInfo_In, ErrStat_F2, ErrMsg_F2) ! ignore error from this + if (ScreenLogOutput_Un > 0) close(ScreenLogOutput_Un) + if (allocated(tmpMeshPtToBladeNum)) deallocate(tmpMeshPtToBladeNum) + end subroutine Cleanup + subroutine ShowPassedData() + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: WaveTank_Init input values") + call WrScr(" --------------------------------------------------------") + call WrScr(" WT_InputFile_C -> "//trim(InputFile)) + call WrScr(" --------------------------------------------------------") + end subroutine ShowPassedData + subroutine ShowReturnData() + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: WaveTank_Init returned values") + call WrScr(" --------------------------------------------------------") + call WrScr(" RootName_C <- "//trim(SimSettings%Sim%OutRootName)) + call WrScr(" WrVTK_Dir_C <- "//trim(SimSettings%Viz%WrVTK_Dir)) + call WrScr("-----------------------------------------------------------") + end subroutine + subroutine AllocTmpStorage(ErrStat3,ErrMsg3) + integer(IntKi), intent(out) :: ErrStat3 + character(ErrMsgLen), intent(out) :: ErrMsg3 + call AllocAry(CalcStepIO%FrcMom_ADI_c, 6*SimSettings%TrbCfg%NumBl, 'FrcMom_ADI_c', ErrStat3, ErrMsg3); if (ErrStat3 /= ErrID_None) return + call AllocAry(StructTmp%BldPos_c, 3*SimSettings%TrbCfg%NumBl, 'TmpBldPos_c', ErrStat3, ErrMsg3); if (ErrStat3 /= ErrID_None) return + call AllocAry(StructTmp%BldDCM_c, 9*SimSettings%TrbCfg%NumBl, 'TmpBldDCM_c', ErrStat3, ErrMsg3); if (ErrStat3 /= ErrID_None) return + call AllocAry(StructTmp%BldVel_c, 6*SimSettings%TrbCfg%NumBl, 'TmpBldVel_c', ErrStat3, ErrMsg3); if (ErrStat3 /= ErrID_None) return + call AllocAry(StructTmp%BldAcc_c, 6*SimSettings%TrbCfg%NumBl, 'TmpBldAcc_c', ErrStat3, ErrMsg3); if (ErrStat3 /= ErrID_None) return + end subroutine +end subroutine WaveTank_Init + +!subroutine DeallocEverything() +!end subroutine DeallocEverything + + +!> Step from T-dt to T and output values at T +subroutine WaveTank_CalcStep( & + time_c, & + pos_c, & + vel_c, & + acc_c, & + loads_c, & + buoyWaveElev_c, & + ErrStat_C, & + ErrMsg_C & +) BIND (C, NAME='WaveTank_CalcStep') +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: WaveTank_CalcStep +!GCC$ ATTRIBUTES DLLEXPORT :: WaveTank_CalcStep +#endif + real(c_double), intent(in ) :: time_c + real(c_float), intent(in ) :: pos_c(6) ! [x,y,z,roll,pitch,yaw] + real(c_float), intent(in ) :: vel_c(6) ! [x_dot,y_dot,z_dot,roll_dot,pitch_dot,yaw_dot] + real(c_float), intent(in ) :: acc_c(6) ! [x_ddot,y_ddot,z_ddot,roll_ddot,pitch_ddot,yaw_ddot] + real(c_float), intent( out) :: loads_c(6) ! [Fx,Fy,Fz,Mx,My,Mz] + real(c_float), intent( out) :: buoyWaveElev_c ! wave elevation at buoy + integer(c_int), intent( out) :: ErrStat_C + character(c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + integer(c_int) :: ErrStat_C2 + character(c_char) :: ErrMsg_C2(ErrMsgLen_C) + integer(IntKi) :: ErrStat_F2 + character(ErrMsgLen) :: ErrMsg_F2 + integer(IntKi) :: i + + ! Initialize error handling + ErrStat_C = ErrID_None + ErrMsg_C = " "//C_NULL_CHAR + + + ! debugging + if (SimSettings%Sim%DebugLevel > 0_c_int) call ShowPassedData() + + ! zero loads in case of error + loads_c = 0.0_c_float + + ! Transfer CalcStepIO data (storing for output to file) + CalcStepIO%Time_c = time_C + CalcStepIO%PosAng_c = pos_c + CalcStepIO%Vel_c = vel_c + CalcStepIO%Acc_c = acc_c + + + !-------------------------------------- + ! Update motion meshes + !-------------------------------------- + call StructMotionUpdate(SimSettings, CalcStepIO, MeshMotions, MeshMaps, StructTmp, ErrStat_F2, ErrMsg_F2) + if (Failed()) return + + + !-------------------------------------- + ! Wave elevation at buoy, update buoy + !-------------------------------------- + StructTmp%BuoyPos_c(1:2) = real(SimSettings%WaveBuoy%XYLoc, c_float) + call SeaSt_C_GetSurfElev(Time_C, StructTmp%BuoyPos_c(1:2), buoyWaveElev_c, ErrStat_C2, ErrMsg_C2) + call SetErrStat_C(ErrStat_C2, ErrMsg_C2, ErrStat_C, ErrMsg_C, 'WaveTank_CalcStep::SeaSt_C_GetSurfElev') + if (ErrStat_C >= AbortErrLev_C) return + MeshMotions%WaveBuoyMotion%TranslationDisp(:,1) = (/ 0.0_ReKi, 0.0_ReKi, real(buoyWaveElev_c, ReKi) /) + + + !-------------------------------------- + ! Write VTK if requested + ! Do this here in case failed calcs + !-------------------------------------- + if (SimSettings%Viz%WrVTK > 0_c_int) then + ! only write on desired time interval (same logic used in c-binding modules) + VTKn_Global = nint(Time_C / SimSettings%Viz%WrVTK_DT) + if (VTKn_Global /= VTKn_last) then ! already wrote this one + VTKn_last = VTKn_Global ! store the current number to make sure we don't write it twice + call WrVTK_Struct(VTKn_Global, SimSettings, MeshMotions, MeshLoads, ErrStat_F2, ErrMsg_F2) + if (Failed()) return + endif + endif + + + !-------------------------------------- + ! call SeaState_Calc (writes vis) + !-------------------------------------- + call SeaSt_C_CalcOutput(Time_C, WrOutputData%OutData_SS_c, ErrStat_C, ErrMsg_C) + call SetErrStat_C(ErrStat_C2, ErrMsg_C2, ErrStat_C, ErrMsg_C, 'WaveTank_CalcStep::SeaSt_C_CalcOutput') + if (ErrStat_C >= AbortErrLev_C) return + ! transfer data for writing out + WrOutputData%OutData_SS = real(WrOutputData%OutData_SS_c, ReKi) + + + !-------------------------------------- + ! MD calculations + !-------------------------------------- + ! Platform positions at T + call SetMDTmpMotion() + + ! Update to T+DT + call MD_C_UpdateStates(TimePrev_c, Time_c, StructTmp%PtfmPosAng_c, StructTmp%PtfmVel_c, StructTmp%PtfmAcc_c, ErrStat_C2, ErrMsg_C2) + call SetErrStat_C(ErrStat_C2, ErrMsg_C2, ErrStat_C, ErrMsg_C, 'WaveTank_CalcStep::MD_C_UpdateStates') + if (ErrStat_C >= AbortErrLev_C) return + + ! get loads at T+DT + call MD_C_CalcOutput(Time_c, StructTmp%PtfmPosAng_c, StructTmp%PtfmVel_c, StructTmp%PtfmAcc_c, CalcStepIO%FrcMom_MD_c, WrOutputData%OutData_MD, ErrStat_C2, ErrMsg_C2) + call SetErrStat_C(ErrStat_C2, ErrMsg_C2, ErrStat_C, ErrMsg_C, 'WaveTank_CalcStep::MD_C_CalcOutput') + if (ErrStat_C >= AbortErrLev_C) return + + ! Put mooring loads onto mesh + call SetMDMeshLoads() + + + !-------------------------------------- + ! ADI calculations + !-------------------------------------- + ! Nacelle motion + call SetADITmpNacMotion() + + ! Hub motion + call SetADITmpHubMotion() + + ! Blade motion + call SetADITmpBldMotion() + + ! Set the rotor motion (assumed single rotor) + ! NOTE: ADI handles blade root and mesh seaparately. For our purposes, + ! the blade root and the first mesh node of the blade (using only + ! one point for a rigid blade) are identical. + call ADI_C_SetRotorMotion( 1_IntKi, & ! rotor number + StructTmp%HubPos_c, StructTmp%HubDCM_c, StructTmp%HubVel_c, StructTmp%HubAcc_c, & + StructTmp%NacPos_c, StructTmp%NacDCM_c, StructTmp%NacVel_c, StructTmp%NacAcc_c, & + StructTmp%BldPos_c, StructTmp%BldDCM_c, StructTmp%BldVel_c, StructTmp%BldAcc_c, & + int(SimSettings%TrbCfg%NumBl, c_int), & ! Number of mesh points (number of blade roots) + StructTmp%BldPos_c, StructTmp%BldDCM_c, StructTmp%BldVel_c, StructTmp%BldAcc_c, & + ErrStat_C2, ErrMsg_C2 ) + call SetErrStat_C(ErrStat_C2, ErrMsg_C2, ErrStat_C, ErrMsg_C, 'WaveTank_CalcStep::ADI_C_SetRotorMotion') + if (ErrStat_C >= AbortErrLev_C) return + + ! Update ADI states to next time + call ADI_C_UpdateStates(TimePrev_c, Time_c, ErrStat_C2, ErrMsg_C2) + call SetErrStat_C(ErrStat_C2, ErrMsg_C2, ErrStat_C, ErrMsg_C, 'WaveTank_CalcStep::ADI_C_UpdateStates') + if (ErrStat_C >= AbortErrLev_C) return + + ! calculate outputs from ADI + call ADI_C_CalcOutput(Time_c, WrOutputData%OutData_ADI, ErrStat_C2, ErrMsg_C2) + call SetErrStat_C(ErrStat_C2, ErrMsg_C2, ErrStat_C, ErrMsg_C, 'WaveTank_CalcStep::ADI_C_CalcOutput') + if (ErrStat_C >= AbortErrLev_C) return + + ! get loads from rotor (assumed single rotor) + call ADI_C_GetRotorLoads( 1_IntKi, & ! rotor number + int(SimSettings%TrbCfg%NumBl, c_int), & ! Number of mesh points (number of blade roots) + CalcStepIO%FrcMom_ADI_c, & ! 6xNumMeshPts_C array [Fx,Fy,Fz,Mx,My,Mz] -- forces and moments (global) + CalcStepIO%HubVel_ADI_c, & ! Wind speed array [Vx,Vy,Vz] -- (m/s) (global) + ErrStat_C2, ErrMsg_C2 ) + call SetErrStat_C(ErrStat_C2, ErrMsg_C2, ErrStat_C, ErrMsg_C, 'WaveTank_CalcStep::ADI_C_GetRotorLoads') + if (ErrStat_C >= AbortErrLev_C) return + + ! Set load on blade root mesh + call SetADIMeshLoads() + + + !-------------------------------------- + ! Transfer mesh loads back to platform + !-------------------------------------- + call StructLoadsMeshTransfer(SimSettings, CalcStepIO, MeshMotions, MeshLoads, MeshMaps, StructTmp, ErrStat_F2, ErrMsg_F2) + if (Failed()) return + + ! set output loads at platform + CalcStepIO%FrcMom_C(1:3) = real(MeshLoads%PtfmPtLoads%Force(1:3,1), c_float) + CalcStepIO%FrcMom_C(4:6) = real(MeshLoads%PtfmPtLoads%Moment(1:3,1), c_float) + loads_c = CalcStepIO%FrcMom_C + + ! debugging + if (SimSettings%Sim%DebugLevel > 0_c_int) call ShowReturnData() + + ! Transfer outputs and write to file + if (SimSettings%Outs%OutFile > 0_IntKi) then + ! output to file + call WriteOutputLine(SimSettings%Outs%OutFmt, CalcStepIO, StructTmp, WrOutputData, ErrStat_F2, ErrMsg_F2) + if (Failed()) return + endif + + ! keep track of the time + if (Time_c > TimePrev_c) TimePrev_c = Time_c + + +contains + logical function Failed() + call SetErrStat_F2C(ErrStat_F2, ErrMsg_F2, ErrStat_C, ErrMsg_C) + Failed = ErrStat_C >= AbortErrLev_C + !if (Failed) call Cleanup() + end function Failed + subroutine ShowPassedData() + character(120) :: TmpStr + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: WaveTank_CalcStep input values") + call WrScr(" --------------------------------------------------------") + call WrScr(" time_c -> "//trim(Num2LStr(time_c))) + write(TmpStr,'("(", *(f10.5, :, ","))') pos_c; TmpStr=trim(TmpStr)//" )" + call WrScr(" pos_c -> "//trim(TmpStr)) + write(TmpStr,'("(", *(f10.5, :, ","))') vel_c; TmpStr=trim(TmpStr)//" )" + call WrScr(" vel_c -> "//trim(TmpStr)) + write(TmpStr,'("(", *(f10.5, :, ","))') acc_c; TmpStr=trim(TmpStr)//" )" + call WrScr(" acc_c -> "//trim(TmpStr)) + call WrScr(" --------------------------------------------------------") + end subroutine ShowPassedData + subroutine ShowReturnData() + character(120) :: TmpStr + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: WaveTank_CalcStep returned values") + call WrScr(" --------------------------------------------------------") + write(TmpStr,'("(", *(f14.2, :, ","))') loads_c; TmpStr=trim(TmpStr)//" )" + call WrScr(" loads_c <- "//trim(TmpStr)) + call WrScr(" buoyWaveElev_c <- "//trim(Num2LStr(buoyWaveElev_c))) + call WrScr("-----------------------------------------------------------") + end subroutine +end subroutine + + + + + +!--------------------------------- +! routines to copy mesh info to temporary vars for transfer +subroutine SetMDTmpMotion() + type(MeshType), pointer :: Ptfm + Ptfm => MeshMotions%PtfmPtMotion + StructTmp%PtfmPosAng_c(1:3) = real(Ptfm%Position(1:3,1), c_float) + real(Ptfm%TranslationDisp(1:3,1), c_float) + StructTmp%PtfmPosAng_c(4:6) = real(CalcStepIO%PosAng_c(4:6), c_float) ! Euler angle set -- used to set Orientation + StructTmp%PtfmVel_c(1:3) = real(Ptfm%TranslationVel(1:3,1), c_float) + StructTmp%PtfmVel_c(4:6) = real(Ptfm%RotationVel(1:3,1), c_float) + StructTmp%PtfmAcc_c(1:3) = real(Ptfm%TranslationAcc(1:3,1), c_float) + StructTmp%PtfmAcc_c(4:6) = real(Ptfm%RotationAcc(1:3,1), c_float) +end subroutine + +subroutine SetMDMeshLoads() + type(MeshType), pointer :: MoorLd + integer(IntKi) :: i1,i2 + MoorLd => MeshLoads%MooringLoads + MoorLd%Force(1:3,1) = real(CalcStepIO%FrcMom_MD_c(1:3), ReKi) + MoorLd%Moment(1:3,1) = real(CalcStepIO%FrcMom_MD_c(4:6), ReKi) +end subroutine + +subroutine SetADITmpNacMotion() +! NOTE: we are treating the nacelle as the tower top and simply using that location +! NOTE: the nacelle drag isn't getting returned anyhow + type(MeshType), pointer :: Twr + Twr => MeshMotions%TowerMotion + StructTmp%NacPos_c(1:3) = real(Twr%Position(1:3,2), c_float) + real(Twr%TranslationDisp(1:3,2), c_float) + StructTmp%NacDCM_c(1:9) = real(reshape(Twr%Orientation(1:3,1:3,2), (/9/)), c_float) + StructTmp%NacVel_c(1:3) = real(Twr%TranslationVel(1:3,2), c_float) + StructTmp%NacVel_c(4:6) = real(Twr%RotationVel(1:3,2), c_float) + StructTmp%NacAcc_c(1:3) = real(Twr%TranslationAcc(1:3,2), c_float) + StructTmp%NacAcc_c(4:6) = real(Twr%RotationAcc(1:3,2), c_float) +end subroutine + +subroutine SetADITmpHubMotion() + type(MeshType), pointer :: Hub + Hub => MeshMotions%HubMotion + StructTmp%HubPos_c(1:3) = real(Hub%Position(1:3,1), c_float) + real(Hub%TranslationDisp(1:3,1), c_float) + StructTmp%HubDCM_c(1:9) = real(reshape(Hub%Orientation(1:3,1:3,1), (/9/)), c_float) + StructTmp%HubVel_c(1:3) = real(Hub%TranslationVel(1:3,1), c_float) + StructTmp%HubVel_c(4:6) = real(Hub%RotationVel(1:3,1), c_float) + StructTmp%HubAcc_c(1:3) = real(Hub%TranslationAcc(1:3,1), c_float) + StructTmp%HubAcc_c(4:6) = real(Hub%RotationAcc(1:3,1), c_float) +end subroutine + +subroutine SetADITmpBldMotion() + type(MeshType), pointer :: Root + integer(IntKi) :: k,i1,i2 + do k=1,SimSettings%TrbCfg%NumBl + Root => MeshMotions%BladeRootMotion(k) + ! position -- x,y,z + i1=(k-1)*3+1; i2=i1+2 + StructTmp%BldPos_c(i1:i2) = real(Root%Position(1:3,1), c_float) + real(Root%TranslationDisp(1:3,1), c_float) + ! orientation DCM unpacked flat -- 9 elements + i1=(k-1)*9+1; i2=i1+8 + StructTmp%BldDCM_c(i1:i2) = real(reshape(Root%Orientation(1:3,1:3,1),(/9/)), c_float) + ! Translation Vel / Accel -- TVx,TVy,TVz / TAx, TAy, TAz + i1=(k-1)*6+1; i2=i1+2 + StructTmp%BldVel_c(i1:i2) = real(Root%TranslationVel(1:3,1), c_float) + StructTmp%BldAcc_c(i1:i2) = real(Root%TranslationAcc(1:3,1), c_float) + ! Rotation Vel / Accel -- RVx,RVy,RVz / RAx, RAy, RAz + i1=(k-1)*6+4; i2=i1+2 + StructTmp%BldVel_c(i1:i2) = real(Root%RotationVel(1:3,1), c_float) + StructTmp%BldAcc_c(i1:i2) = real(Root%RotationAcc(1:3,1), c_float) + enddo +end subroutine + +subroutine SetADIMeshLoads() + type(MeshType), pointer :: RootLd + integer(IntKi) :: k,i1,i2 + do k=1,SimSettings%TrbCfg%NumBl + RootLd => MeshLoads%BladeRootLoads(k) + ! Forces + i1=(k-1)*6+1; i2=i1+2 + RootLd%Force(1:3,1) = real(CalcStepIO%FrcMom_ADI_c(i1:i2), ReKi) + ! Momment + i1=(k-1)*6+4; i2=i1+2 + RootLd%Moment(1:3,1) = real(CalcStepIO%FrcMom_ADI_c(i1:i2), ReKi) + enddo +end subroutine + + + +subroutine WaveTank_End(ErrStat_C, ErrMsg_C) bind (C, NAME="WaveTank_End") #ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: WaveTank_CalcOutput -!GCC$ ATTRIBUTES DLLEXPORT :: WaveTank_CalcOutput +!DEC$ ATTRIBUTES DLLEXPORT :: WaveTank_End +!GCC$ ATTRIBUTES DLLEXPORT :: WaveTank_End #endif -! INTEGER(C_INT) :: delta_time -INTEGER(C_INT) :: frame_number -REAL(C_FLOAT), INTENT(IN ) :: positions_x(N_CAMERA_POINTS) -REAL(C_FLOAT), INTENT(IN ) :: positions_y(N_CAMERA_POINTS) -REAL(C_FLOAT), INTENT(IN ) :: positions_z(N_CAMERA_POINTS) -REAL(C_FLOAT), INTENT(IN ) :: rotation_matrix(9) -REAL(C_FLOAT), INTENT( OUT) :: loads(N_CAMERA_POINTS) -INTEGER(C_INT), INTENT( OUT) :: ErrStat_C -CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_C(ErrMsgLen_C) + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) -INTEGER :: i + ! Local variables + integer(c_int) :: ErrStat_C2 + character(kind=c_char, len=ErrMsgLen_C) :: ErrMsg_C2 + integer(IntKi) :: ErrStat_F2 + character(ErrMsgLen) :: ErrMsg_F2 -IF ( MOD(frame_number / load_period, 2) == 0 ) THEN - loads = -1.0 -ELSE - loads = 1.0 -ENDIF + ErrStat_C = ErrID_None + ErrMsg_C = " "//C_NULL_CHAR -END SUBROUTINE + ! destroy mesh info + call StructDestroy(MeshMotions, MeshLoads, MeshMaps, StructTmp, ErrStat_F2, ErrMsg_F2) + call SetErrStat_F2C(ErrStat_F2, ErrMsg_F2, ErrStat_C, ErrMsg_C) -SUBROUTINE WaveTank_End() bind (C, NAME="WaveTank_End") + ! in case we were writing to a file instead of the screen + if (ScreenLogOutput_Un > 0) close(ScreenLogOutput_Un) + call MD_C_END(ErrStat_C2, ErrMsg_C2) + call SetErrStat_C(ErrStat_C2, ErrMsg_C2, ErrStat_C, ErrMsg_C, 'MD_C_END') -IMPLICIT NONE + call SeaSt_C_END(ErrStat_C2, ErrMsg_C2) + call SetErrStat_C(ErrStat_C2, ErrMsg_C2, ErrStat_C, ErrMsg_C, 'SeaSt_C_END') + call ADI_C_END(ErrStat_C2, ErrMsg_C2) + call SetErrStat_C(ErrStat_C2, ErrMsg_C2, ErrStat_C, ErrMsg_C, 'ADI_C_END') + ! close output file + if (WrOutputData%OutUn > 0) then + close(WrOutputData%OutUn, iostat=ErrStat_F2) + if (ErrStat_F2 /= 0_IntKi) call SetErrStat_C(int(ErrID_Fatal,c_int), 'could no close output file '//trim(WrOutputData%OutName), ErrStat_C, ErrMsg_C, 'ADI_C_END') + WrOutputData%OutUn = -1 ! mark as closed - prevents faults + endif +end subroutine -END SUBROUTINE -end module WaveTankTesting +subroutine WaveTank_SetWaveFieldPointer(ErrStat_C, ErrMsg_C) bind (C, NAME="WaveTank_SetWaveFieldPointer") +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: WaveTank_SetWaveFieldPointer +!GCC$ ATTRIBUTES DLLEXPORT :: WaveTank_SetWaveFieldPointer +#endif + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + integer(c_int) :: ErrStat_C2 + character(kind=c_char, len=ErrMsgLen_C) :: ErrMsg_C2 + + ! Set the SeaState FlowField pointer onto MoorDyn + type(c_ptr) :: WaveFieldPointer_C + type(SeaSt_WaveFieldType), pointer :: WaveFieldPointer_F => NULL() ! used only in sanity check + + ErrStat_C = ErrID_None + ErrMsg_C = " "//C_NULL_CHAR + + call SeaSt_C_GetWaveFieldPointer(WaveFieldPointer_C, ErrStat_C2, ErrMsg_C2) + call SetErrStat_C(ErrStat_C2, ErrMsg_C2, ErrStat_C, ErrMsg_C, 'WaveTank_SetWaveFieldPointer') + if (ErrStat_C >= AbortErrLev_C) return + + call C_F_POINTER(WaveFieldPointer_C, WaveFieldPointer_F) + ! Verify that the data in the WaveField pointer has been set + if (WaveFieldPointer_F%WtrDpth == 0) then + ErrStat_C2 = ErrID_Fatal + ErrMsg_C2 = "SeaState WaveFieldPointer is WtrDpth is 0.0, so it it probably not initialized." + call SetErrStat_C(ErrStat_C2, ErrMsg_C2, ErrStat_C, ErrMsg_C, 'WaveTank_SetWaveFieldPointer') + return + endif + + ! There isn't a good way to check for an error here. Will get caught at init + call MD_C_SetWaveFieldData(WaveFieldPointer_C) + + ! Probably doesn't matter, but clear the fortran pointer just in case + WaveFieldPointer_F => NULL() +end subroutine + +END MODULE WaveTankTesting diff --git a/glue-codes/labview/src/WaveTank_IO.f90 b/glue-codes/labview/src/WaveTank_IO.f90 new file mode 100644 index 0000000000..ab7cd5f84c --- /dev/null +++ b/glue-codes/labview/src/WaveTank_IO.f90 @@ -0,0 +1,398 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2025 National Renewable Energy Laboratory +! +! This file is a module specific to an experimental wave tank at NREL. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!********************************************************************************************************************************** +! +! This code is designed to connect with LabView for a specific wave tank test case and likely will not work for other purposes. +! +! For this test, a physical platform is deployed in a wave tank with cable acutators that are controlled through LabView. This +! module is called to provide some loads that are not present in the physical tank setup. These include the following: +! - rotor loading from a fixed RPM MHK rotor from AeroDyn. This is calculated from either steady current provided by SeaState +! - Mooring loads from MoorDyn +! +! +!********************************************************************************************************************************** +MODULE WaveTank_IO + use ISO_C_BINDING + use NWTC_Library + use NWTC_IO + use WaveTank_Types + + implicit none + private + + public :: ParseInputFile + public :: ValidateInputFile + public :: TransferOutChanNamesUnits + public :: InitOutputFile + public :: WriteOutputLine + + ! These channels are output by default + integer(IntKi), parameter :: NumDefChans = 42 + character(OutStrLenM1), parameter :: DefChanNames(NumDefChans) = (/ "Time ", & + "Ptfm_x ","Ptfm_y ","Ptfm_z ", & ! position (absolute global) + "Ptfm_Rx ","Ptfm_Ry ","Ptfm_Rz ", & ! Euler angles phi,theta,psi + "Ptfm_Vx ","Ptfm_Vy ","Ptfm_Vz ", & ! translation vel + "Ptfm_RVx ","Ptfm_RVy ","Ptfm_RVz ", & ! rotation vel + "Ptfm_Ax ","Ptfm_Ay ","Ptfm_Az ", & ! translation acc + "Ptfm_RAx ","Ptfm_RAy ","Ptfm_RAz ", & ! rotation acc + "Ptfm_Fx ","Ptfm_Fy ","Ptfm_Fz ", & ! Forces total + "Ptfm_Mx ","Ptfm_My ","Ptfm_Mz ", & ! Moments total + "Ptfm_MD_Fx ","Ptfm_MD_Fy ","Ptfm_MD_Fz ", & ! Forces from MD + "Ptfm_MD_Mx ","Ptfm_MD_My ","Ptfm_MD_Mz ", & ! Moments from MD + "Ptfm_ADI_Fx ","Ptfm_ADI_Fy ","Ptfm_ADI_Fz ", & ! Forces from ADI + "Ptfm_ADI_Mx ","Ptfm_ADI_My ","Ptfm_ADI_Mz ", & ! Moments from ADI + "Azimuth ","RotSpeed ","BlPitch ", & + "NacYaw ","BuoyElev " & + /) + character(OutStrLenM1), parameter :: DefChanUnits(NumDefChans) = (/ "(s) ", & + "(m) ","(m) ","(m) ", & + "(rad) ","(rad) ","(rad) ", & + "(m/s) ","(m/s) ","(m/s) ", & + "(rad/s) ","(rad/s) ","(rad/s) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(rad/s^2) ","(rad/s^2) ","(rad/s^2) ", & + "(N) ","(N) ","(N) ", & ! Forces total + "(N-m) ","(N-m) ","(N-m) ", & ! Moments total + "(N) ","(N) ","(N) ", & ! Forces from MD + "(N-m) ","(N-m) ","(N-m) ", & ! Moments from MD + "(N) ","(N) ","(N) ", & ! Forces from ADI + "(N-m) ","(N-m) ","(N-m) ", & ! Moments from ADI + "(deg) ","(RPM) ","(deg) ", & + "(deg) ","(m) " & + /) + +contains + +subroutine ParseInputFile(FileInfo_In, SimSettings, ErrStat, ErrMsg) + type(FileInfoType), intent(in ) :: FileInfo_In !< The derived type for holding the file information. + type(SimSettingsType), intent( out) :: SimSettings + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + + ! Local variables + integer :: CurLine + character(1024), target :: TmpPath + character(1024) :: FileName + integer(IntKi) :: ErrStat2 ! local status of error message + character(ErrMsgLen) :: ErrMsg2 ! local error message if errStat /= ErrID_None + character(*), parameter :: RoutineName = 'WaveTankTesting.ParseInputFile' + + ErrStat = ErrID_None + ErrMsg = " " + + CurLine = 1 + ! Separator/header lines skipped automatically + ! ----- Simulation control ------------- + call ParseVar( FileInfo_In, CurLine, 'DT', SimSettings%Sim%DT, ErrStat2, ErrMsg2); if(Failed()) return; ! timestep (unused) + call ParseVar( FileInfo_In, CurLine, 'TMax', SimSettings%Sim%TMax, ErrStat2, ErrMsg2); if(Failed()) return; ! Max sim time (used only with SeaState wavemod 5) + call ParseVar( FileInfo_In, CurLine, 'MHK', SimSettings%Sim%MHK, ErrStat2, ErrMsg2); if(Failed()) return; ! MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine} + call ParseVar( FileInfo_In, CurLine, 'InterpOrd', SimSettings%Sim%InterpOrd, ErrStat2, ErrMsg2); if(Failed()) return; ! Interpolation order [unused] +!TODO: These are placeholders for later use. Some of the logic is incomplete which is why this has been commented out. +! call ParseVar( FileInfo_In, CurLine, 'ScaleFact', SimSettings%Sim%ScaleFact, ErrStat2, ErrMsg2); if(Failed()) return; ! scaling factor for scaling full size model to wavetank scale results (Froude scaling: lambda = full_dimension / scale_dimension) [>1 expected] (-) +! call ParseVar( FileInfo_In, CurLine, 'DensFact', SimSettings%Sim%DensFact, ErrStat2, ErrMsg2); if(Failed()) return; ! ratio of density - Density_full/Density_model (rho_F/rho_M). Used with Froude scaling of forces/moments" (-) + call ParseVar( FileInfo_In, CurLine, 'DebugLevel', SimSettings%Sim%DebugLevel, ErrStat2, ErrMsg2); if(Failed()) return; ! 0: none, 1: I/O summary, 2: +positions/orientations passed, 3:, 4: +all meshes + call ParseVar( FileInfo_In, CurLine, 'OutRootName', SimSettings%Sim%OutRootName, ErrStat2, ErrMsg2); if(Failed()) return; ! Root name for any summary or other files + ! -------- Environment ---------------- + call ParseVar( FileInfo_In, CurLine, 'Gravity', SimSettings%Env%Gravity, ErrStat2, ErrMsg2); if(Failed()) return; ! Gravitational acceleration (m/s^2) + call ParseVar( FileInfo_In, CurLine, 'WtrDens', SimSettings%Env%WtrDens, ErrStat2, ErrMsg2); if(Failed()) return; ! Water density (kg/m^3) + call ParseVar( FileInfo_In, CurLine, 'WtrVisc', SimSettings%Env%WtrVisc, ErrStat2, ErrMsg2); if(Failed()) return; ! Kinematic viscosity of working fluid (m^2/s) + call ParseVar( FileInfo_In, CurLine, 'SpdSound', SimSettings%Env%SpdSound, ErrStat2, ErrMsg2); if(Failed()) return; ! Speed of sound in working fluid (m/s) + call ParseVar( FileInfo_In, CurLine, 'Patm', SimSettings%Env%Patm, ErrStat2, ErrMsg2); if(Failed()) return; ! Atmospheric pressure (Pa) [used only for an MHK turbine cavitation check] + call ParseVar( FileInfo_In, CurLine, 'Pvap', SimSettings%Env%Pvap, ErrStat2, ErrMsg2); if(Failed()) return; ! Vapour pressure of working fluid (Pa) [used only for an MHK turbine cavitation check] + call ParseVar( FileInfo_In, CurLine, 'WtrDpth', SimSettings%Env%WtrDpth, ErrStat2, ErrMsg2); if(Failed()) return; ! Water depth (m) + call ParseVar( FileInfo_In, CurLine, 'MSL2SWL', SimSettings%Env%MSL2SWL, ErrStat2, ErrMsg2); if(Failed()) return; ! Offset between still-water level and mean sea level (m) [positive upward] + ! -------- SeaState ------------------- + call ParseVar( FileInfo_In, CurLine, 'SS_InputFile', SimSettings%ModSettings%SS_InputFile, ErrStat2, ErrMsg2); if(Failed()) return; ! SeaState input file + call ParseVar( FileInfo_In, CurLine, 'WaveTimeShift', SimSettings%ModSettings%WaveTimeShift, ErrStat2, ErrMsg2); if(Failed()) return; ! Shift the SeaState wavetime by this amount (for phase shifting waves to match tank) + ! -------- MoorDyn -------------------- + call ParseVar( FileInfo_In, CurLine, 'MD_InputFile', SimSettings%ModSettings%MD_InputFile, ErrStat2, ErrMsg2); if(Failed()) return; ! MoorDyn input file + ! -------- AeroDyn + InflowWind ------- + call ParseVar( FileInfo_In, CurLine, 'AD_InputFile', SimSettings%ModSettings%AD_InputFile, ErrStat2, ErrMsg2); if(Failed()) return; ! AeroDyn input file + call ParseVar( FileInfo_In, CurLine, 'IfW_InputFile', SimSettings%ModSettings%IfW_InputFile, ErrStat2, ErrMsg2); if(Failed()) return; ! InflowWind input file + ! -------- Turbine Configuration ------ + call ParseVar( FileInfo_In, CurLine, 'NumBl', SimSettings%TrbCfg%NumBl, ErrStat2, ErrMsg2); if(Failed()) return; ! Number of blades (-) + call ParseVar( FileInfo_In, CurLine, 'HubRad', SimSettings%TrbCfg%HubRad, ErrStat2, ErrMsg2); if(Failed()) return; ! The distance from the rotor apex to the blade root (meters) + call ParseVar( FileInfo_In, CurLine, 'PreCone', SimSettings%TrbCfg%PreCone, ErrStat2, ErrMsg2); if(Failed()) return; ! Blade cone angle (degrees) + SimSettings%TrbCfg%PreCone = D2R * SimSettings%TrbCfg%PreCone + call ParseVar( FileInfo_In, CurLine, 'OverHang', SimSettings%TrbCfg%OverHang, ErrStat2, ErrMsg2); if(Failed()) return; ! Distance from yaw axis to rotor apex [3 blades] or teeter pin [2 blades] (meters) + call ParseVar( FileInfo_In, CurLine, 'ShftTilt', SimSettings%TrbCfg%ShftTilt, ErrStat2, ErrMsg2); if(Failed()) return; ! Rotor shaft tilt angle (degrees) + SimSettings%TrbCfg%ShftTilt = D2R * SimSettings%TrbCfg%ShftTilt + call ParseVar( FileInfo_In, CurLine, 'Twr2Shft', SimSettings%TrbCfg%Twr2Shft, ErrStat2, ErrMsg2); if(Failed()) return; ! Vertical distance from the tower-top to the rotor shaft, center of nacelle (meters) + call ParseVar( FileInfo_In, CurLine, 'TowerHt', SimSettings%TrbCfg%TowerHt, ErrStat2, ErrMsg2); if(Failed()) return; ! Height of tower relative MSL + call ParseAry( FileInfo_In, CurLine, 'TowerBsPt', SimSettings%TrbCfg%TowerBsPt, 3, ErrStat2, ErrMsg2); if(Failed()) return; ! Height of tower base relative to PtfmRefPos in x,y, and water surface in z (meters) + call ParseAry( FileInfo_In, CurLine, 'PtfmRefPos', SimSettings%TrbCfg%PtfmRefPos, 3, ErrStat2, ErrMsg2); if(Failed()) return; ! Location of platform reference point, relative to MSL. Motions and loads all connect to this point + call ParseAry( FileInfo_In, CurLine, 'PtfmRefOrient', SimSettings%TrbCfg%PtfmRefOrient, 3, ErrStat2, ErrMsg2); if(Failed()) return; ! Orientation of platform reference point, Euler angle set of roll,pitch,yaw" (deg) + SimSettings%TrbCfg%PtfmRefOrient = D2R * SimSettings%TrbCfg%PtfmRefOrient + ! -------- Turbine Operating Point ---- + call ParseVar( FileInfo_In, CurLine, 'RotSpeed', SimSettings%TrbInit%RotSpeed, ErrStat2, ErrMsg2); if(Failed()) return; ! Rotational speed of rotor in rotor coordinates (rpm) + call ParseVar( FileInfo_In, CurLine, 'NacYaw', SimSettings%TrbInit%NacYaw, ErrStat2, ErrMsg2); if(Failed()) return; ! Initial or fixed nacelle-yaw angle (deg read) + call ParseVar( FileInfo_In, CurLine, 'BldPitch', SimSettings%TrbInit%BldPitch, ErrStat2, ErrMsg2); if(Failed()) return; ! Blade 1 pitch (deg read) + call ParseVar( FileInfo_In, CurLine, 'Azimuth', SimSettings%TrbInit%Azimuth, ErrStat2, ErrMsg2); if(Failed()) return; ! Initial azimuth (deg read) + ! angles are read as degrees, store as radians internally + SimSettings%TrbInit%NacYaw = D2R * SimSettings%TrbInit%NacYaw + SimSettings%TrbInit%BldPitch = D2R * SimSettings%TrbInit%BldPitch + SimSettings%TrbInit%Azimuth = D2R * SimSettings%TrbInit%Azimuth + ! -------- Wave Buoy------------------ + call ParseAry( FileInfo_In, CurLine, 'WaveBuoyLoc', SimSettings%WaveBuoy%XYLoc, 2, ErrStat2, ErrMsg2); if(Failed()) return; ! Location of the wave elevation measurement buoy. SeaState data returned at every timestep at this location (m) + ! -------- Output --------------------- + call ParseVar( FileInfo_In, CurLine, 'SendScreenToFile', SimSettings%Outs%SendScreenToFile, ErrStat2, ErrMsg2); if(Failed()) return; ! send to file .screen.log if true + call ParseVar( FileInfo_In, CurLine, 'OutFile', SimSettings%Outs%OutFile, ErrStat2, ErrMsg2); if(Failed()) return; ! 0: no output file of channels, 1: output file in text format (at default DT) + call ParseVar( FileInfo_In, CurLine, 'OutFmt', SimSettings%Outs%OutFmt, ErrStat2, ErrMsg2); if(Failed()) return; ! Format used for text tabular output, excluding the time channel. (quoted string) + ! -------- VTK output ----------------- + call ParseVar( FileInfo_In, CurLine, 'WrVTK_Dir', SimSettings%Viz%WrVTK_Dir, ErrStat2, ErrMsg2); if(Failed()) return; ! output directory for visualization + call ParseVar( FileInfo_In, CurLine, 'WrVTK', SimSettings%Viz%WrVTK, ErrStat2, ErrMsg2); if(Failed()) return; ! VTK visualization data output: (switch) {0=none; 1=initialization data only; 2=animation; 3=mode shapes} + call ParseVar( FileInfo_In, CurLine, 'WrVTK_type', SimSettings%Viz%WrVTK_type, ErrStat2, ErrMsg2); if(Failed()) return; ! Type of VTK visualization data: (switch) {1=surfaces; 2=basic meshes (lines/points); 3=all meshes (debug)} [unused if WrVTK=0] + call ParseVar( FileInfo_In, CurLine, 'WrVTK_DT', SimSettings%Viz%WrVTK_DT, ErrStat2, ErrMsg2); if(Failed()) return; ! DT for writing VTK files + call ParseAry( FileInfo_In, CurLine, 'VTKNacDim', SimSettings%Viz%VTKNacDim, 6, ErrStat2, ErrMsg2); if(Failed()) return; ! Nacelle dimension passed in for VTK surface rendering [0,y0,z0,Lx,Ly,Lz] (m) + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + + + +subroutine ValidateInputFile(SimSettings, ErrStat, ErrMsg) + type(SimSettingsType), intent(inout) :: SimSettings + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WaveTankTesting.ValidateInputFile' + logical :: file_exists + + ErrStat = ErrID_None + ErrMsg = "" + + !------------------------ + ! Sim Control + !------------------------ + if (SimSettings%Sim%MHK /= 2_c_int) call SetErrStat(ErrID_Fatal, "WaveTank module only works for floating MHK turbines at present (MHK=2).",ErrStat,ErrMsg,RoutineName) + if (SimSettings%Sim%ScaleFact < 1.0_c_float) call SetErrStat(ErrID_Fatal, "ScaleFact should be > 1", ErrStat,ErrMsg,RoutineName) + if (SimSettings%Sim%ScaleFact > 1.0_c_float) then + call SetErrStat(ErrID_Warn, "ScaleFact should be == 1 for now. Scaling is untested and incomplete!!!!", ErrStat,ErrMsg,RoutineName) + call WrScr("/---------------------------------------------------------\") + call WrScr("|--- WARNING ---- WARNING ---- WARNING ---- WARNING ---|") + call WrScr("|---------------------------------------------------------|") + call WrScr("| |") + call WrScr("| Froude scaling is not complete, nor is it tested!!!! |") + call WrScr("| |") + call WrScr("| At present, only some inputs are scaled, but equations |") + call WrScr("| have not been verified yet. This is useful just for |") + call WrScr("| observing motions are occuring, but will corrupt your |") + call WrScr("| simulation. |") + call WrScr("| |") + call WrScr("| Set ScaleFact=1.0 in your input file. |") + call WrScr("| |") + call WrScr("| TODO: |") + call WrScr("| - verify equations in FroudeScaling* functions |") + call WrScr("| - scale resulting forces / moments |") + call WrScr("| - add scaled time, pos, vel, acc, frc, mom to output |") + call WrScr("| channels and add subscripting to differentiate |") + call WrScr("| |") + call WrScr("\---------------------------------------------------------/") + endif + + + !------------------------ + ! Environment + !------------------------ + + !------------------------ + ! Turbine Config + !------------------------ + + !------------------------ + ! Input files + !------------------------ + inquire(file=SimSettings%ModSettings%SS_InputFile, exist=file_exists); if (.not. file_exists) call SetErrStat(ErrID_Fatal,"Cannot find SeaState input file " //trim(SimSettings%ModSettings%SS_InputFile ),ErrStat,ErrMsg,RoutineName) + inquire(file=SimSettings%ModSettings%MD_InputFile, exist=file_exists); if (.not. file_exists) call SetErrStat(ErrID_Fatal,"Cannot find MoorDyn input file " //trim(SimSettings%ModSettings%MD_InputFile ),ErrStat,ErrMsg,RoutineName) + inquire(file=SimSettings%ModSettings%AD_InputFile, exist=file_exists); if (.not. file_exists) call SetErrStat(ErrID_Fatal,"Cannot find AeroDyn input file " //trim(SimSettings%ModSettings%AD_InputFile ),ErrStat,ErrMsg,RoutineName) + inquire(file=SimSettings%ModSettings%IfW_InputFile, exist=file_exists); if (.not. file_exists) call SetErrStat(ErrID_Fatal,"Cannot find InflowWind input file "//trim(SimSettings%ModSettings%IfW_InputFile),ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) return + + ! Wave time shift must be positive + if (SimSettings%ModSettings%WaveTimeShift < 0.0_DbKi) call SetErrStat(ErrID_Fatal, "WaveTimeShift must be >= 0",Errstat,ErrMsg,RoutineName) + + !------------------------ + ! Turbine Operating point + !------------------------ + + !------------------------ + ! Output + !------------------------ + + !------------------------ + ! VTK + !------------------------ + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + + +!> Transfer names or units from c character arrays into fortran character arrays for output file writing +subroutine TransferOutChanNamesUnits(NumChans, name, NamesUnits_C, NamesUnits, ErrStat, ErrMsg) + integer(IntKi), intent(in ) :: NumChans + character(*), intent(in ) :: name + character(c_char), intent(in ) :: NamesUnits_C(:) + character(ChanLen), allocatable, intent( out) :: NamesUnits(:) + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen), intent( out) :: ErrMsg + integer(IntKi) :: i,idxStart,idxEnd + call AllocAry(NamesUnits, NumChans, name, ErrStat, ErrMsg) + if (ErrStat >= AbortErrLev) return + do i=1,NumChans + idxStart = (i-1)*ChanLen + 1 + idxEnd = i*ChanLen + NamesUnits(i) = transfer(NamesUnits_C(idxStart:idxEnd),NamesUnits(i)) + enddo +end subroutine + + +!> open the output file and populate the header +subroutine InitOutputFile(WrOutputData, ErrStat, ErrMsg) + type(WrOutputDataType), intent(inout) :: WrOutputData + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen), intent( out) :: ErrMsg + integer(IntKi) :: i + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InitOutputFile' + if (WrOutputData%OutUn > 0) then + ErrStat = ErrID_Warn + ErrMsg = "Output file "//trim(WrOutputData%OutName)//" already open" + return + endif + + call GetNewUnit(WrOutputData%OutUn,ErrStat2,ErrMsg2) + call OpenFOutFile (WrOutputData%OutUn, trim(WrOutputData%OutName), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + +!FIXME: add version info here + ! write header line + write (WrOutputData%OutUn,'(/,A)') 'Simulation run on '//CurDate()//' at '//CurTime()//' using the WaveTank c-binding interface' + write (WrOutputData%OutUn,'()') + write (WrOutputData%OutUn,'()') + write (WrOutputData%OutUn,'()') + write (WrOutputData%OutUn,'()') + + !...................................................... + ! Write the names of the output parameters on one line: + !...................................................... + ! default outputs + call WrFileNR(WrOutputData%OutUn, DefChanNames(1)) ! time channel + do i=2,NumDefChans + call WrFileNR(WrOutputData%OutUn, tab//DefChanNames(i)) + enddo + ! SS + do i=1,WrOutputData%NumChans_SS + call WrFileNR(WrOutputData%OutUn, tab//WrOutputData%WriteOutputHdr_SS(i)) + enddo + ! MD + do i=1,WrOutputData%NumChans_MD + call WrFileNR(WrOutputData%OutUn, tab//WrOutputData%WriteOutputHdr_MD(i)) + enddo + ! ADI + do i=1,WrOutputData%NumChans_ADI + call WrFileNR(WrOutputData%OutUn, tab//WrOutputData%WriteOutputHdr_ADI(i)) + enddo + write (WrOutputData%OutUn,'()') + + !...................................................... + ! Write the units of the output parameters on one line: + !...................................................... + ! default outputs + call WrFileNR(WrOutputData%OutUn, DefChanUnits(1)) ! time channel + do i=2,NumDefChans + call WrFileNR(WrOutputData%OutUn, tab//DefChanUnits(i)) + enddo + ! SS + do i=1,WrOutputData%NumChans_SS + call WrFileNR(WrOutputData%OutUn, tab//WrOutputData%WriteOutputUnt_SS(i)) + enddo + ! MD + do i=1,WrOutputData%NumChans_MD + call WrFileNR(WrOutputData%OutUn, tab//WrOutputData%WriteOutputUnt_MD(i)) + enddo + ! ADI + do i=1,WrOutputData%NumChans_ADI + call WrFileNR(WrOutputData%OutUn, tab//WrOutputData%WriteOutputUnt_ADI(i)) + enddo + write (WrOutputData%OutUn,'()') + +end subroutine + + +subroutine WriteOutputLine(OutFmt, CalcStepIO, StructTmp, WrOutputData, ErrStat, ErrMsg) + character(*), intent(in ) :: OutFmt + type(CalcStepIOdataType), intent(in ) :: CalcStepIO + type(StructTmpType), intent(in ) :: StructTmp ! operating states are in here + type(WrOutputDataType), intent(in ) :: WrOutputData + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen), intent( out) :: ErrMsg + integer(IntKi) :: OutUnit + integer(IntKi) :: errStat2 ! Status of error message (we're going to ignore errors in writing to the file) + character(ErrMsgLen) :: errMsg2 ! Error message if ErrStat /= ErrID_None + character(200) :: frmt ! A string to hold a format specifier + character(15) :: tmpStr ! temporary string to print the time output as text + real(ReKi) :: TmpAry5(5) ! temporary array for RotSpeed, BlPitch, NacYaw, Azimuth, BuoyWaveElev + + ErrStat = ErrID_None + ErrMSg = "" + + frmt = '"'//tab//'"'//trim(OutFmt) ! format for array elements from individual modules + OutUnit = WrOutputData%OutUn + if (OutUnit <= 0_IntKi) then + ErrStat = ErrID_Severe + ErrMSg = 'Cannot write to output file '//trim(WrOutputData%OutName) + return + endif + + ! time + write( tmpStr, '(F15.6)' ) CalcStepIO%Time_c + call WrFileNR( OutUnit, tmpStr ) + ! position / orientation euler angles, velocity, accel, resulting force/moment + call WrNumAryFileNR(OutUnit, CalcStepIO%PosAng_c, frmt, errStat2, errMsg2); if (Failed()) return + call WrNumAryFileNR(OutUnit, CalcStepIO%Vel_c, frmt, errStat2, errMsg2); if (Failed()) return + call WrNumAryFileNR(OutUnit, CalcStepIO%Acc_c, frmt, errStat2, errMsg2); if (Failed()) return + call WrNumAryFileNR(OutUnit, CalcStepIO%FrcMom_c, frmt, errStat2, errMsg2); if (Failed()) return ! total + call WrNumAryFileNR(OutUnit, StructTmp%FrcMom_MD_at_Ptfm, frmt, errStat2, errMsg2); if (Failed()) return + call WrNumAryFileNR(OutUnit, StructTmp%FrcMom_ADI_at_Ptfm, frmt, errStat2, errMsg2); if (Failed()) return + TmpAry5 = (/ R2D*StructTmp%Azimuth, StructTmp%RotSpeed, R2D*StructTmp%BldPitch, R2D*StructTmp%NacYaw, CalcStepIO%BuoyWaveElev /) + call WrNumAryFileNR(OutUnit, TmpAry5, frmt, errStat2, errMsg2); if (Failed()) return + ! channels from modules + call WrNumAryFileNR(OutUnit, WrOutputData%OutData_SS, frmt, errStat2, ErrMsg2); if (Failed()) return + call WrNumAryFileNR(OutUnit, WrOutputData%OutData_MD, frmt, errStat2, ErrMsg2); if (Failed()) return + call WrNumAryFileNR(OutUnit, WrOutputData%OutData_ADI, frmt, errStat2, ErrMsg2); if (Failed()) return + ! write a new line (advance to the next line) + write (OutUnit,'()') +contains + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'WriteOutputLine') + Failed = errStat >= AbortErrLev + end function Failed +end subroutine + +END MODULE WaveTank_IO diff --git a/glue-codes/labview/src/WaveTank_Registry.txt b/glue-codes/labview/src/WaveTank_Registry.txt new file mode 100644 index 0000000000..f3072b5aca --- /dev/null +++ b/glue-codes/labview/src/WaveTank_Registry.txt @@ -0,0 +1,160 @@ +################################################################################################################################### +# Registry for WaveTank module +# This Registry file is used to create WaveTank_Types.f90 +# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. +# See the NWTC Programmer's Handbook for further information on the format/contents of this file. +# +# Entries are of the form +# +# +# Use ^ as a shortcut for the value in the same column from the previous line. +################################################################################################################################### +# ...... Include files (definitions from NWTC Library) ............................................................................ +include Registry_NWTC_Library.txt +# + +typedef WaveTank/WT SimType c_double DT - - - "timestep" - +typedef ^ ^ c_double TMax - - - "Max sim time" - +typedef ^ ^ c_int MHK - - - "MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine}" (-) +typedef ^ ^ c_int InterpOrd - 1 - "Interpolation order" - +typedef ^ ^ c_float ScaleFact - 1 - "scaling factor for scaling full size model to wavetank scale results (Froude scaling: lambda = full_dimension / scale_dimension) (>1 expected) (-) +typedef ^ ^ c_float DensFact - 1 - "ratio of density - Density_full/Density_model (rho_F/rho_M). Used with Froude scaling of forces/moments" (-) +typedef ^ ^ c_int DebugLevel - - - "Debug level for outputs" - +typedef ^ ^ character(1024) OutRootName - - - "Rootname for outputs" - + +typedef ^ EnvType c_float Gravity - - - "gravitational constant (positive for down)" (m/s^2) +typedef ^ ^ ^ WtrDens - - - "Water density" (kg/m^3) +typedef ^ ^ ^ WtrVisc - - - "fluid viscosity" (m^2/s) +typedef ^ ^ ^ SpdSound - - - "Speed of sound in working fluid" (m/s) +typedef ^ ^ ^ Patm - - - "Atmospheric pressure [used only for an MHK turbine cavitation check]" (Pa) +typedef ^ ^ ^ Pvap - - - "Vapour pressure of working fluid [used only for an MHK turbine cavitation check]" (Pa) +typedef ^ ^ ^ WtrDpth - - - "Water depth" (m) +typedef ^ ^ ^ MSL2SWL - - - "Mean sea level to still water level" (m) + +typedef ^ TurbConfigType IntKi NumBl - - - "Number of blades" (-) +typedef ^ ^ SiKi HubRad - - - "The distance from the rotor apex to the blade root" (m) +typedef ^ ^ ^ PreCone - - - "Blade cone angle" (deg) +typedef ^ ^ ^ OverHang - - - "Distance from yaw axis to rotor apex [3 blades] or teeter pin [2 blades]" (m) +typedef ^ ^ ^ ShftTilt - - - "Rotor shaft tilt angle" (deg) +typedef ^ ^ ^ Twr2Shft - - - "Vertical distance from the tower-top to the rotor shaft" (m) +typedef ^ ^ ^ TowerHt - - - "Height of tower relative MSL" (m) +typedef ^ ^ ^ TowerBsPt 3 - - "Tower base location relative to MSL. Consider absolute difference to PtfmRef [floating MHK]" (m) +typedef ^ ^ ^ PtfmRefPos 3 - - "Location of platform reference point, relative to MSL. Motions and loads all connect to this point" (m) +typedef ^ ^ ^ PtfmRefOrient 3 - - "Orientation of platform reference point, Euler angle set of roll,pitch,yaw" (rad) + +typedef ^ TurbInitCondType ReKi RotSpeed - - - "Rotor speed" (RPM) +typedef ^ ^ ^ NacYaw - - - "Initial or fixed nacelle-yaw angle - read as deg, convert to rad" (rad) +typedef ^ ^ ^ BldPitch - - - "Fixed blade pitch for full simulation - read as deg, convert to rad" (rad) +typedef ^ ^ ^ Azimuth - 0 - "Initial azimuth (actual azimuth calculated and not stored) - read as deg, convert to rad" (rad) + +typedef ^ WaveBuoyType ReKi XYLoc 2 - - "Location of the wave elevation measurement buoy. SeaState data returned at every timestep at this location" (m) + +typedef ^ OutFilesType logical SendScreenToFile - - - "send to file .screen.log if true" (-) +typedef ^ ^ c_int OutFile - - - "0: no output file of channels, 1: output file in text format (at DT)" (-) +typedef ^ ^ character(20) OutFmt - - - "Format used for text tabular output, excluding the time channel. (quoted string)" (-) + +typedef ^ VizType c_int WrVTK - - - "Write VTK?" - +typedef ^ ^ ^ WrVTK_type - - - "Write VTK outputs as [1: surface, 2: lines, 3: both]" - +typedef ^ ^ c_double WrVTK_DT - - - "Time step between VTK writes" - +typedef ^ ^ character(1024) WrVTK_dir - - - "Directory for VTK writing" - +typedef ^ ^ c_float VTKNacDim 6 - - "Nacelle dimension passed in for VTK surface rendering [0,y0,z0,Lx,Ly,Lz]" (m) +typedef ^ ^ IntKi Twidth - 6 - "Time width -- hard coded for now" (-) + +typedef ^ ModSettings character(1024) SS_InputFile - - - "SeaState input file" (-) +typedef ^ ^ DbKi WaveTimeShift - - - "Shift the SeaState wavetime by this amount (for phase shifting waves to match tank)" (s) +typedef ^ ^ character(1024) MD_InputFile - - - "MoorDyn input file" (-) +typedef ^ ^ ^ AD_InputFile - - - "AeroDyn input file" (-) +typedef ^ ^ ^ IfW_InputFile - - - "InflowWind input file" (-) + + +typedef ^ SimSettingsType SimType Sim - - - "Simulation settings" - +typedef ^ ^ EnvType Env - - - "Environment settings" - +typedef ^ ^ TurbConfigType TrbCfg - - - "Turbine configuration" - +typedef ^ ^ TurbInitCondType TrbInit - - - "Turbine initial operating point" - +typedef ^ ^ WaveBuoyType WaveBuoy - - - "Wave elevation buoy locat (x-y)" (m) +typedef ^ ^ OutFilesType Outs - - - "Output settings" - +typedef ^ ^ VizType Viz - - - "Vizualization settings" - +typedef ^ ^ ModSettings ModSettings - - - "Input files for each module" - + + +# Storage for IO to CalcStep +typedef ^ CalcStepIOdataType c_double Time_c - - - "IN: time" "(s)" +typedef ^ ^ c_float PosAng_c 6 - - "IN: Position + Euler Ang [x,y,z,phi,theta,psi]" "[(m) (rad)]" +typedef ^ ^ ^ Vel_c 6 - - "IN: Velocity [Vx,Vy,Vz,RVx,RVy,RVz]" "[(m/s) (rad/s)]" +typedef ^ ^ ^ Acc_c 6 - - "IN: Acceleration [Ax,Ay,Az,RAx,RAy,RAz]" "[(m/s^2) (rad/s^2)]" +typedef ^ ^ ^ FrcMom_c 6 - - "OUT: Acceleration [Fx,Fy,Fz,Mx,My,Mz]" "[(N) (N-m)]" +typedef ^ ^ ^ FrcMom_MD_c 6 - - "calculated forces/moments from MD" - +typedef ^ ^ ^ FrcMom_ADI_c : - - "calculated forces/moments from ADI" - +typedef ^ ^ ^ HubVel_ADI_c 3 - - "hub height wind vel from ADI" - +typedef ^ ^ ReKi BuoyWaveElev - - - "calculated wave elevation at buoy" - + + +# storage for output file data (num chans, WriteOutputHdr, out arrays per module, etc) +typedef ^ WrOutputDataType IntKi NumChans_cbind - 0 - "Number of output channels from c-bind" - +typedef ^ ^ ^ NumChans_SS - 0 - "Number of output channels from SS" - +typedef ^ ^ ^ NumChans_MD - 0 - "Number of output channels from MD" - +typedef ^ ^ ^ NumChans_ADI - 0 - "Number of output channels from ADI" - +typedef ^ ^ ^ NumChans_all - 0 - "Total number of channels (sum of above)" - +typedef ^ ^ character(ChanLen) WriteOutputHdr_SS : - - "output file header names from SS" - +typedef ^ ^ ^ WriteOutputUnt_SS : - - "output file header units from SS" - +typedef ^ ^ ^ WriteOutputHdr_MD : - - "output file header names from MD" - +typedef ^ ^ ^ WriteOutputUnt_MD : - - "output file header units from MD" - +typedef ^ ^ ^ WriteOutputHdr_ADI : - - "output file header names from ADI" - +typedef ^ ^ ^ WriteOutputUnt_ADI : - - "output file header units from ADI" - +typedef ^ ^ c_float OutData_SS_c : - - "output data from SS as passed c_float" - +typedef ^ ^ ^ OutData_MD_c : - - "output data from MD as passed c_float" - +typedef ^ ^ ^ OutData_ADI_c : - - "output data from ADI as passed c_float" - +typedef ^ ^ SiKi OutData_SS : - - "output data from SS" - +typedef ^ ^ ^ OutData_MD : - - "output data from MD" - +typedef ^ ^ ^ OutData_ADI : - - "output data from ADI" - +typedef ^ ^ character(1024) OutName - - - "Output file name" - +typedef ^ ^ IntKi OutUn - -1 - "Output unit" - + + +# Mesh structures and mappings +typedef ^ MeshesMotionType MeshType PtfmPtMotion - - - "Platform principle ref point. Also serves as tower base" - +typedef ^ ^ ^ TowerMotion - - - "Tower mesh (used only for vis)" - +typedef ^ ^ ^ HubMotion - - - "Hub mesh (for mappings, no loadings)" - +typedef ^ ^ ^ BladeRootMotion : - - "Blade root motions" - +typedef ^ ^ ^ WaveBuoyMotion - - - "wave measurement buoy motion (sensor only)" - + +typedef ^ MeshesLoadsType MeshType PtfmPtLoads - - - "Platform principle ref point loads output" - +typedef ^ ^ ^ PtfmPtLoadsTmp - - - "Platform principle ref point loads output - temp var for load summation" - +typedef ^ ^ ^ MooringLoads - - - "Mooring loads (always at PtfmPt, but separated for simplicity)" - +typedef ^ ^ ^ TowerLoads - - - "Tower mesh (unused)" - +typedef ^ ^ ^ HubLoads - - - "Hub mesh (for mappings, intermediate loads)" - +typedef ^ ^ ^ BladeRootLoads : - - "Blade root loads" - + +# NOTE: rigid geometry, no yaw, static pitch +typedef ^ MeshesMapsType MeshMapType Motion_PRP_2_Twr - - - "PRP to tower motion" - +typedef ^ ^ ^ Motion_PRP_2_Hub - - - "Twrtop to nacelle - add rotation afterwards" - +typedef ^ ^ ^ Motion_Hub_2_BldRoot : - - "Hub to blade root motion transfer" - +typedef ^ ^ ^ Load_BldRoot_2_Hub : - - "Blade root loads to hub" - +typedef ^ ^ ^ Load_Hub_2_PRP - - - "Hub to nacelle load transfer" - +typedef ^ ^ ^ Load_Twr_2_PRP - - - "Tower loads to PRP (unused)" - +typedef ^ ^ ^ Load_Moor_2_PRP - - - "Mooring loads to PRP" - + +# temporary data storage for structural model +typedef ^ StructTmpType ReKi Azimuth - 0 - "Current Azimuth" (rad) +typedef ^ ^ ^ RotSpeed - - - "Rotor speed" (RPM) +typedef ^ ^ ^ BldPitch - - - "Blade pitch" (rad) +typedef ^ ^ ^ NacYaw - - - "Nacelle-yaw angle" (rad) +typedef ^ ^ ^ FrcMom_ADI_at_Ptfm 6 - - "Total aero loading summed to Ptfm point" (N, N-m) +typedef ^ ^ ^ FrcMom_MD_at_Ptfm 6 - - "MoorDyn loading at Ptfm point" (N, N-m) +typedef ^ ^ c_float BuoyPos_c 2 - - "Buoy XY position" (m) +typedef ^ ^ ^ PtfmPosAng_c 6 - - "Temp position and euler angle" (m, rad) +typedef ^ ^ ^ PtfmVel_c 6 - - "Temp velocity " (m/s, rad/s) +typedef ^ ^ ^ PtfmAcc_c 6 - - "Temp acceleration " (m/s^2, rad/s^2) +typedef ^ ^ ^ NacPos_c 3 - - "Temp nacelle position " (m, rad) +typedef ^ ^ c_double NacDCM_c 9 - - "Temp nacelle orientation DCM" (-) +typedef ^ ^ c_float NacVel_c 6 - - "Temp nacelle velocity " (m/s, rad/s) +typedef ^ ^ ^ NacAcc_c 6 - - "Temp nacelle acceleration " (m/s^2, rad/s^2) +typedef ^ ^ ^ HubPos_c 3 - - "Temp hub position " (m, rad) +typedef ^ ^ c_double HubDCM_c 9 - - "Temp hub orientation DCM" (-) +typedef ^ ^ c_float HubVel_c 6 - - "Temp hub velocity " (m/s, rad/s) +typedef ^ ^ ^ HubAcc_c 6 - - "Temp hub acceleration " (m/s^2, rad/s^2) +typedef ^ ^ ^ BldPos_c : - - "Temp blade position -- sequential by blade" (m) +typedef ^ ^ c_double BldDCM_c : - - "Temp blade orientation DCM -- flat sequential by blade" (-) +typedef ^ ^ c_float BldVel_c : - - "Temp blade velocity -- sequential by blade" (m/s, rad/s) +typedef ^ ^ ^ BldAcc_c : - - "Temp blade acceleration -- sequential by blade" (m/s^2, rad/s^2) + diff --git a/glue-codes/labview/src/WaveTank_Struct.f90 b/glue-codes/labview/src/WaveTank_Struct.f90 new file mode 100644 index 0000000000..7c096b8e0b --- /dev/null +++ b/glue-codes/labview/src/WaveTank_Struct.f90 @@ -0,0 +1,666 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2025 National Renewable Energy Laboratory +! +! This file is a module specific to an experimental wave tank at NREL. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!********************************************************************************************************************************** +! +! This module provides structural model for the wavetank interface +! +!********************************************************************************************************************************** +module WaveTank_Struct + use ISO_C_BINDING + use NWTC_Library + use WaveTank_Types + + implicit none + private + + save + + public :: StructCreate + public :: StructCreateMeshMaps + public :: StructDestroy + public :: StructMotionUpdate + public :: StructLoadsMeshTransfer + public :: WrVTK_Struct_Ref + public :: WrVTK_Struct + public :: FroudeScaleM2F_Disp + public :: FroudeScaleM2F_TVel + public :: FroudeScaleM2F_RVel + public :: FroudeScaleM2F_TAcc + public :: FroudeScaleM2F_RAcc + public :: FroudeScaleM2F_Time + public :: FroudeScaleF2M_Frc + public :: FroudeScaleF2M_Mom + +contains + + +!> create the structural model, allocate temp data storage, setup mesh mappings +subroutine StructCreate(SimSettings, MeshMotions, MeshLoads, MeshMaps, StructTmp, ErrStat, ErrMsg) + type(SimSettingsType), target, intent(in ) :: SimSettings + type(MeshesMotionType), target, intent(inout) :: MeshMotions + type(MeshesLoadsType ), target, intent(inout) :: MeshLoads + type(MeshesMapsType ), intent(inout) :: MeshMaps + type(StructTmpType ), intent(inout) :: StructTmp + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WaveTank::StructCreate' + real(ReKi) :: TmpPos(3) + real(DbKi) :: AzBlade ! temporary var for calculating blade mounting azimuth + real(DbKi) :: TmpAng(3) ! temporary euler angle + real(DbKi) :: Orient(3,3) ! temporary orientation + type(TurbConfigType), pointer :: TrbCfg ! to shorten notation + type(TurbInitCondType), pointer :: TrbInit ! to shorten notation + type(MeshType), pointer :: Ptfm, PtfmLd ! to shorten notation + type(MeshType), pointer :: Twr, TwrLd ! to shorten notation + type(MeshType), pointer :: Hub, HubLd ! to shorten notation + type(MeshType), pointer :: Root, RootLd ! to shorten notation + type(MeshType), pointer :: MoorLd ! to shorten notation + integer(IntKi) :: k ! blade counter + ErrStat = ErrID_None + ErrMsg = '' + + TrbCfg => SimSettings%TrbCfg + TrbInit => SimSettings%TrbInit + + ! Set some state information + StructTmp%RotSpeed = TrbInit%RotSpeed + StructTmp%BldPitch = TrbInit%BldPitch + StructTmp%NacYaw = TrbInit%NacYaw + StructTmp%Azimuth = TrbInit%Azimuth + + + !------------------------------- + ! Wave measurement buoy + !------------------------------- + TmpPos = 0.0_ReKi + TmpPos(1:2) = SimSettings%WaveBuoy%XYLoc(1:2) + call Eye(Orient, ErrStat2, ErrMsg2); if (Failed()) return + call CreateInputPointMesh(MeshMotions%WaveBuoyMotion, TmpPos, Orient, ErrStat2, ErrMsg2, hasMotion=.true., hasLoads=.false.); if (Failed()) return + + + !------------------------------- + ! create PRP platform mesh point + !------------------------------- + Ptfm => MeshMotions%PtfmPtMotion + TmpPos = real(TrbCfg%PtfmRefPos, ReKi) + Orient=WT_EulerToDCM_fromInput(TrbCfg%PtfmRefOrient) + call CreateInputPointMesh(Ptfm, TmpPos, Orient, ErrStat2, ErrMsg2, hasMotion=.true., hasLoads=.false.); if (Failed()) return + Ptfm%RemapFlag = .false. + + ! create platform load mesh + PtfmLd => MeshLoads%PtfmPtLoads + call MeshCopy( SrcMesh=Ptfm, DestMesh=PtfmLd, CtrlCode=MESH_SIBLING, IOS=COMPONENT_OUTPUT, ErrStat=ErrStat2, ErrMess=ErrMsg2, Force=.true., Moment=.true. ) + if (Failed()) return + PtfmLd%RemapFlag = .false. + + ! create a temporary load mesh + call MeshCopy( PtfmLd, MeshLoads%PtfmPtLoadsTmp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + if (Failed()) return + PtfmLd%RemapFlag = .false. + + ! create a mooring mesh point + MoorLd => MeshLoads%MooringLoads + call MeshCopy( SrcMesh=Ptfm, DestMesh=MoorLd, CtrlCode=MESH_COUSIN, IOS=COMPONENT_OUTPUT, ErrStat=ErrStat2, ErrMess=ErrMsg2, Force=.true., Moment=.true. ) + if (Failed()) return + PtfmLd%RemapFlag = .false. + + + !------------------------------- + ! create 2 point tower mesh + !------------------------------- + Twr => MeshMotions%TowerMotion + call MeshCreate ( BlankMesh = Twr, IOS=COMPONENT_INPUT, Nnodes=2, ErrStat=ErrStat2, ErrMess=ErrMsg2, & + Orientation = .true., TranslationDisp = .true., TranslationVel = .true., RotationVel = .true., TranslationAcc = .TRUE., RotationAcc = .true.) + if (Failed()) return + + ! Tower bottom + TmpPos(1:2) = real(TrbCfg%TowerBsPt(1:2) + TrbCfg%PtfmRefPos(1:2), ReKi) ! relative to PtfmRefPos in (x,y) + TmpPos(3) = real(TrbCfg%TowerBsPt(3), ReKi) ! relative to MSL in (z) + call MeshPositionNode(Twr, 1, TmpPos, errStat2, errMsg2) ! orientation is identity by default + if (Failed()) return + + ! Tower top -- assumes vertical tower + TmpPos(3) = real(TrbCfg%TowerHt,ReKi) ! c_float to ReKi + call MeshPositionNode(Twr, 2, TmpPos, errStat2, errMsg2) ! orientation is identity by default + if (Failed()) return + + ! create line element + call MeshConstructElement( Twr, ELEMENT_LINE2, errStat2, errMsg2, p1=1, p2=2 ) + if (Failed()) return + + ! commit mesh + call MeshCommit(Twr, errStat2, errMsg2 ) + + ! initialize location + Twr%Orientation = Twr%RefOrientation + Twr%TranslationDisp = 0.0_R8Ki + Twr%TranslationVel = 0.0_ReKi + Twr%RemapFlag = .false. + + ! create tower load mesh + TwrLd => MeshLoads%TowerLoads + call MeshCopy( SrcMesh=Twr, DestMesh=TwrLd, CtrlCode=MESH_SIBLING, IOS=COMPONENT_OUTPUT, ErrStat=ErrStat2, ErrMess=ErrMsg2, Force=.true., Moment=.true. ) + if (Failed()) return + TwrLd%RemapFlag = .false. + TwrLd%Force = 0.0_ReKi + TwrLd%Moment = 0.0_ReKi + + + !------------------------------- + ! create hub mesh + !------------------------------- + ! NOTE: for a reference mesh position, nacelle yaw should be zero. since NacYaw is static in this + ! we are setting it once here. If it needs to be dynamic, zero it here and update the yaw + ! in the StructMotionUpdate routine below + Hub => MeshMotions%HubMotion + TmpPos(1:3) = Twr%Position(1:3,2) ! Tower top + TmpPos(1) = TmpPos(1) + cos(TrbInit%NacYaw) * TrbCfg%OverHang ! X, nacelle yaw, and overhang + TmpPos(2) = TmpPos(2) + sin(TrbInit%NacYaw) * TrbCfg%OverHang ! Y, nacelle yaw, and overhang + TmpPos(3) = TmpPos(3) + TrbCfg%Twr2Shft - abs(TrbCfg%OverHang) * tan(TrbCfg%ShftTilt) ! Z, shaft height above tower top, and shaft tilt + + TmpAng = (/ 0.0_DbKi, -real(TrbCfg%ShftTilt,DbKi), real(TrbInit%NacYaw,DbKi) /) ! Hub/rotor azimuth is zero for reference. Hub axis on upwind points towards nacelle. + Orient = EulerConstruct(TmpAng) + call CreateInputPointMesh(Hub, TmpPos, Orient, ErrStat2, ErrMsg2, hasMotion=.true., hasLoads=.false.); if (Failed()) return + Hub%RemapFlag = .false. + + ! create tower load mesh + HubLd => MeshLoads%HubLoads + call MeshCopy( SrcMesh=Hub, DestMesh=HubLd, CtrlCode=MESH_SIBLING, IOS=COMPONENT_OUTPUT, ErrStat=ErrStat2, ErrMess=ErrMsg2, Force=.true., Moment=.true. ) + if (Failed()) return + HubLd%RemapFlag = .false. + HubLd%Force = 0.0_ReKi + HubLd%Moment = 0.0_ReKi + + + !------------------------------- + ! create blade root mesh + !------------------------------- + ! NOTE: for a reference mesh position, blade pitch should be zero. since BldPitch is static in this + ! we are setting it once here. If it needs to be dynamic, zero it here and update the yaw + ! in the StructMotionUpdate routine below + allocate(MeshMotions%BladeRootMotion(TrbCfg%NumBl),STAT=ErrStat2) + if (ErrStat2 /= 0) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Could not allocate BladeRootMotion mesh" + if (Failed()) return + endif + do k=1,TrbCfg%NumBl + Root => MeshMotions%BladeRootMotion(k) + AzBlade = TwoPi_D * real((k-1),DbKi)/real(TrbCfg%NumBl,DbKi) + TmpAng = (/ AzBlade, real(TrbCfg%PreCone,DbKi), real(-TrbInit%BldPitch,DbKi) /) ! Blade pitch does not follow RHR + Orient = EulerConstruct(TmpAng) + Orient = matmul(Orient,Hub%Orientation(1:3,1:3,1)) + TmpPos = Hub%Position(1:3,1) + TrbCfg%HubRad * real(Orient(3,1:3),ReKi) + call CreateInputPointMesh(Root, TmpPos, Orient, ErrStat2, ErrMsg2, hasMotion=.true., hasLoads=.false.); if (Failed()) return + Root%RemapFlag = .false. + enddo + + ! create blade root load mesh + allocate(MeshLoads%BladeRootLoads(TrbCfg%NumBl),STAT=ErrStat2) + if (ErrStat2 /= 0) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Could not allocate BladeRootLoads mesh" + if (Failed()) return + endif + do k=1,TrbCfg%NumBl + Root => MeshMotions%BladeRootMotion(k) + RootLd => MeshLoads%BladeRootLoads(k) + call MeshCopy( SrcMesh=Root, DestMesh=RootLd, CtrlCode=MESH_SIBLING, IOS=COMPONENT_OUTPUT, ErrStat=ErrStat2, ErrMess=ErrMsg2, Force=.true., Moment=.true. ) + if (Failed()) return + RootLd%RemapFlag = .false. + RootLd%Force = 0.0_ReKi + RootLd%Moment = 0.0_ReKi + enddo + +contains + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + Failed = errStat >= AbortErrLev + end function Failed +end subroutine + + + +!> create mesh mappings +subroutine StructCreateMeshMaps(SimSettings, MeshMotions, MeshLoads, MeshMaps, ErrStat, ErrMsg) + type(SimSettingsType), intent(in ) :: SimSettings + type(MeshesMotionType), intent(inout) :: MeshMotions + type(MeshesLoadsType ), intent(inout) :: MeshLoads + type(MeshesMapsType ), intent(inout) :: MeshMaps + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WaveTank::StructCreateMeshMaps' + integer(IntKi) :: k + + ErrStat = ErrID_None + ErrMsg = '' + + !------------------------------- + ! Mapping arrays + allocate(MeshMaps%Motion_Hub_2_BldRoot(SimSettings%TrbCfg%NumBl),STAT=ErrStat2) + if (ErrStat2 /= 0) then + ErrStat = ErrID_Fatal + ErrMsg = "Could not allocate Motion_Hub_2_BldRoot mesh mapping" + return + endif + allocate(MeshMaps%Load_BldRoot_2_Hub(SimSettings%TrbCfg%NumBl),STAT=ErrStat2) + if (ErrStat2 /= 0) then + ErrStat = ErrID_Fatal + ErrMsg = "Could not allocate Load_BldRoot_2_Hub mesh mapping" + return + endif + + !------------------------------- + ! Mesh motion mappings + call MeshMapCreate(MeshMotions%PtfmPtMotion, MeshMotions%TowerMotion, MeshMaps%Motion_PRP_2_Twr, errStat2, errMsg2); if(Failed())return + call MeshMapCreate(MeshMotions%PtfmPtMotion, MeshMotions%HubMotion, MeshMaps%Motion_PRP_2_Hub, errStat2, errMsg2); if(Failed())return + do k=1,SimSettings%TrbCfg%NumBl + call MeshMapCreate(MeshMotions%HubMotion, MeshMotions%BladeRootMotion(k), MeshMaps%Motion_Hub_2_BldRoot(k), errStat2, errMsg2); if(Failed())return + enddo + + !------------------------------- + ! Mesh load mappings + call MeshMapCreate(MeshLoads%TowerLoads, MeshLoads%PtfmPtLoads, MeshMaps%Load_Twr_2_PRP, errStat2, ErrMsg2); if(Failed()) return + call MeshMapCreate(MeshLoads%HubLoads, MeshLoads%PtfmPtLoads, MeshMaps%Load_Hub_2_PRP, errStat2, ErrMsg2); if(Failed()) return + do k=1,SimSettings%TrbCfg%NumBl + call MeshMapCreate(MeshLoads%BladeRootLoads(k), MeshLoads%HubLoads, MeshMaps%Load_BldRoot_2_Hub(k), errStat2, errMsg2); if(Failed())return + enddo + call MeshMapCreate(MeshLoads%MooringLoads, MeshLoads%PtfmPtLoads, MeshMaps%Load_Moor_2_PRP, errStat2, ErrMsg2); if(Failed()) return + +contains + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + Failed = errStat >= AbortErrLev + end function Failed +end subroutine + + + +!> updates the structural meshes +subroutine StructMotionUpdate(SimSettings, CalcStepIO, MeshMotions, MeshMaps, StructTmp, ErrStat, ErrMsg) + type(SimSettingsType), target, intent(in ) :: SimSettings + type(CalcStepIOdataType), intent(in ) :: CalcStepIO + type(MeshesMotionType), target, intent(inout) :: MeshMotions + type(MeshesMapsType ), intent(inout) :: MeshMaps + type(StructTmpType ), intent(inout) :: StructTmp + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WaveTank::StructMotionUpdate' + real(R8Ki) :: TmpTransDisp(3) + real(DbKi) :: TmpAng(3) ! temporary euler angle + real(R8Ki) :: Orient(3,3) ! temporary orientation + type(TurbConfigType), pointer :: TrbCfg ! to shorten notation + type(TurbInitCondType), pointer :: TrbInit ! to shorten notation + type(MeshType), pointer :: Ptfm ! to shorten notation + type(MeshType), pointer :: Twr ! to shorten notation + type(MeshType), pointer :: Hub ! to shorten notation + type(MeshType), pointer :: Root ! to shorten notation + real(c_float) :: ScaleFact ! to shorten notation + integer(IntKi) :: k + + ErrStat = ErrID_None + ErrMsg = '' + + TrbCfg => SimSettings%TrbCfg + TrbInit => SimSettings%TrbInit + + ! scaling factor + ScaleFact = SimSettings%Sim%ScaleFact + + ! update PtfmPtMotion + Ptfm => MeshMotions%PtfmPtMotion + Ptfm%TranslationDisp(1:3,1) = FroudeScaleM2F_Disp(ScaleFact, CalcStepIO%PosAng_c(1:3), Ptfm%Position(1:3,1)) + Ptfm%Orientation(1:3,1:3,1) = WT_EulerToDCM_fromInput(CalcStepIO%PosAng_c(4:6)) ! angles don't scale + Ptfm%TranslationVel(1:3,1) = FroudeScaleM2F_TVel(ScaleFact, CalcStepIO%Vel_c(1:3)) + Ptfm%RotationVel(1:3,1) = FroudeScaleM2F_RVel(ScaleFact, CalcStepIO%Vel_c(4:6)) + Ptfm%TranslationAcc(1:3,1) = FroudeScaleM2F_TAcc(ScaleFact, CalcStepIO%Acc_c(1:3)) + Ptfm%RotationAcc(1:3,1) = FroudeScaleM2F_RAcc(ScaleFact, CalcStepIO%Acc_c(4:6)) + + !-------------------------------------- + ! transfer Ptfm to Tower + Twr => MeshMotions%TowerMotion + call Transfer_Point_to_Line2( Ptfm, Twr, MeshMaps%Motion_PRP_2_Twr, ErrStat2, ErrMsg2 ); if (Failed()) return; + + !-------------------------------------- + ! transfer Ptfm to hub (tower is rigid) + Hub => MeshMotions%HubMotion + call Transfer_Point_to_Point( Ptfm, Hub, MeshMaps%Motion_PRP_2_Hub, ErrStat2, ErrMsg2 ); if (Failed()) return; + + ! rotor azimuth + StructTmp%Azimuth = modulo(real(CalcStepIO%Time_c,ReKi)*StructTmp%RotSpeed + TrbInit%Azimuth, TwoPi ) + + ! update hub azimuth -- include initial azimuth + TmpAng = (/ real(StructTmp%Azimuth,DbKi), 0.0_DbKi, 0.0_DbKi /) + Orient = EulerConstruct(TmpAng) + Hub%Orientation(1:3,1:3,1) = matmul(Orient,Hub%Orientation(1:3,1:3,1)) + + !-------------------------------------- + ! hub to blades + do k=1,TrbCfg%NumBl + Root => MeshMotions%BladeRootMotion(k) + call Transfer_Point_to_Point( Hub, Root, MeshMaps%Motion_Hub_2_BldRoot(k), ErrStat2, ErrMsg2 ); if (Failed()) return; + enddo + +contains + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + Failed = errStat >= AbortErrLev + end function Failed +end subroutine + + + +!> updates the structural load meshes and populates aggregated loads +subroutine StructLoadsMeshTransfer(SimSettings, CalcStepIO, MeshMotions, MeshLoads, MeshMaps, StructTmp, ErrStat, ErrMsg) + type(SimSettingsType), target, intent(in ) :: SimSettings + type(CalcStepIOdataType), intent(in ) :: CalcStepIO + type(MeshesMotionType), target, intent(inout) :: MeshMotions + type(MeshesLoadsType), target, intent(inout) :: MeshLoads + type(MeshesMapsType ), intent(inout) :: MeshMaps + type(StructTmpType ), intent(inout) :: StructTmp + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WaveTank::StructMotionUpdate' + real(R8Ki) :: TmpTransDisp(3) + real(DbKi) :: TmpAng(3) ! temporary euler angle + real(R8Ki) :: Orient(3,3) ! temporary orientation + type(TurbConfigType), pointer :: TrbCfg ! to shorten notation + type(TurbInitCondType), pointer :: TrbInit ! to shorten notation + type(MeshType), pointer :: Ptfm, PtfmLd, PtfmLdTmp ! to shorten notation + type(MeshType), pointer :: Twr, TwrLd ! to shorten notation + type(MeshType), pointer :: Hub, HubLd ! to shorten notation + type(MeshType), pointer :: Root, RootLd ! to shorten notation + type(MeshType), pointer :: MoorLd ! to shorten notation + real(c_float) :: ScaleFact ! to shorten notation + integer(IntKi) :: k + + ErrStat = ErrID_None + ErrMsg = '' + + ! shorthand pointers + TrbCfg => SimSettings%TrbCfg + TrbInit => SimSettings%TrbInit + Hub => MeshMotions%HubMotion + HubLd => MeshLoads%HubLoads + Twr => MeshMotions%TowerMotion + TwrLd => MeshLoads%TowerLoads + Ptfm => MeshMotions%PtfmPtMotion + PtfmLd => MeshLoads%PtfmPtLoads + PtfmLdTmp=> MeshLoads%PtfmPtLoadsTmp + MoorLd => MeshLoads%MooringLoads + + !----------------------------------------- + ! Aero loading + !----------------------------------------- + ! Transfer blade root loads to hub + do k=1,TrbCfg%NumBl + Root => MeshMotions%BladeRootMotion(k) + RootLd => MeshLoads%BladeRootLoads(k) + call Transfer_Point_To_Point( RootLd, HubLd, MeshMaps%Load_BldRoot_2_Hub(k), ErrStat2, ErrMsg2, Root, Hub ) + if (Failed()) return + enddo + + ! Transfer hub to platform + call Transfer_Point_To_Point( HubLd, PtfmLd, MeshMaps%Load_Hub_2_PRP, ErrStat2, ErrMsg2, Hub, Ptfm ) + if (Failed()) return + + + !----------------------------------------- + ! Transfer tower to platform + ! NOTE: no tower loads at present from ADI + !FIXME: add tower loads output transfer to mesh here + !call Transfer_Line2_To_Point( TwrLd, PtfmLdTmp, MeshMaps%Load_Twr_2_PRP, ErrStat2, ErrMsg2, Twr, Ptfm ) + !PtfmLd%Force(1:3,1) = PtfmLd%Force(1:3,1) + PtfmLdTmp%Force(1:3,1) + !PtfmLd%Moment(1:3,1) = PtfmLd%Moment(1:3,1) + PtfmLdTmp%Moment(1:3,1) + + ! Store the ADI summed foreces and moments for output + StructTmp%FrcMom_ADI_at_Ptfm(1:3) = PtfmLd%Force(1:3,1) + StructTmp%FrcMom_ADI_at_Ptfm(4:6) = PtfmLd%Moment(1:3,1) + + + !----------------------------------------- + ! Mooring loading + !----------------------------------------- + ! Transfer mooring load + call Transfer_Point_To_Point( MoorLd, PtfmLdTmp, MeshMaps%Load_Moor_2_PRP, ErrStat2, ErrMsg2, Ptfm, Ptfm ) + if (Failed()) return + PtfmLd%Force(1:3,1) = PtfmLd%Force(1:3,1) + PtfmLdTmp%Force(1:3,1) + PtfmLd%Moment(1:3,1) = PtfmLd%Moment(1:3,1) + PtfmLdTmp%Moment(1:3,1) + + ! Store the MD summed foreces and moments for output + StructTmp%FrcMom_MD_at_Ptfm(1:3) = PtfmLdTmp%Force(1:3,1) + StructTmp%FrcMom_MD_at_Ptfm(4:6) = PtfmLdTmp%Moment(1:3,1) + +contains + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + Failed = errStat >= AbortErrLev + end function Failed +end subroutine + + + +!> destroy all structural model related info +subroutine StructDestroy(MeshMotions, MeshLoads, MeshMaps, StructTmp, ErrStat,ErrMsg) ! We are actually ignoring all errors from here + type(MeshesMotionType), intent(inout) :: MeshMotions + type(MeshesLoadsType ), intent(inout) :: MeshLoads + type(MeshesMapsType ), intent(inout) :: MeshMaps + type(StructTmpType ), intent(inout) :: StructTmp + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WaveTank::StructDestroy' + ErrStat = ErrID_None + ErrMsg = '' + call WT_DestroyMeshesMotionType(MeshMotions, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WT_DestroyMeshesLoadsType(MeshLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WT_DestroyMeshesMapsType(MeshMaps, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WT_DestroyStructTmpType(StructTmp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + + + +!> Convert an Euler angle set of Roll, Pitch, Yaw ordering to a DCM. +!! this routine exists for two reasons +!! 1. ordering may be different +!! 2. incoming Euler angle is c_float instead of R8Ki +!! NOTE: no Euler angles are exported, so we stick with the OF convention +!! for all internal conversions +function WT_EulerToDCM_fromInput(Ang) result(DCM) + real(c_float), intent(in ) :: Ang(3) + real(R8Ki) :: DCM(3,3) + !>>> Select one of the two following orders + ! 3-2-1 intrinsic rotation sequence of the 3 Tait-Bryan angles (1-2-3 extrinsic rotation) + DCM = EulerConstruct(real(Ang, DbKi)) + !! 1-2-3 intrinsic rotation sequence of the 3 Tait-Bryan angles (3-2-1 extrinsic rotation) + !DCM = EulerConstructZYX(real(Ang, DbKi)) +end function + + + +subroutine WrVTK_Struct_Ref(SimSettings, MeshMotions, MeshLoads, ErrStat, ErrMsg) + type(SimSettingsType), target, intent(in ) :: SimSettings + type(MeshesMotionType), intent(in ) :: MeshMotions + type(MeshesLoadsType ), intent(in ) :: MeshLoads + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WaveTank::WrVTK_Struct_Ref' + character(1024) :: DirRootName + real(SiKi) :: RefPt(3) + integer(IntKi) :: k + ErrStat = ErrID_None + ErrMsg = '' + RefPt = (/ 0.0_SiKi, 0.0_SiKi, 0.0_SiKi /) + DirRootName = trim(SimSettings%Viz%WrVTK_dir)//PathSep//trim(SimSettings%Sim%OutRootName) + ! Wave elevation measurement buoy + call MeshWrVTKreference(RefPt, MeshMotions%WaveBuoyMotion, trim(DirRootName)//'.WaveBuoyMotion', ErrStat2, ErrMsg2); if (Failed()) return + ! Platform point + call MeshWrVTKreference(RefPt, MeshMotions%PtfmPtMotion, trim(DirRootName)//'.Struct'//'.PtfmPtMotion', ErrStat2, ErrMsg2); if (Failed()) return + ! Tower + call MeshWrVTKreference(RefPt, MeshMotions%TowerMotion, trim(DirRootName)//'.Struct'//'.TowerMotion', ErrStat2, ErrMsg2); if (Failed()) return + ! hub point + call MeshWrVTKreference(RefPt, MeshMotions%HubMotion, trim(DirRootName)//'.Struct'//'.HubMotion', ErrStat2, ErrMsg2); if (Failed()) return + ! RootMotion points + do k=1,SimSettings%TrbCfg%NumBl + call MeshWrVTKreference(RefPt, MeshMotions%BladeRootMotion(k), trim(DirRootName)//'.Struct'//'.RootMotion'//trim(Num2LStr(k)), ErrStat2, ErrMsg2); if (Failed()) return + enddo +contains + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + Failed = errStat >= AbortErrLev + end function Failed +end subroutine + +subroutine WrVTK_Struct(n_Global, SimSettings, MeshMotions, MeshLoads, ErrStat, ErrMsg) + integer(IntKi), intent(in ) :: n_Global + type(SimSettingsType), target, intent(in ) :: SimSettings + type(MeshesMotionType), intent(in ) :: MeshMotions + type(MeshesLoadsType ), intent(in ) :: MeshLoads + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WaveTank::WrVTK_Struct' + character(1024) :: DirRootName + real(SiKi) :: RefPt(3) + integer(IntKi) :: k + ErrStat = ErrID_None + ErrMsg = '' + RefPt = (/ 0.0_SiKi, 0.0_SiKi, 0.0_SiKi /) + DirRootName = trim(SimSettings%Viz%WrVTK_dir)//PathSep//trim(SimSettings%Sim%OutRootName) + ! Wave elevation measurement buoy + call MeshWrVTK(RefPt, MeshMotions%WaveBuoyMotion, trim(DirRootName)//'.WaveBuoyMotion', n_Global, .true., ErrStat2, ErrMsg2, Twidth=SimSettings%Viz%Twidth); if (Failed()) return + ! Platform point + call MeshWrVTK(RefPt, MeshMotions%PtfmPtMotion, trim(DirRootName)//'.Struct'//'.PtfmPtMotion', n_Global, .true., ErrStat2, ErrMsg2, Twidth=SimSettings%Viz%Twidth); if (Failed()) return + ! Tower + call MeshWrVTK(RefPt, MeshMotions%TowerMotion, trim(DirRootName)//'.Struct'//'.TowerMotion', n_Global, .true., ErrStat2, ErrMsg2, Twidth=SimSettings%Viz%Twidth); if (Failed()) return + ! Hub point + call MeshWrVTK(RefPt, MeshMotions%HubMotion, trim(DirRootName)//'.Struct'//'.HubMotion', n_Global, .true., ErrStat2, ErrMsg2, Twidth=SimSettings%Viz%Twidth); if (Failed()) return + ! RootMotion points + do k=1,SimSettings%TrbCfg%NumBl + call MeshWrVTK(RefPt, MeshMotions%BladeRootMotion(k), trim(DirRootName)//'.Struct'//'.RootMotion'//trim(Num2LStr(k)), n_Global, .true., ErrStat2, ErrMsg2, Twidth=SimSettings%Viz%Twidth); if (Failed()) return + enddo +contains + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + Failed = errStat >= AbortErrLev + end function Failed +end subroutine + + + +!----------------------------------------------- +! Froude scaling from here: https://home.hvl.no/ansatte/gste/ftp/MarinLab_files/Litteratur/NTNU_Scaling_Laws.pdf, page 21 +! notation below: +! model scale: _m +! full scale: _f +! ScaleFact: length_f/length_m = lambda +! DensFact: rho_f/rho_m + +!> scale model displacements to full scale +!! length_full = length_model * lambda +function FroudeScaleM2F_Disp(ScaleFact, Pos_m, refPos_f) result(transDisp_f) + real(c_float), intent(in ) :: ScaleFact + real(c_float), intent(in ) :: Pos_m(3) + real(ReKi), intent(in ) :: refPos_f(3) + real(R8Ki) :: transdisp_f(3) + transDisp_f = real(ScaleFact*Pos_m,R8Ki) - real(refPos_f,R8Ki) +end function + +!> scale model translational velocity to full scale +!! TVel_full = TVel_model * sqrt( lambda ) TODO: check this!!!! +function FroudeScaleM2F_TVel(ScaleFact, TVel_m) result(TVel_f) + real(c_float), intent(in ) :: ScaleFact + real(c_float), intent(in ) :: TVel_m(3) + real(ReKi) :: TVel_f(3) + TVel_f = sqrt(real(ScaleFact,ReKi)) * real(TVel_m,ReKi) +end function + +!> scale model rotational velocity to full scale +!! RVel_full = RVel_model * sqrt(lambda) TODO: check this!!!! +function FroudeScaleM2F_RVel(ScaleFact, RVel_m) result(RVel_f) + real(c_float), intent(in ) :: ScaleFact + real(c_float), intent(in ) :: RVel_m(3) + real(ReKi) :: RVel_f(3) + RVel_f = real(RVel_m,ReKi) / sqrt(real(ScaleFact,ReKi)) +end function + +!> scale model translational acceleration to full scale +!! TAcc_full = TAcc_model ---> no scaling applied +function FroudeScaleM2F_TAcc(ScaleFact, TAcc_m) result(TAcc_f) + real(c_float), intent(in ) :: ScaleFact + real(c_float), intent(in ) :: TAcc_m(3) + real(ReKi) :: TAcc_f(3) + TAcc_f = real(TAcc_m,ReKi) +end function + +!> scale model rotational acceleration to full scale +!! RAcc_full = RAcc_model / lambda TODO: check this!!!! +function FroudeScaleM2F_RAcc(ScaleFact, RAcc_m) result(RAcc_f) + real(c_float), intent(in ) :: ScaleFact + real(c_float), intent(in ) :: RAcc_m(3) + real(ReKi) :: RAcc_f(3) + RAcc_f = real(RAcc_m,ReKi) / real(ScaleFact,ReKi) +end function + +!> scale model time to full scale +!! sqrt(lambda) = sqrt(Length_full/ Length_model) +function FroudeScaleM2F_Time(ScaleFact, Time_m) result(Time_f) + real(c_float), intent(in ) :: ScaleFact + real(c_double),intent(in ) :: Time_m + real(R8Ki) :: Time_f + Time_f = sqrt(real(ScaleFact,R8Ki)) * real(Time_m,R8Ki) +end function + +!> scale full scale force to model +!! lambda^3 * DensFact * Frc_model = Frc_full +function FroudeScaleF2M_Frc(ScaleFact, DensFact, Frc_f) result(Frc_m) + real(c_float), intent(in ) :: ScaleFact + real(c_float), intent(in ) :: DensFact + real(ReKi), intent(in ) :: Frc_f(3) + real(c_float) :: Frc_m(3) + Frc_m = real(Frc_f, c_float) / (ScaleFact**3 * DensFact) +end function + +!> scale full scale moment to model +!! lambda^4 * DensFact * Mom_model = Mom_full +function FroudeScaleF2M_Mom(ScaleFact, DensFact, Mom_f) result(Mom_m) + real(c_float), intent(in ) :: ScaleFact + real(c_float), intent(in ) :: DensFact + real(ReKi), intent(in ) :: Mom_f(3) + real(c_float) :: Mom_m(3) + Mom_m = real(Mom_f, c_float) / (ScaleFact**4 * DensFact) +end function + + +end module diff --git a/glue-codes/labview/src/WaveTank_Types.f90 b/glue-codes/labview/src/WaveTank_Types.f90 new file mode 100644 index 0000000000..c134bcaa1e --- /dev/null +++ b/glue-codes/labview/src/WaveTank_Types.f90 @@ -0,0 +1,1671 @@ +!STARTOFREGISTRYGENERATEDFILE 'WaveTank_Types.f90' +! +! WARNING This file is generated automatically by the FAST registry. +! Do not edit. Your changes to this file will be lost. +! +! FAST Registry +!********************************************************************************************************************************* +! WaveTank_Types +!................................................................................................................................. +! This file is part of WaveTank. +! +! Copyright (C) 2012-2016 National Renewable Energy Laboratory +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +! +! +! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. +! +!********************************************************************************************************************************* +!> This module contains the user-defined types needed in WaveTank. It also contains copy, destroy, pack, and +!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. +MODULE WaveTank_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE ISO_C_BINDING +USE NWTC_Library +IMPLICIT NONE +! ========= SimType ======= + TYPE, PUBLIC :: SimType + REAL(c_double) :: DT = 0.0_R8Ki !< timestep [-] + REAL(c_double) :: TMax = 0.0_R8Ki !< Max sim time [-] + INTEGER(c_int) :: MHK = 0_IntKi !< MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine} [(-)] + INTEGER(c_int) :: InterpOrd = 1 !< Interpolation order [-] + REAL(c_float) :: ScaleFact = 1 + REAL(c_float) :: DensFact = 1 !< ratio of density - Density_full/Density_model (rho_F/rho_M). Used with Froude scaling of forces/moments [(-)] + INTEGER(c_int) :: DebugLevel = 0_IntKi !< Debug level for outputs [-] + character(1024) :: OutRootName !< Rootname for outputs [-] + END TYPE SimType +! ======================= +! ========= EnvType ======= + TYPE, PUBLIC :: EnvType + REAL(c_float) :: Gravity = 0.0_R4Ki !< gravitational constant (positive for down) [(m/s^2)] + REAL(c_float) :: WtrDens = 0.0_R4Ki !< Water density [(kg/m^3)] + REAL(c_float) :: WtrVisc = 0.0_R4Ki !< fluid viscosity [(m^2/s)] + REAL(c_float) :: SpdSound = 0.0_R4Ki !< Speed of sound in working fluid [(m/s)] + REAL(c_float) :: Patm = 0.0_R4Ki !< Atmospheric pressure [used only for an MHK turbine cavitation check] [(Pa)] + REAL(c_float) :: Pvap = 0.0_R4Ki !< Vapour pressure of working fluid [used only for an MHK turbine cavitation check] [(Pa)] + REAL(c_float) :: WtrDpth = 0.0_R4Ki !< Water depth [(m)] + REAL(c_float) :: MSL2SWL = 0.0_R4Ki !< Mean sea level to still water level [(m)] + END TYPE EnvType +! ======================= +! ========= TurbConfigType ======= + TYPE, PUBLIC :: TurbConfigType + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of blades [(-)] + REAL(SiKi) :: HubRad = 0.0_R4Ki !< The distance from the rotor apex to the blade root [(m)] + REAL(SiKi) :: PreCone = 0.0_R4Ki !< Blade cone angle [(deg)] + REAL(SiKi) :: OverHang = 0.0_R4Ki !< Distance from yaw axis to rotor apex [3 blades] or teeter pin [2 blades] [(m)] + REAL(SiKi) :: ShftTilt = 0.0_R4Ki !< Rotor shaft tilt angle [(deg)] + REAL(SiKi) :: Twr2Shft = 0.0_R4Ki !< Vertical distance from the tower-top to the rotor shaft [(m)] + REAL(SiKi) :: TowerHt = 0.0_R4Ki !< Height of tower relative MSL [(m)] + REAL(SiKi) , DIMENSION(1:3) :: TowerBsPt = 0.0_R4Ki !< Tower base location relative to MSL. Consider absolute difference to PtfmRef [floating MHK] [(m)] + REAL(SiKi) , DIMENSION(1:3) :: PtfmRefPos = 0.0_R4Ki !< Location of platform reference point, relative to MSL. Motions and loads all connect to this point [(m)] + REAL(SiKi) , DIMENSION(1:3) :: PtfmRefOrient = 0.0_R4Ki !< Orientation of platform reference point, Euler angle set of roll,pitch,yaw [(rad)] + END TYPE TurbConfigType +! ======================= +! ========= TurbInitCondType ======= + TYPE, PUBLIC :: TurbInitCondType + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Rotor speed [(RPM)] + REAL(ReKi) :: NacYaw = 0.0_ReKi !< Initial or fixed nacelle-yaw angle - read as deg, convert to rad [(rad)] + REAL(ReKi) :: BldPitch = 0.0_ReKi !< Fixed blade pitch for full simulation - read as deg, convert to rad [(rad)] + REAL(ReKi) :: Azimuth = 0 !< Initial azimuth (actual azimuth calculated and not stored) - read as deg, convert to rad [(rad)] + END TYPE TurbInitCondType +! ======================= +! ========= WaveBuoyType ======= + TYPE, PUBLIC :: WaveBuoyType + REAL(ReKi) , DIMENSION(1:2) :: XYLoc = 0.0_ReKi !< Location of the wave elevation measurement buoy. SeaState data returned at every timestep at this location [(m)] + END TYPE WaveBuoyType +! ======================= +! ========= OutFilesType ======= + TYPE, PUBLIC :: OutFilesType + LOGICAL :: SendScreenToFile = .false. !< send to file .screen.log if true [(-)] + INTEGER(c_int) :: OutFile = 0_IntKi !< 0: no output file of channels, 1: output file in text format (at DT) [(-)] + character(20) :: OutFmt !< Format used for text tabular output, excluding the time channel. (quoted string) [(-)] + END TYPE OutFilesType +! ======================= +! ========= VizType ======= + TYPE, PUBLIC :: VizType + INTEGER(c_int) :: WrVTK = 0_IntKi !< Write VTK? [-] + INTEGER(c_int) :: WrVTK_type = 0_IntKi !< Write VTK outputs as [1: surface, 2: lines, 3: both] [-] + REAL(c_double) :: WrVTK_DT = 0.0_R8Ki !< Time step between VTK writes [-] + character(1024) :: WrVTK_dir !< Directory for VTK writing [-] + REAL(c_float) , DIMENSION(1:6) :: VTKNacDim = 0.0_R4Ki !< Nacelle dimension passed in for VTK surface rendering [0,y0,z0,Lx,Ly,Lz] [(m)] + INTEGER(IntKi) :: Twidth = 6 !< Time width -- hard coded for now [(-)] + END TYPE VizType +! ======================= +! ========= ModSettings ======= + TYPE, PUBLIC :: ModSettings + character(1024) :: SS_InputFile !< SeaState input file [(-)] + REAL(DbKi) :: WaveTimeShift = 0.0_R8Ki !< Shift the SeaState wavetime by this amount (for phase shifting waves to match tank) [(s)] + character(1024) :: MD_InputFile !< MoorDyn input file [(-)] + character(1024) :: AD_InputFile !< AeroDyn input file [(-)] + character(1024) :: IfW_InputFile !< InflowWind input file [(-)] + END TYPE ModSettings +! ======================= +! ========= SimSettingsType ======= + TYPE, PUBLIC :: SimSettingsType + TYPE(SimType) :: Sim !< Simulation settings [-] + TYPE(EnvType) :: Env !< Environment settings [-] + TYPE(TurbConfigType) :: TrbCfg !< Turbine configuration [-] + TYPE(TurbInitCondType) :: TrbInit !< Turbine initial operating point [-] + TYPE(WaveBuoyType) :: WaveBuoy !< Wave elevation buoy locat (x-y) [(m)] + TYPE(OutFilesType) :: Outs !< Output settings [-] + TYPE(VizType) :: Viz !< Vizualization settings [-] + TYPE(ModSettings) :: ModSettings !< Input files for each module [-] + END TYPE SimSettingsType +! ======================= +! ========= CalcStepIOdataType ======= + TYPE, PUBLIC :: CalcStepIOdataType + REAL(c_double) :: Time_c = 0.0_R8Ki !< IN: time [(s)] + REAL(c_float) , DIMENSION(1:6) :: PosAng_c = 0.0_R4Ki !< IN: Position + Euler Ang [x,y,z,phi,theta,psi] [[(m) (rad)]] + REAL(c_float) , DIMENSION(1:6) :: Vel_c = 0.0_R4Ki !< IN: Velocity [Vx,Vy,Vz,RVx,RVy,RVz] [[(m/s) (rad/s)]] + REAL(c_float) , DIMENSION(1:6) :: Acc_c = 0.0_R4Ki !< IN: Acceleration [Ax,Ay,Az,RAx,RAy,RAz] [[(m/s^2) (rad/s^2)]] + REAL(c_float) , DIMENSION(1:6) :: FrcMom_c = 0.0_R4Ki !< OUT: Acceleration [Fx,Fy,Fz,Mx,My,Mz] [[(N) (N-m)]] + REAL(c_float) , DIMENSION(1:6) :: FrcMom_MD_c = 0.0_R4Ki !< calculated forces/moments from MD [-] + REAL(c_float) , DIMENSION(:), ALLOCATABLE :: FrcMom_ADI_c !< calculated forces/moments from ADI [-] + REAL(c_float) , DIMENSION(1:3) :: HubVel_ADI_c = 0.0_R4Ki !< hub height wind vel from ADI [-] + REAL(ReKi) :: BuoyWaveElev = 0.0_ReKi !< calculated wave elevation at buoy [-] + END TYPE CalcStepIOdataType +! ======================= +! ========= WrOutputDataType ======= + TYPE, PUBLIC :: WrOutputDataType + INTEGER(IntKi) :: NumChans_cbind = 0 !< Number of output channels from c-bind [-] + INTEGER(IntKi) :: NumChans_SS = 0 !< Number of output channels from SS [-] + INTEGER(IntKi) :: NumChans_MD = 0 !< Number of output channels from MD [-] + INTEGER(IntKi) :: NumChans_ADI = 0 !< Number of output channels from ADI [-] + INTEGER(IntKi) :: NumChans_all = 0 !< Total number of channels (sum of above) [-] + character(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr_SS !< output file header names from SS [-] + character(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt_SS !< output file header units from SS [-] + character(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr_MD !< output file header names from MD [-] + character(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt_MD !< output file header units from MD [-] + character(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr_ADI !< output file header names from ADI [-] + character(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt_ADI !< output file header units from ADI [-] + REAL(c_float) , DIMENSION(:), ALLOCATABLE :: OutData_SS_c !< output data from SS as passed c_float [-] + REAL(c_float) , DIMENSION(:), ALLOCATABLE :: OutData_MD_c !< output data from MD as passed c_float [-] + REAL(c_float) , DIMENSION(:), ALLOCATABLE :: OutData_ADI_c !< output data from ADI as passed c_float [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: OutData_SS !< output data from SS [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: OutData_MD !< output data from MD [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: OutData_ADI !< output data from ADI [-] + character(1024) :: OutName !< Output file name [-] + INTEGER(IntKi) :: OutUn = -1 !< Output unit [-] + END TYPE WrOutputDataType +! ======================= +! ========= MeshesMotionType ======= + TYPE, PUBLIC :: MeshesMotionType + TYPE(MeshType) :: PtfmPtMotion !< Platform principle ref point. Also serves as tower base [-] + TYPE(MeshType) :: TowerMotion !< Tower mesh (used only for vis) [-] + TYPE(MeshType) :: HubMotion !< Hub mesh (for mappings, no loadings) [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeRootMotion !< Blade root motions [-] + TYPE(MeshType) :: WaveBuoyMotion !< wave measurement buoy motion (sensor only) [-] + END TYPE MeshesMotionType +! ======================= +! ========= MeshesLoadsType ======= + TYPE, PUBLIC :: MeshesLoadsType + TYPE(MeshType) :: PtfmPtLoads !< Platform principle ref point loads output [-] + TYPE(MeshType) :: PtfmPtLoadsTmp !< Platform principle ref point loads output - temp var for load summation [-] + TYPE(MeshType) :: MooringLoads !< Mooring loads (always at PtfmPt, but separated for simplicity) [-] + TYPE(MeshType) :: TowerLoads !< Tower mesh (unused) [-] + TYPE(MeshType) :: HubLoads !< Hub mesh (for mappings, intermediate loads) [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeRootLoads !< Blade root loads [-] + END TYPE MeshesLoadsType +! ======================= +! ========= MeshesMapsType ======= + TYPE, PUBLIC :: MeshesMapsType + TYPE(MeshMapType) :: Motion_PRP_2_Twr !< PRP to tower motion [-] + TYPE(MeshMapType) :: Motion_PRP_2_Hub !< Twrtop to nacelle - add rotation afterwards [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: Motion_Hub_2_BldRoot !< Hub to blade root motion transfer [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: Load_BldRoot_2_Hub !< Blade root loads to hub [-] + TYPE(MeshMapType) :: Load_Hub_2_PRP !< Hub to nacelle load transfer [-] + TYPE(MeshMapType) :: Load_Twr_2_PRP !< Tower loads to PRP (unused) [-] + TYPE(MeshMapType) :: Load_Moor_2_PRP !< Mooring loads to PRP [-] + END TYPE MeshesMapsType +! ======================= +! ========= StructTmpType ======= + TYPE, PUBLIC :: StructTmpType + REAL(ReKi) :: Azimuth = 0 !< Current Azimuth [(rad)] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Rotor speed [(RPM)] + REAL(ReKi) :: BldPitch = 0.0_ReKi !< Blade pitch [(rad)] + REAL(ReKi) :: NacYaw = 0.0_ReKi !< Nacelle-yaw angle [(rad)] + REAL(ReKi) , DIMENSION(1:6) :: FrcMom_ADI_at_Ptfm = 0.0_ReKi !< Total aero loading summed to Ptfm point [(N,] + REAL(ReKi) , DIMENSION(1:6) :: FrcMom_MD_at_Ptfm = 0.0_ReKi !< MoorDyn loading at Ptfm point [(N,] + REAL(c_float) , DIMENSION(1:2) :: BuoyPos_c = 0.0_R4Ki !< Buoy XY position [(m)] + REAL(c_float) , DIMENSION(1:6) :: PtfmPosAng_c = 0.0_R4Ki !< Temp position and euler angle [(m,] + REAL(c_float) , DIMENSION(1:6) :: PtfmVel_c = 0.0_R4Ki !< Temp velocity [(m/s,] + REAL(c_float) , DIMENSION(1:6) :: PtfmAcc_c = 0.0_R4Ki !< Temp acceleration [(m/s^2,] + REAL(c_float) , DIMENSION(1:3) :: NacPos_c = 0.0_R4Ki !< Temp nacelle position [(m,] + REAL(c_double) , DIMENSION(1:9) :: NacDCM_c = 0.0_R8Ki !< Temp nacelle orientation DCM [(-)] + REAL(c_float) , DIMENSION(1:6) :: NacVel_c = 0.0_R4Ki !< Temp nacelle velocity [(m/s,] + REAL(c_float) , DIMENSION(1:6) :: NacAcc_c = 0.0_R4Ki !< Temp nacelle acceleration [(m/s^2,] + REAL(c_float) , DIMENSION(1:3) :: HubPos_c = 0.0_R4Ki !< Temp hub position [(m,] + REAL(c_double) , DIMENSION(1:9) :: HubDCM_c = 0.0_R8Ki !< Temp hub orientation DCM [(-)] + REAL(c_float) , DIMENSION(1:6) :: HubVel_c = 0.0_R4Ki !< Temp hub velocity [(m/s,] + REAL(c_float) , DIMENSION(1:6) :: HubAcc_c = 0.0_R4Ki !< Temp hub acceleration [(m/s^2,] + REAL(c_float) , DIMENSION(:), ALLOCATABLE :: BldPos_c !< Temp blade position -- sequential by blade [(m)] + REAL(c_double) , DIMENSION(:), ALLOCATABLE :: BldDCM_c !< Temp blade orientation DCM -- flat sequential by blade [(-)] + REAL(c_float) , DIMENSION(:), ALLOCATABLE :: BldVel_c !< Temp blade velocity -- sequential by blade [(m/s,] + REAL(c_float) , DIMENSION(:), ALLOCATABLE :: BldAcc_c !< Temp blade acceleration -- sequential by blade [(m/s^2,] + END TYPE StructTmpType +! ======================= +CONTAINS + +subroutine WT_CopySimType(SrcSimTypeData, DstSimTypeData, CtrlCode, ErrStat, ErrMsg) + type(SimType), intent(in) :: SrcSimTypeData + type(SimType), intent(inout) :: DstSimTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WT_CopySimType' + ErrStat = ErrID_None + ErrMsg = '' + DstSimTypeData%DT = SrcSimTypeData%DT + DstSimTypeData%TMax = SrcSimTypeData%TMax + DstSimTypeData%MHK = SrcSimTypeData%MHK + DstSimTypeData%InterpOrd = SrcSimTypeData%InterpOrd + DstSimTypeData%ScaleFact = SrcSimTypeData%ScaleFact + DstSimTypeData%DensFact = SrcSimTypeData%DensFact + DstSimTypeData%DebugLevel = SrcSimTypeData%DebugLevel + DstSimTypeData%OutRootName = SrcSimTypeData%OutRootName +end subroutine + +subroutine WT_DestroySimType(SimTypeData, ErrStat, ErrMsg) + type(SimType), intent(inout) :: SimTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WT_DestroySimType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine WT_PackSimType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SimType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WT_PackSimType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%TMax) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%InterpOrd) + call RegPack(RF, InData%ScaleFact) + call RegPack(RF, InData%DensFact) + call RegPack(RF, InData%DebugLevel) + call RegPack(RF, InData%OutRootName) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_UnPackSimType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SimType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WT_UnPackSimType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InterpOrd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ScaleFact); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DensFact); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DebugLevel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutRootName); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_CopyEnvType(SrcEnvTypeData, DstEnvTypeData, CtrlCode, ErrStat, ErrMsg) + type(EnvType), intent(in) :: SrcEnvTypeData + type(EnvType), intent(inout) :: DstEnvTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WT_CopyEnvType' + ErrStat = ErrID_None + ErrMsg = '' + DstEnvTypeData%Gravity = SrcEnvTypeData%Gravity + DstEnvTypeData%WtrDens = SrcEnvTypeData%WtrDens + DstEnvTypeData%WtrVisc = SrcEnvTypeData%WtrVisc + DstEnvTypeData%SpdSound = SrcEnvTypeData%SpdSound + DstEnvTypeData%Patm = SrcEnvTypeData%Patm + DstEnvTypeData%Pvap = SrcEnvTypeData%Pvap + DstEnvTypeData%WtrDpth = SrcEnvTypeData%WtrDpth + DstEnvTypeData%MSL2SWL = SrcEnvTypeData%MSL2SWL +end subroutine + +subroutine WT_DestroyEnvType(EnvTypeData, ErrStat, ErrMsg) + type(EnvType), intent(inout) :: EnvTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WT_DestroyEnvType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine WT_PackEnvType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(EnvType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WT_PackEnvType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%WtrDens) + call RegPack(RF, InData%WtrVisc) + call RegPack(RF, InData%SpdSound) + call RegPack(RF, InData%Patm) + call RegPack(RF, InData%Pvap) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%MSL2SWL) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_UnPackEnvType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(EnvType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WT_UnPackEnvType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Patm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pvap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_CopyTurbConfigType(SrcTurbConfigTypeData, DstTurbConfigTypeData, CtrlCode, ErrStat, ErrMsg) + type(TurbConfigType), intent(in) :: SrcTurbConfigTypeData + type(TurbConfigType), intent(inout) :: DstTurbConfigTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WT_CopyTurbConfigType' + ErrStat = ErrID_None + ErrMsg = '' + DstTurbConfigTypeData%NumBl = SrcTurbConfigTypeData%NumBl + DstTurbConfigTypeData%HubRad = SrcTurbConfigTypeData%HubRad + DstTurbConfigTypeData%PreCone = SrcTurbConfigTypeData%PreCone + DstTurbConfigTypeData%OverHang = SrcTurbConfigTypeData%OverHang + DstTurbConfigTypeData%ShftTilt = SrcTurbConfigTypeData%ShftTilt + DstTurbConfigTypeData%Twr2Shft = SrcTurbConfigTypeData%Twr2Shft + DstTurbConfigTypeData%TowerHt = SrcTurbConfigTypeData%TowerHt + DstTurbConfigTypeData%TowerBsPt = SrcTurbConfigTypeData%TowerBsPt + DstTurbConfigTypeData%PtfmRefPos = SrcTurbConfigTypeData%PtfmRefPos + DstTurbConfigTypeData%PtfmRefOrient = SrcTurbConfigTypeData%PtfmRefOrient +end subroutine + +subroutine WT_DestroyTurbConfigType(TurbConfigTypeData, ErrStat, ErrMsg) + type(TurbConfigType), intent(inout) :: TurbConfigTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WT_DestroyTurbConfigType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine WT_PackTurbConfigType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(TurbConfigType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WT_PackTurbConfigType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumBl) + call RegPack(RF, InData%HubRad) + call RegPack(RF, InData%PreCone) + call RegPack(RF, InData%OverHang) + call RegPack(RF, InData%ShftTilt) + call RegPack(RF, InData%Twr2Shft) + call RegPack(RF, InData%TowerHt) + call RegPack(RF, InData%TowerBsPt) + call RegPack(RF, InData%PtfmRefPos) + call RegPack(RF, InData%PtfmRefOrient) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_UnPackTurbConfigType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(TurbConfigType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WT_UnPackTurbConfigType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PreCone); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OverHang); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShftTilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Twr2Shft); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerBsPt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRefPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRefOrient); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_CopyTurbInitCondType(SrcTurbInitCondTypeData, DstTurbInitCondTypeData, CtrlCode, ErrStat, ErrMsg) + type(TurbInitCondType), intent(in) :: SrcTurbInitCondTypeData + type(TurbInitCondType), intent(inout) :: DstTurbInitCondTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WT_CopyTurbInitCondType' + ErrStat = ErrID_None + ErrMsg = '' + DstTurbInitCondTypeData%RotSpeed = SrcTurbInitCondTypeData%RotSpeed + DstTurbInitCondTypeData%NacYaw = SrcTurbInitCondTypeData%NacYaw + DstTurbInitCondTypeData%BldPitch = SrcTurbInitCondTypeData%BldPitch + DstTurbInitCondTypeData%Azimuth = SrcTurbInitCondTypeData%Azimuth +end subroutine + +subroutine WT_DestroyTurbInitCondType(TurbInitCondTypeData, ErrStat, ErrMsg) + type(TurbInitCondType), intent(inout) :: TurbInitCondTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WT_DestroyTurbInitCondType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine WT_PackTurbInitCondType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(TurbInitCondType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WT_PackTurbInitCondType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%NacYaw) + call RegPack(RF, InData%BldPitch) + call RegPack(RF, InData%Azimuth) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_UnPackTurbInitCondType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(TurbInitCondType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WT_UnPackTurbInitCondType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Azimuth); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_CopyWaveBuoyType(SrcWaveBuoyTypeData, DstWaveBuoyTypeData, CtrlCode, ErrStat, ErrMsg) + type(WaveBuoyType), intent(in) :: SrcWaveBuoyTypeData + type(WaveBuoyType), intent(inout) :: DstWaveBuoyTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WT_CopyWaveBuoyType' + ErrStat = ErrID_None + ErrMsg = '' + DstWaveBuoyTypeData%XYLoc = SrcWaveBuoyTypeData%XYLoc +end subroutine + +subroutine WT_DestroyWaveBuoyType(WaveBuoyTypeData, ErrStat, ErrMsg) + type(WaveBuoyType), intent(inout) :: WaveBuoyTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WT_DestroyWaveBuoyType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine WT_PackWaveBuoyType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WaveBuoyType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WT_PackWaveBuoyType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%XYLoc) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_UnPackWaveBuoyType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WaveBuoyType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WT_UnPackWaveBuoyType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%XYLoc); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_CopyOutFilesType(SrcOutFilesTypeData, DstOutFilesTypeData, CtrlCode, ErrStat, ErrMsg) + type(OutFilesType), intent(in) :: SrcOutFilesTypeData + type(OutFilesType), intent(inout) :: DstOutFilesTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WT_CopyOutFilesType' + ErrStat = ErrID_None + ErrMsg = '' + DstOutFilesTypeData%SendScreenToFile = SrcOutFilesTypeData%SendScreenToFile + DstOutFilesTypeData%OutFile = SrcOutFilesTypeData%OutFile + DstOutFilesTypeData%OutFmt = SrcOutFilesTypeData%OutFmt +end subroutine + +subroutine WT_DestroyOutFilesType(OutFilesTypeData, ErrStat, ErrMsg) + type(OutFilesType), intent(inout) :: OutFilesTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WT_DestroyOutFilesType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine WT_PackOutFilesType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(OutFilesType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WT_PackOutFilesType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%SendScreenToFile) + call RegPack(RF, InData%OutFile) + call RegPack(RF, InData%OutFmt) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_UnPackOutFilesType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(OutFilesType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WT_UnPackOutFilesType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%SendScreenToFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_CopyVizType(SrcVizTypeData, DstVizTypeData, CtrlCode, ErrStat, ErrMsg) + type(VizType), intent(in) :: SrcVizTypeData + type(VizType), intent(inout) :: DstVizTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WT_CopyVizType' + ErrStat = ErrID_None + ErrMsg = '' + DstVizTypeData%WrVTK = SrcVizTypeData%WrVTK + DstVizTypeData%WrVTK_type = SrcVizTypeData%WrVTK_type + DstVizTypeData%WrVTK_DT = SrcVizTypeData%WrVTK_DT + DstVizTypeData%WrVTK_dir = SrcVizTypeData%WrVTK_dir + DstVizTypeData%VTKNacDim = SrcVizTypeData%VTKNacDim + DstVizTypeData%Twidth = SrcVizTypeData%Twidth +end subroutine + +subroutine WT_DestroyVizType(VizTypeData, ErrStat, ErrMsg) + type(VizType), intent(inout) :: VizTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WT_DestroyVizType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine WT_PackVizType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(VizType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WT_PackVizType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%WrVTK) + call RegPack(RF, InData%WrVTK_type) + call RegPack(RF, InData%WrVTK_DT) + call RegPack(RF, InData%WrVTK_dir) + call RegPack(RF, InData%VTKNacDim) + call RegPack(RF, InData%Twidth) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_UnPackVizType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(VizType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WT_UnPackVizType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%WrVTK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrVTK_type); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrVTK_DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrVTK_dir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKNacDim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Twidth); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_CopyModSettings(SrcModSettingsData, DstModSettingsData, CtrlCode, ErrStat, ErrMsg) + type(ModSettings), intent(in) :: SrcModSettingsData + type(ModSettings), intent(inout) :: DstModSettingsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WT_CopyModSettings' + ErrStat = ErrID_None + ErrMsg = '' + DstModSettingsData%SS_InputFile = SrcModSettingsData%SS_InputFile + DstModSettingsData%WaveTimeShift = SrcModSettingsData%WaveTimeShift + DstModSettingsData%MD_InputFile = SrcModSettingsData%MD_InputFile + DstModSettingsData%AD_InputFile = SrcModSettingsData%AD_InputFile + DstModSettingsData%IfW_InputFile = SrcModSettingsData%IfW_InputFile +end subroutine + +subroutine WT_DestroyModSettings(ModSettingsData, ErrStat, ErrMsg) + type(ModSettings), intent(inout) :: ModSettingsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WT_DestroyModSettings' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine WT_PackModSettings(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ModSettings), intent(in) :: InData + character(*), parameter :: RoutineName = 'WT_PackModSettings' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%SS_InputFile) + call RegPack(RF, InData%WaveTimeShift) + call RegPack(RF, InData%MD_InputFile) + call RegPack(RF, InData%AD_InputFile) + call RegPack(RF, InData%IfW_InputFile) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_UnPackModSettings(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ModSettings), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WT_UnPackModSettings' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%SS_InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveTimeShift); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MD_InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AD_InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IfW_InputFile); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_CopySimSettingsType(SrcSimSettingsTypeData, DstSimSettingsTypeData, CtrlCode, ErrStat, ErrMsg) + type(SimSettingsType), intent(in) :: SrcSimSettingsTypeData + type(SimSettingsType), intent(inout) :: DstSimSettingsTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WT_CopySimSettingsType' + ErrStat = ErrID_None + ErrMsg = '' + call WT_CopySimType(SrcSimSettingsTypeData%Sim, DstSimSettingsTypeData%Sim, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WT_CopyEnvType(SrcSimSettingsTypeData%Env, DstSimSettingsTypeData%Env, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WT_CopyTurbConfigType(SrcSimSettingsTypeData%TrbCfg, DstSimSettingsTypeData%TrbCfg, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WT_CopyTurbInitCondType(SrcSimSettingsTypeData%TrbInit, DstSimSettingsTypeData%TrbInit, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WT_CopyWaveBuoyType(SrcSimSettingsTypeData%WaveBuoy, DstSimSettingsTypeData%WaveBuoy, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WT_CopyOutFilesType(SrcSimSettingsTypeData%Outs, DstSimSettingsTypeData%Outs, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WT_CopyVizType(SrcSimSettingsTypeData%Viz, DstSimSettingsTypeData%Viz, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WT_CopyModSettings(SrcSimSettingsTypeData%ModSettings, DstSimSettingsTypeData%ModSettings, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine WT_DestroySimSettingsType(SimSettingsTypeData, ErrStat, ErrMsg) + type(SimSettingsType), intent(inout) :: SimSettingsTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WT_DestroySimSettingsType' + ErrStat = ErrID_None + ErrMsg = '' + call WT_DestroySimType(SimSettingsTypeData%Sim, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WT_DestroyEnvType(SimSettingsTypeData%Env, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WT_DestroyTurbConfigType(SimSettingsTypeData%TrbCfg, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WT_DestroyTurbInitCondType(SimSettingsTypeData%TrbInit, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WT_DestroyWaveBuoyType(SimSettingsTypeData%WaveBuoy, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WT_DestroyOutFilesType(SimSettingsTypeData%Outs, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WT_DestroyVizType(SimSettingsTypeData%Viz, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WT_DestroyModSettings(SimSettingsTypeData%ModSettings, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WT_PackSimSettingsType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SimSettingsType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WT_PackSimSettingsType' + if (RF%ErrStat >= AbortErrLev) return + call WT_PackSimType(RF, InData%Sim) + call WT_PackEnvType(RF, InData%Env) + call WT_PackTurbConfigType(RF, InData%TrbCfg) + call WT_PackTurbInitCondType(RF, InData%TrbInit) + call WT_PackWaveBuoyType(RF, InData%WaveBuoy) + call WT_PackOutFilesType(RF, InData%Outs) + call WT_PackVizType(RF, InData%Viz) + call WT_PackModSettings(RF, InData%ModSettings) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_UnPackSimSettingsType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SimSettingsType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WT_UnPackSimSettingsType' + if (RF%ErrStat /= ErrID_None) return + call WT_UnpackSimType(RF, OutData%Sim) ! Sim + call WT_UnpackEnvType(RF, OutData%Env) ! Env + call WT_UnpackTurbConfigType(RF, OutData%TrbCfg) ! TrbCfg + call WT_UnpackTurbInitCondType(RF, OutData%TrbInit) ! TrbInit + call WT_UnpackWaveBuoyType(RF, OutData%WaveBuoy) ! WaveBuoy + call WT_UnpackOutFilesType(RF, OutData%Outs) ! Outs + call WT_UnpackVizType(RF, OutData%Viz) ! Viz + call WT_UnpackModSettings(RF, OutData%ModSettings) ! ModSettings +end subroutine + +subroutine WT_CopyCalcStepIOdataType(SrcCalcStepIOdataTypeData, DstCalcStepIOdataTypeData, CtrlCode, ErrStat, ErrMsg) + type(CalcStepIOdataType), intent(in) :: SrcCalcStepIOdataTypeData + type(CalcStepIOdataType), intent(inout) :: DstCalcStepIOdataTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WT_CopyCalcStepIOdataType' + ErrStat = ErrID_None + ErrMsg = '' + DstCalcStepIOdataTypeData%Time_c = SrcCalcStepIOdataTypeData%Time_c + DstCalcStepIOdataTypeData%PosAng_c = SrcCalcStepIOdataTypeData%PosAng_c + DstCalcStepIOdataTypeData%Vel_c = SrcCalcStepIOdataTypeData%Vel_c + DstCalcStepIOdataTypeData%Acc_c = SrcCalcStepIOdataTypeData%Acc_c + DstCalcStepIOdataTypeData%FrcMom_c = SrcCalcStepIOdataTypeData%FrcMom_c + DstCalcStepIOdataTypeData%FrcMom_MD_c = SrcCalcStepIOdataTypeData%FrcMom_MD_c + if (allocated(SrcCalcStepIOdataTypeData%FrcMom_ADI_c)) then + LB(1:1) = lbound(SrcCalcStepIOdataTypeData%FrcMom_ADI_c) + UB(1:1) = ubound(SrcCalcStepIOdataTypeData%FrcMom_ADI_c) + if (.not. allocated(DstCalcStepIOdataTypeData%FrcMom_ADI_c)) then + allocate(DstCalcStepIOdataTypeData%FrcMom_ADI_c(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCalcStepIOdataTypeData%FrcMom_ADI_c.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCalcStepIOdataTypeData%FrcMom_ADI_c = SrcCalcStepIOdataTypeData%FrcMom_ADI_c + end if + DstCalcStepIOdataTypeData%HubVel_ADI_c = SrcCalcStepIOdataTypeData%HubVel_ADI_c + DstCalcStepIOdataTypeData%BuoyWaveElev = SrcCalcStepIOdataTypeData%BuoyWaveElev +end subroutine + +subroutine WT_DestroyCalcStepIOdataType(CalcStepIOdataTypeData, ErrStat, ErrMsg) + type(CalcStepIOdataType), intent(inout) :: CalcStepIOdataTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WT_DestroyCalcStepIOdataType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(CalcStepIOdataTypeData%FrcMom_ADI_c)) then + deallocate(CalcStepIOdataTypeData%FrcMom_ADI_c) + end if +end subroutine + +subroutine WT_PackCalcStepIOdataType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(CalcStepIOdataType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WT_PackCalcStepIOdataType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Time_c) + call RegPack(RF, InData%PosAng_c) + call RegPack(RF, InData%Vel_c) + call RegPack(RF, InData%Acc_c) + call RegPack(RF, InData%FrcMom_c) + call RegPack(RF, InData%FrcMom_MD_c) + call RegPackAlloc(RF, InData%FrcMom_ADI_c) + call RegPack(RF, InData%HubVel_ADI_c) + call RegPack(RF, InData%BuoyWaveElev) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_UnPackCalcStepIOdataType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(CalcStepIOdataType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WT_UnPackCalcStepIOdataType' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Time_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PosAng_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Vel_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Acc_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FrcMom_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FrcMom_MD_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FrcMom_ADI_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubVel_ADI_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BuoyWaveElev); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_CopyWrOutputDataType(SrcWrOutputDataTypeData, DstWrOutputDataTypeData, CtrlCode, ErrStat, ErrMsg) + type(WrOutputDataType), intent(in) :: SrcWrOutputDataTypeData + type(WrOutputDataType), intent(inout) :: DstWrOutputDataTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WT_CopyWrOutputDataType' + ErrStat = ErrID_None + ErrMsg = '' + DstWrOutputDataTypeData%NumChans_cbind = SrcWrOutputDataTypeData%NumChans_cbind + DstWrOutputDataTypeData%NumChans_SS = SrcWrOutputDataTypeData%NumChans_SS + DstWrOutputDataTypeData%NumChans_MD = SrcWrOutputDataTypeData%NumChans_MD + DstWrOutputDataTypeData%NumChans_ADI = SrcWrOutputDataTypeData%NumChans_ADI + DstWrOutputDataTypeData%NumChans_all = SrcWrOutputDataTypeData%NumChans_all + if (allocated(SrcWrOutputDataTypeData%WriteOutputHdr_SS)) then + LB(1:1) = lbound(SrcWrOutputDataTypeData%WriteOutputHdr_SS) + UB(1:1) = ubound(SrcWrOutputDataTypeData%WriteOutputHdr_SS) + if (.not. allocated(DstWrOutputDataTypeData%WriteOutputHdr_SS)) then + allocate(DstWrOutputDataTypeData%WriteOutputHdr_SS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWrOutputDataTypeData%WriteOutputHdr_SS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWrOutputDataTypeData%WriteOutputHdr_SS = SrcWrOutputDataTypeData%WriteOutputHdr_SS + end if + if (allocated(SrcWrOutputDataTypeData%WriteOutputUnt_SS)) then + LB(1:1) = lbound(SrcWrOutputDataTypeData%WriteOutputUnt_SS) + UB(1:1) = ubound(SrcWrOutputDataTypeData%WriteOutputUnt_SS) + if (.not. allocated(DstWrOutputDataTypeData%WriteOutputUnt_SS)) then + allocate(DstWrOutputDataTypeData%WriteOutputUnt_SS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWrOutputDataTypeData%WriteOutputUnt_SS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWrOutputDataTypeData%WriteOutputUnt_SS = SrcWrOutputDataTypeData%WriteOutputUnt_SS + end if + if (allocated(SrcWrOutputDataTypeData%WriteOutputHdr_MD)) then + LB(1:1) = lbound(SrcWrOutputDataTypeData%WriteOutputHdr_MD) + UB(1:1) = ubound(SrcWrOutputDataTypeData%WriteOutputHdr_MD) + if (.not. allocated(DstWrOutputDataTypeData%WriteOutputHdr_MD)) then + allocate(DstWrOutputDataTypeData%WriteOutputHdr_MD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWrOutputDataTypeData%WriteOutputHdr_MD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWrOutputDataTypeData%WriteOutputHdr_MD = SrcWrOutputDataTypeData%WriteOutputHdr_MD + end if + if (allocated(SrcWrOutputDataTypeData%WriteOutputUnt_MD)) then + LB(1:1) = lbound(SrcWrOutputDataTypeData%WriteOutputUnt_MD) + UB(1:1) = ubound(SrcWrOutputDataTypeData%WriteOutputUnt_MD) + if (.not. allocated(DstWrOutputDataTypeData%WriteOutputUnt_MD)) then + allocate(DstWrOutputDataTypeData%WriteOutputUnt_MD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWrOutputDataTypeData%WriteOutputUnt_MD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWrOutputDataTypeData%WriteOutputUnt_MD = SrcWrOutputDataTypeData%WriteOutputUnt_MD + end if + if (allocated(SrcWrOutputDataTypeData%WriteOutputHdr_ADI)) then + LB(1:1) = lbound(SrcWrOutputDataTypeData%WriteOutputHdr_ADI) + UB(1:1) = ubound(SrcWrOutputDataTypeData%WriteOutputHdr_ADI) + if (.not. allocated(DstWrOutputDataTypeData%WriteOutputHdr_ADI)) then + allocate(DstWrOutputDataTypeData%WriteOutputHdr_ADI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWrOutputDataTypeData%WriteOutputHdr_ADI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWrOutputDataTypeData%WriteOutputHdr_ADI = SrcWrOutputDataTypeData%WriteOutputHdr_ADI + end if + if (allocated(SrcWrOutputDataTypeData%WriteOutputUnt_ADI)) then + LB(1:1) = lbound(SrcWrOutputDataTypeData%WriteOutputUnt_ADI) + UB(1:1) = ubound(SrcWrOutputDataTypeData%WriteOutputUnt_ADI) + if (.not. allocated(DstWrOutputDataTypeData%WriteOutputUnt_ADI)) then + allocate(DstWrOutputDataTypeData%WriteOutputUnt_ADI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWrOutputDataTypeData%WriteOutputUnt_ADI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWrOutputDataTypeData%WriteOutputUnt_ADI = SrcWrOutputDataTypeData%WriteOutputUnt_ADI + end if + if (allocated(SrcWrOutputDataTypeData%OutData_SS_c)) then + LB(1:1) = lbound(SrcWrOutputDataTypeData%OutData_SS_c) + UB(1:1) = ubound(SrcWrOutputDataTypeData%OutData_SS_c) + if (.not. allocated(DstWrOutputDataTypeData%OutData_SS_c)) then + allocate(DstWrOutputDataTypeData%OutData_SS_c(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWrOutputDataTypeData%OutData_SS_c.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWrOutputDataTypeData%OutData_SS_c = SrcWrOutputDataTypeData%OutData_SS_c + end if + if (allocated(SrcWrOutputDataTypeData%OutData_MD_c)) then + LB(1:1) = lbound(SrcWrOutputDataTypeData%OutData_MD_c) + UB(1:1) = ubound(SrcWrOutputDataTypeData%OutData_MD_c) + if (.not. allocated(DstWrOutputDataTypeData%OutData_MD_c)) then + allocate(DstWrOutputDataTypeData%OutData_MD_c(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWrOutputDataTypeData%OutData_MD_c.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWrOutputDataTypeData%OutData_MD_c = SrcWrOutputDataTypeData%OutData_MD_c + end if + if (allocated(SrcWrOutputDataTypeData%OutData_ADI_c)) then + LB(1:1) = lbound(SrcWrOutputDataTypeData%OutData_ADI_c) + UB(1:1) = ubound(SrcWrOutputDataTypeData%OutData_ADI_c) + if (.not. allocated(DstWrOutputDataTypeData%OutData_ADI_c)) then + allocate(DstWrOutputDataTypeData%OutData_ADI_c(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWrOutputDataTypeData%OutData_ADI_c.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWrOutputDataTypeData%OutData_ADI_c = SrcWrOutputDataTypeData%OutData_ADI_c + end if + if (allocated(SrcWrOutputDataTypeData%OutData_SS)) then + LB(1:1) = lbound(SrcWrOutputDataTypeData%OutData_SS) + UB(1:1) = ubound(SrcWrOutputDataTypeData%OutData_SS) + if (.not. allocated(DstWrOutputDataTypeData%OutData_SS)) then + allocate(DstWrOutputDataTypeData%OutData_SS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWrOutputDataTypeData%OutData_SS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWrOutputDataTypeData%OutData_SS = SrcWrOutputDataTypeData%OutData_SS + end if + if (allocated(SrcWrOutputDataTypeData%OutData_MD)) then + LB(1:1) = lbound(SrcWrOutputDataTypeData%OutData_MD) + UB(1:1) = ubound(SrcWrOutputDataTypeData%OutData_MD) + if (.not. allocated(DstWrOutputDataTypeData%OutData_MD)) then + allocate(DstWrOutputDataTypeData%OutData_MD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWrOutputDataTypeData%OutData_MD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWrOutputDataTypeData%OutData_MD = SrcWrOutputDataTypeData%OutData_MD + end if + if (allocated(SrcWrOutputDataTypeData%OutData_ADI)) then + LB(1:1) = lbound(SrcWrOutputDataTypeData%OutData_ADI) + UB(1:1) = ubound(SrcWrOutputDataTypeData%OutData_ADI) + if (.not. allocated(DstWrOutputDataTypeData%OutData_ADI)) then + allocate(DstWrOutputDataTypeData%OutData_ADI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWrOutputDataTypeData%OutData_ADI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWrOutputDataTypeData%OutData_ADI = SrcWrOutputDataTypeData%OutData_ADI + end if + DstWrOutputDataTypeData%OutName = SrcWrOutputDataTypeData%OutName + DstWrOutputDataTypeData%OutUn = SrcWrOutputDataTypeData%OutUn +end subroutine + +subroutine WT_DestroyWrOutputDataType(WrOutputDataTypeData, ErrStat, ErrMsg) + type(WrOutputDataType), intent(inout) :: WrOutputDataTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WT_DestroyWrOutputDataType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(WrOutputDataTypeData%WriteOutputHdr_SS)) then + deallocate(WrOutputDataTypeData%WriteOutputHdr_SS) + end if + if (allocated(WrOutputDataTypeData%WriteOutputUnt_SS)) then + deallocate(WrOutputDataTypeData%WriteOutputUnt_SS) + end if + if (allocated(WrOutputDataTypeData%WriteOutputHdr_MD)) then + deallocate(WrOutputDataTypeData%WriteOutputHdr_MD) + end if + if (allocated(WrOutputDataTypeData%WriteOutputUnt_MD)) then + deallocate(WrOutputDataTypeData%WriteOutputUnt_MD) + end if + if (allocated(WrOutputDataTypeData%WriteOutputHdr_ADI)) then + deallocate(WrOutputDataTypeData%WriteOutputHdr_ADI) + end if + if (allocated(WrOutputDataTypeData%WriteOutputUnt_ADI)) then + deallocate(WrOutputDataTypeData%WriteOutputUnt_ADI) + end if + if (allocated(WrOutputDataTypeData%OutData_SS_c)) then + deallocate(WrOutputDataTypeData%OutData_SS_c) + end if + if (allocated(WrOutputDataTypeData%OutData_MD_c)) then + deallocate(WrOutputDataTypeData%OutData_MD_c) + end if + if (allocated(WrOutputDataTypeData%OutData_ADI_c)) then + deallocate(WrOutputDataTypeData%OutData_ADI_c) + end if + if (allocated(WrOutputDataTypeData%OutData_SS)) then + deallocate(WrOutputDataTypeData%OutData_SS) + end if + if (allocated(WrOutputDataTypeData%OutData_MD)) then + deallocate(WrOutputDataTypeData%OutData_MD) + end if + if (allocated(WrOutputDataTypeData%OutData_ADI)) then + deallocate(WrOutputDataTypeData%OutData_ADI) + end if +end subroutine + +subroutine WT_PackWrOutputDataType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WrOutputDataType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WT_PackWrOutputDataType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumChans_cbind) + call RegPack(RF, InData%NumChans_SS) + call RegPack(RF, InData%NumChans_MD) + call RegPack(RF, InData%NumChans_ADI) + call RegPack(RF, InData%NumChans_all) + call RegPackAlloc(RF, InData%WriteOutputHdr_SS) + call RegPackAlloc(RF, InData%WriteOutputUnt_SS) + call RegPackAlloc(RF, InData%WriteOutputHdr_MD) + call RegPackAlloc(RF, InData%WriteOutputUnt_MD) + call RegPackAlloc(RF, InData%WriteOutputHdr_ADI) + call RegPackAlloc(RF, InData%WriteOutputUnt_ADI) + call RegPackAlloc(RF, InData%OutData_SS_c) + call RegPackAlloc(RF, InData%OutData_MD_c) + call RegPackAlloc(RF, InData%OutData_ADI_c) + call RegPackAlloc(RF, InData%OutData_SS) + call RegPackAlloc(RF, InData%OutData_MD) + call RegPackAlloc(RF, InData%OutData_ADI) + call RegPack(RF, InData%OutName) + call RegPack(RF, InData%OutUn) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_UnPackWrOutputDataType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WrOutputDataType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WT_UnPackWrOutputDataType' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumChans_cbind); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumChans_SS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumChans_MD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumChans_ADI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumChans_all); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr_SS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt_SS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr_MD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt_MD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr_ADI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt_ADI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutData_SS_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutData_MD_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutData_ADI_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutData_SS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutData_MD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutData_ADI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutUn); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_CopyMeshesMotionType(SrcMeshesMotionTypeData, DstMeshesMotionTypeData, CtrlCode, ErrStat, ErrMsg) + type(MeshesMotionType), intent(inout) :: SrcMeshesMotionTypeData + type(MeshesMotionType), intent(inout) :: DstMeshesMotionTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WT_CopyMeshesMotionType' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcMeshesMotionTypeData%PtfmPtMotion, DstMeshesMotionTypeData%PtfmPtMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcMeshesMotionTypeData%TowerMotion, DstMeshesMotionTypeData%TowerMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcMeshesMotionTypeData%HubMotion, DstMeshesMotionTypeData%HubMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMeshesMotionTypeData%BladeRootMotion)) then + LB(1:1) = lbound(SrcMeshesMotionTypeData%BladeRootMotion) + UB(1:1) = ubound(SrcMeshesMotionTypeData%BladeRootMotion) + if (.not. allocated(DstMeshesMotionTypeData%BladeRootMotion)) then + allocate(DstMeshesMotionTypeData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshesMotionTypeData%BladeRootMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcMeshesMotionTypeData%BladeRootMotion(i1), DstMeshesMotionTypeData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcMeshesMotionTypeData%WaveBuoyMotion, DstMeshesMotionTypeData%WaveBuoyMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine WT_DestroyMeshesMotionType(MeshesMotionTypeData, ErrStat, ErrMsg) + type(MeshesMotionType), intent(inout) :: MeshesMotionTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WT_DestroyMeshesMotionType' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( MeshesMotionTypeData%PtfmPtMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( MeshesMotionTypeData%TowerMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( MeshesMotionTypeData%HubMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MeshesMotionTypeData%BladeRootMotion)) then + LB(1:1) = lbound(MeshesMotionTypeData%BladeRootMotion) + UB(1:1) = ubound(MeshesMotionTypeData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( MeshesMotionTypeData%BladeRootMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MeshesMotionTypeData%BladeRootMotion) + end if + call MeshDestroy( MeshesMotionTypeData%WaveBuoyMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WT_PackMeshesMotionType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MeshesMotionType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WT_PackMeshesMotionType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%PtfmPtMotion) + call MeshPack(RF, InData%TowerMotion) + call MeshPack(RF, InData%HubMotion) + call RegPack(RF, allocated(InData%BladeRootMotion)) + if (allocated(InData%BladeRootMotion)) then + call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) + LB(1:1) = lbound(InData%BladeRootMotion) + UB(1:1) = ubound(InData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeRootMotion(i1)) + end do + end if + call MeshPack(RF, InData%WaveBuoyMotion) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_UnPackMeshesMotionType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MeshesMotionType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WT_UnPackMeshesMotionType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%PtfmPtMotion) ! PtfmPtMotion + call MeshUnpack(RF, OutData%TowerMotion) ! TowerMotion + call MeshUnpack(RF, OutData%HubMotion) ! HubMotion + if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeRootMotion(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeRootMotion(i1)) ! BladeRootMotion + end do + end if + call MeshUnpack(RF, OutData%WaveBuoyMotion) ! WaveBuoyMotion +end subroutine + +subroutine WT_CopyMeshesLoadsType(SrcMeshesLoadsTypeData, DstMeshesLoadsTypeData, CtrlCode, ErrStat, ErrMsg) + type(MeshesLoadsType), intent(inout) :: SrcMeshesLoadsTypeData + type(MeshesLoadsType), intent(inout) :: DstMeshesLoadsTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WT_CopyMeshesLoadsType' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcMeshesLoadsTypeData%PtfmPtLoads, DstMeshesLoadsTypeData%PtfmPtLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcMeshesLoadsTypeData%PtfmPtLoadsTmp, DstMeshesLoadsTypeData%PtfmPtLoadsTmp, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcMeshesLoadsTypeData%MooringLoads, DstMeshesLoadsTypeData%MooringLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcMeshesLoadsTypeData%TowerLoads, DstMeshesLoadsTypeData%TowerLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcMeshesLoadsTypeData%HubLoads, DstMeshesLoadsTypeData%HubLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMeshesLoadsTypeData%BladeRootLoads)) then + LB(1:1) = lbound(SrcMeshesLoadsTypeData%BladeRootLoads) + UB(1:1) = ubound(SrcMeshesLoadsTypeData%BladeRootLoads) + if (.not. allocated(DstMeshesLoadsTypeData%BladeRootLoads)) then + allocate(DstMeshesLoadsTypeData%BladeRootLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshesLoadsTypeData%BladeRootLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcMeshesLoadsTypeData%BladeRootLoads(i1), DstMeshesLoadsTypeData%BladeRootLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine WT_DestroyMeshesLoadsType(MeshesLoadsTypeData, ErrStat, ErrMsg) + type(MeshesLoadsType), intent(inout) :: MeshesLoadsTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WT_DestroyMeshesLoadsType' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( MeshesLoadsTypeData%PtfmPtLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( MeshesLoadsTypeData%PtfmPtLoadsTmp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( MeshesLoadsTypeData%MooringLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( MeshesLoadsTypeData%TowerLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( MeshesLoadsTypeData%HubLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MeshesLoadsTypeData%BladeRootLoads)) then + LB(1:1) = lbound(MeshesLoadsTypeData%BladeRootLoads) + UB(1:1) = ubound(MeshesLoadsTypeData%BladeRootLoads) + do i1 = LB(1), UB(1) + call MeshDestroy( MeshesLoadsTypeData%BladeRootLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MeshesLoadsTypeData%BladeRootLoads) + end if +end subroutine + +subroutine WT_PackMeshesLoadsType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MeshesLoadsType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WT_PackMeshesLoadsType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%PtfmPtLoads) + call MeshPack(RF, InData%PtfmPtLoadsTmp) + call MeshPack(RF, InData%MooringLoads) + call MeshPack(RF, InData%TowerLoads) + call MeshPack(RF, InData%HubLoads) + call RegPack(RF, allocated(InData%BladeRootLoads)) + if (allocated(InData%BladeRootLoads)) then + call RegPackBounds(RF, 1, lbound(InData%BladeRootLoads), ubound(InData%BladeRootLoads)) + LB(1:1) = lbound(InData%BladeRootLoads) + UB(1:1) = ubound(InData%BladeRootLoads) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeRootLoads(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_UnPackMeshesLoadsType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MeshesLoadsType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WT_UnPackMeshesLoadsType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%PtfmPtLoads) ! PtfmPtLoads + call MeshUnpack(RF, OutData%PtfmPtLoadsTmp) ! PtfmPtLoadsTmp + call MeshUnpack(RF, OutData%MooringLoads) ! MooringLoads + call MeshUnpack(RF, OutData%TowerLoads) ! TowerLoads + call MeshUnpack(RF, OutData%HubLoads) ! HubLoads + if (allocated(OutData%BladeRootLoads)) deallocate(OutData%BladeRootLoads) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeRootLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootLoads.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeRootLoads(i1)) ! BladeRootLoads + end do + end if +end subroutine + +subroutine WT_CopyMeshesMapsType(SrcMeshesMapsTypeData, DstMeshesMapsTypeData, CtrlCode, ErrStat, ErrMsg) + type(MeshesMapsType), intent(inout) :: SrcMeshesMapsTypeData + type(MeshesMapsType), intent(inout) :: DstMeshesMapsTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WT_CopyMeshesMapsType' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_CopyMeshMapType(SrcMeshesMapsTypeData%Motion_PRP_2_Twr, DstMeshesMapsTypeData%Motion_PRP_2_Twr, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcMeshesMapsTypeData%Motion_PRP_2_Hub, DstMeshesMapsTypeData%Motion_PRP_2_Hub, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMeshesMapsTypeData%Motion_Hub_2_BldRoot)) then + LB(1:1) = lbound(SrcMeshesMapsTypeData%Motion_Hub_2_BldRoot) + UB(1:1) = ubound(SrcMeshesMapsTypeData%Motion_Hub_2_BldRoot) + if (.not. allocated(DstMeshesMapsTypeData%Motion_Hub_2_BldRoot)) then + allocate(DstMeshesMapsTypeData%Motion_Hub_2_BldRoot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshesMapsTypeData%Motion_Hub_2_BldRoot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcMeshesMapsTypeData%Motion_Hub_2_BldRoot(i1), DstMeshesMapsTypeData%Motion_Hub_2_BldRoot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMeshesMapsTypeData%Load_BldRoot_2_Hub)) then + LB(1:1) = lbound(SrcMeshesMapsTypeData%Load_BldRoot_2_Hub) + UB(1:1) = ubound(SrcMeshesMapsTypeData%Load_BldRoot_2_Hub) + if (.not. allocated(DstMeshesMapsTypeData%Load_BldRoot_2_Hub)) then + allocate(DstMeshesMapsTypeData%Load_BldRoot_2_Hub(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshesMapsTypeData%Load_BldRoot_2_Hub.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcMeshesMapsTypeData%Load_BldRoot_2_Hub(i1), DstMeshesMapsTypeData%Load_BldRoot_2_Hub(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call NWTC_Library_CopyMeshMapType(SrcMeshesMapsTypeData%Load_Hub_2_PRP, DstMeshesMapsTypeData%Load_Hub_2_PRP, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcMeshesMapsTypeData%Load_Twr_2_PRP, DstMeshesMapsTypeData%Load_Twr_2_PRP, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcMeshesMapsTypeData%Load_Moor_2_PRP, DstMeshesMapsTypeData%Load_Moor_2_PRP, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine WT_DestroyMeshesMapsType(MeshesMapsTypeData, ErrStat, ErrMsg) + type(MeshesMapsType), intent(inout) :: MeshesMapsTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WT_DestroyMeshesMapsType' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyMeshMapType(MeshesMapsTypeData%Motion_PRP_2_Twr, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(MeshesMapsTypeData%Motion_PRP_2_Hub, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MeshesMapsTypeData%Motion_Hub_2_BldRoot)) then + LB(1:1) = lbound(MeshesMapsTypeData%Motion_Hub_2_BldRoot) + UB(1:1) = ubound(MeshesMapsTypeData%Motion_Hub_2_BldRoot) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(MeshesMapsTypeData%Motion_Hub_2_BldRoot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MeshesMapsTypeData%Motion_Hub_2_BldRoot) + end if + if (allocated(MeshesMapsTypeData%Load_BldRoot_2_Hub)) then + LB(1:1) = lbound(MeshesMapsTypeData%Load_BldRoot_2_Hub) + UB(1:1) = ubound(MeshesMapsTypeData%Load_BldRoot_2_Hub) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(MeshesMapsTypeData%Load_BldRoot_2_Hub(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MeshesMapsTypeData%Load_BldRoot_2_Hub) + end if + call NWTC_Library_DestroyMeshMapType(MeshesMapsTypeData%Load_Hub_2_PRP, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(MeshesMapsTypeData%Load_Twr_2_PRP, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(MeshesMapsTypeData%Load_Moor_2_PRP, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WT_PackMeshesMapsType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MeshesMapsType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WT_PackMeshesMapsType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackMeshMapType(RF, InData%Motion_PRP_2_Twr) + call NWTC_Library_PackMeshMapType(RF, InData%Motion_PRP_2_Hub) + call RegPack(RF, allocated(InData%Motion_Hub_2_BldRoot)) + if (allocated(InData%Motion_Hub_2_BldRoot)) then + call RegPackBounds(RF, 1, lbound(InData%Motion_Hub_2_BldRoot), ubound(InData%Motion_Hub_2_BldRoot)) + LB(1:1) = lbound(InData%Motion_Hub_2_BldRoot) + UB(1:1) = ubound(InData%Motion_Hub_2_BldRoot) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%Motion_Hub_2_BldRoot(i1)) + end do + end if + call RegPack(RF, allocated(InData%Load_BldRoot_2_Hub)) + if (allocated(InData%Load_BldRoot_2_Hub)) then + call RegPackBounds(RF, 1, lbound(InData%Load_BldRoot_2_Hub), ubound(InData%Load_BldRoot_2_Hub)) + LB(1:1) = lbound(InData%Load_BldRoot_2_Hub) + UB(1:1) = ubound(InData%Load_BldRoot_2_Hub) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%Load_BldRoot_2_Hub(i1)) + end do + end if + call NWTC_Library_PackMeshMapType(RF, InData%Load_Hub_2_PRP) + call NWTC_Library_PackMeshMapType(RF, InData%Load_Twr_2_PRP) + call NWTC_Library_PackMeshMapType(RF, InData%Load_Moor_2_PRP) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_UnPackMeshesMapsType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MeshesMapsType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WT_UnPackMeshesMapsType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackMeshMapType(RF, OutData%Motion_PRP_2_Twr) ! Motion_PRP_2_Twr + call NWTC_Library_UnpackMeshMapType(RF, OutData%Motion_PRP_2_Hub) ! Motion_PRP_2_Hub + if (allocated(OutData%Motion_Hub_2_BldRoot)) deallocate(OutData%Motion_Hub_2_BldRoot) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Motion_Hub_2_BldRoot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Motion_Hub_2_BldRoot.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%Motion_Hub_2_BldRoot(i1)) ! Motion_Hub_2_BldRoot + end do + end if + if (allocated(OutData%Load_BldRoot_2_Hub)) deallocate(OutData%Load_BldRoot_2_Hub) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Load_BldRoot_2_Hub(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Load_BldRoot_2_Hub.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%Load_BldRoot_2_Hub(i1)) ! Load_BldRoot_2_Hub + end do + end if + call NWTC_Library_UnpackMeshMapType(RF, OutData%Load_Hub_2_PRP) ! Load_Hub_2_PRP + call NWTC_Library_UnpackMeshMapType(RF, OutData%Load_Twr_2_PRP) ! Load_Twr_2_PRP + call NWTC_Library_UnpackMeshMapType(RF, OutData%Load_Moor_2_PRP) ! Load_Moor_2_PRP +end subroutine + +subroutine WT_CopyStructTmpType(SrcStructTmpTypeData, DstStructTmpTypeData, CtrlCode, ErrStat, ErrMsg) + type(StructTmpType), intent(in) :: SrcStructTmpTypeData + type(StructTmpType), intent(inout) :: DstStructTmpTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WT_CopyStructTmpType' + ErrStat = ErrID_None + ErrMsg = '' + DstStructTmpTypeData%Azimuth = SrcStructTmpTypeData%Azimuth + DstStructTmpTypeData%RotSpeed = SrcStructTmpTypeData%RotSpeed + DstStructTmpTypeData%BldPitch = SrcStructTmpTypeData%BldPitch + DstStructTmpTypeData%NacYaw = SrcStructTmpTypeData%NacYaw + DstStructTmpTypeData%FrcMom_ADI_at_Ptfm = SrcStructTmpTypeData%FrcMom_ADI_at_Ptfm + DstStructTmpTypeData%FrcMom_MD_at_Ptfm = SrcStructTmpTypeData%FrcMom_MD_at_Ptfm + DstStructTmpTypeData%BuoyPos_c = SrcStructTmpTypeData%BuoyPos_c + DstStructTmpTypeData%PtfmPosAng_c = SrcStructTmpTypeData%PtfmPosAng_c + DstStructTmpTypeData%PtfmVel_c = SrcStructTmpTypeData%PtfmVel_c + DstStructTmpTypeData%PtfmAcc_c = SrcStructTmpTypeData%PtfmAcc_c + DstStructTmpTypeData%NacPos_c = SrcStructTmpTypeData%NacPos_c + DstStructTmpTypeData%NacDCM_c = SrcStructTmpTypeData%NacDCM_c + DstStructTmpTypeData%NacVel_c = SrcStructTmpTypeData%NacVel_c + DstStructTmpTypeData%NacAcc_c = SrcStructTmpTypeData%NacAcc_c + DstStructTmpTypeData%HubPos_c = SrcStructTmpTypeData%HubPos_c + DstStructTmpTypeData%HubDCM_c = SrcStructTmpTypeData%HubDCM_c + DstStructTmpTypeData%HubVel_c = SrcStructTmpTypeData%HubVel_c + DstStructTmpTypeData%HubAcc_c = SrcStructTmpTypeData%HubAcc_c + if (allocated(SrcStructTmpTypeData%BldPos_c)) then + LB(1:1) = lbound(SrcStructTmpTypeData%BldPos_c) + UB(1:1) = ubound(SrcStructTmpTypeData%BldPos_c) + if (.not. allocated(DstStructTmpTypeData%BldPos_c)) then + allocate(DstStructTmpTypeData%BldPos_c(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstStructTmpTypeData%BldPos_c.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstStructTmpTypeData%BldPos_c = SrcStructTmpTypeData%BldPos_c + end if + if (allocated(SrcStructTmpTypeData%BldDCM_c)) then + LB(1:1) = lbound(SrcStructTmpTypeData%BldDCM_c) + UB(1:1) = ubound(SrcStructTmpTypeData%BldDCM_c) + if (.not. allocated(DstStructTmpTypeData%BldDCM_c)) then + allocate(DstStructTmpTypeData%BldDCM_c(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstStructTmpTypeData%BldDCM_c.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstStructTmpTypeData%BldDCM_c = SrcStructTmpTypeData%BldDCM_c + end if + if (allocated(SrcStructTmpTypeData%BldVel_c)) then + LB(1:1) = lbound(SrcStructTmpTypeData%BldVel_c) + UB(1:1) = ubound(SrcStructTmpTypeData%BldVel_c) + if (.not. allocated(DstStructTmpTypeData%BldVel_c)) then + allocate(DstStructTmpTypeData%BldVel_c(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstStructTmpTypeData%BldVel_c.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstStructTmpTypeData%BldVel_c = SrcStructTmpTypeData%BldVel_c + end if + if (allocated(SrcStructTmpTypeData%BldAcc_c)) then + LB(1:1) = lbound(SrcStructTmpTypeData%BldAcc_c) + UB(1:1) = ubound(SrcStructTmpTypeData%BldAcc_c) + if (.not. allocated(DstStructTmpTypeData%BldAcc_c)) then + allocate(DstStructTmpTypeData%BldAcc_c(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstStructTmpTypeData%BldAcc_c.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstStructTmpTypeData%BldAcc_c = SrcStructTmpTypeData%BldAcc_c + end if +end subroutine + +subroutine WT_DestroyStructTmpType(StructTmpTypeData, ErrStat, ErrMsg) + type(StructTmpType), intent(inout) :: StructTmpTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WT_DestroyStructTmpType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(StructTmpTypeData%BldPos_c)) then + deallocate(StructTmpTypeData%BldPos_c) + end if + if (allocated(StructTmpTypeData%BldDCM_c)) then + deallocate(StructTmpTypeData%BldDCM_c) + end if + if (allocated(StructTmpTypeData%BldVel_c)) then + deallocate(StructTmpTypeData%BldVel_c) + end if + if (allocated(StructTmpTypeData%BldAcc_c)) then + deallocate(StructTmpTypeData%BldAcc_c) + end if +end subroutine + +subroutine WT_PackStructTmpType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(StructTmpType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WT_PackStructTmpType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Azimuth) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%BldPitch) + call RegPack(RF, InData%NacYaw) + call RegPack(RF, InData%FrcMom_ADI_at_Ptfm) + call RegPack(RF, InData%FrcMom_MD_at_Ptfm) + call RegPack(RF, InData%BuoyPos_c) + call RegPack(RF, InData%PtfmPosAng_c) + call RegPack(RF, InData%PtfmVel_c) + call RegPack(RF, InData%PtfmAcc_c) + call RegPack(RF, InData%NacPos_c) + call RegPack(RF, InData%NacDCM_c) + call RegPack(RF, InData%NacVel_c) + call RegPack(RF, InData%NacAcc_c) + call RegPack(RF, InData%HubPos_c) + call RegPack(RF, InData%HubDCM_c) + call RegPack(RF, InData%HubVel_c) + call RegPack(RF, InData%HubAcc_c) + call RegPackAlloc(RF, InData%BldPos_c) + call RegPackAlloc(RF, InData%BldDCM_c) + call RegPackAlloc(RF, InData%BldVel_c) + call RegPackAlloc(RF, InData%BldAcc_c) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WT_UnPackStructTmpType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(StructTmpType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WT_UnPackStructTmpType' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Azimuth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FrcMom_ADI_at_Ptfm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FrcMom_MD_at_Ptfm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BuoyPos_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmPosAng_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmVel_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmAcc_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacPos_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacDCM_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacVel_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacAcc_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubPos_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubDCM_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubVel_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubAcc_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldPos_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldDCM_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldVel_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldAcc_c); if (RegCheckErr(RF, RoutineName)) return +end subroutine +END MODULE WaveTank_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/glue-codes/labview/src/libwavetanktestinglib.h b/glue-codes/labview/src/libwavetanktestinglib.h new file mode 100644 index 0000000000..00ce5f13a6 --- /dev/null +++ b/glue-codes/labview/src/libwavetanktestinglib.h @@ -0,0 +1,14 @@ +#ifndef WAVETANKTESTING_H +#define WAVETANKTESTING_H + +#ifdef __cplusplus +extern "C" { +#endif + +void WaveTank_NoOp(); + +#ifdef __cplusplus +} +#endif + +#endif \ No newline at end of file diff --git a/glue-codes/openfast/CMakeLists.txt b/glue-codes/openfast/CMakeLists.txt index a742b5972a..08fde158b7 100644 --- a/glue-codes/openfast/CMakeLists.txt +++ b/glue-codes/openfast/CMakeLists.txt @@ -40,5 +40,3 @@ if(BUILD_OPENFAST_LIB_DRIVER) install(TARGETS openfast_lib_driver RUNTIME DESTINATION bin) endif() - - diff --git a/glue-codes/python/examples/OpenFAST.py b/glue-codes/python/examples/OpenFAST.py index 6a953d70c8..d7b7e25784 100644 --- a/glue-codes/python/examples/OpenFAST.py +++ b/glue-codes/python/examples/OpenFAST.py @@ -1,4 +1,6 @@ - +# NOTE: this file is not complete, but can serve as a starting point for +# calling OpenFAST through the library interface. Modification will be +# necessary from pyOpenFAST import fast project_root = '/Users/rmudafor/Development/openfast' diff --git a/glue-codes/python/examples/SeaState.py b/glue-codes/python/examples/SeaState.py deleted file mode 100644 index c37dff19ee..0000000000 --- a/glue-codes/python/examples/SeaState.py +++ /dev/null @@ -1,40 +0,0 @@ - - -from OpynFAST.seastate import SeaStateLib -import matplotlib.pyplot as plt -import numpy as np - -project_root = '/Users/rmudafor/Development/openfast' -library_path = project_root + '/build/modules/seastate/libseastate_c_binding.dylib' - -if __name__=="__main__": - - dt = 1.0 - time_steps = 10 - - seastatelib = SeaStateLib( - library_path, - "NRELOffshrBsline5MW_OC4DeepCwindSemi_SeaState_WaveMod5.dat" - ) - - seastatelib.init( - time_interval=dt, - n_steps=time_steps, - ) - - seastate_outputs = np.zeros((time_steps, seastatelib.num_outs)) - for i in range(time_steps): - seastatelib.calc_output(i) - seastate_outputs[i] = seastatelib.output_values - print(i, [f"{value:3.4f} - " for value in seastate_outputs[i]]) - seastatelib.end() - - # Plot the results - # plt.figure(figsize=(10, 6)) - # plt.plot(seastate_outputs[:, 0]) - # plt.plot(seastate_outputs[:, 1]) - # plt.xlabel('Time Step') - # plt.ylabel('Value') - # plt.title('Sea State Outputs') - # plt.legend() - # plt.show() diff --git a/glue-codes/python/examples/WaveTankDriver.py b/glue-codes/python/examples/WaveTankDriver.py deleted file mode 100644 index 3a8ec07db8..0000000000 --- a/glue-codes/python/examples/WaveTankDriver.py +++ /dev/null @@ -1,198 +0,0 @@ - -from ctypes import ( - CDLL, - POINTER, - create_string_buffer, - byref, - c_byte, - c_int, - c_double, - c_float, - c_char, - c_char_p, - c_bool -) -import numpy as np -from pathlib import Path - -from OpynFAST.interface_abc import OpenFASTInterfaceType - -project_root = '/Users/rmudafor/Development/openfast' -library_path = project_root + '/build/glue-codes/labview/libwavetanktestinglib.dylib' - -class WaveTankLib(OpenFASTInterfaceType): - - def __init__(self, library_path: str, input_file_names: dict): - """ - _summary_ - - Args: - library_path (str): Path to the compile wavetank interface shared library - input_file_names (dict): Map of file names for each included module: - - MD_InputFile - - SS_InputFile - - AD_InputFile - - IfW_InputFile - """ - super().__init__(library_path) - - self.input_file_names = { - k: create_string_buffer(str(Path(v).absolute() ).encode('utf-8')) - for k,v in input_file_names.items() - } - - self._initialize_routines() - - # Create buffers for class data - self.ended = False # For error handling at end - - # This buffer for the channel names and units is set arbitrarily large - # to start. Channel name and unit lengths are currently hard - # coded to 20 (this must match ChanLen in NWTC_Base.f90). - # self._channel_names_c = create_string_buffer(20 * 4000 + 1) - # self._channel_units_c = create_string_buffer(20 * 4000 + 1) - - self.dt = c_double(0) - self.total_time = c_double(0) - self.numTimeSteps = c_int(0) - - def _initialize_routines(self): - self.WaveTank_Init.argtypes = [ - POINTER(c_char), # intent(in ) :: MD_InputFile_c(IntfStrLen) - POINTER(c_char), # intent(in ) :: SS_InputFile_c(IntfStrLen) - POINTER(c_char), # intent(in ) :: AD_InputFile_c(IntfStrLen) - POINTER(c_char), # intent(in ) :: IfW_InputFile_c(IntfStrLen) - POINTER(c_int), # intent(in ) :: IfW_InputFile_c(IntfStrLen) - POINTER(c_int), # intent(in ) :: n_camera_points_c - POINTER(c_char), # intent( out) :: ErrMsg_C(ErrMsgLen_C) - ] - self.WaveTank_Init.restype = c_int - - self.WaveTank_CalcOutput.argtypes = [ - POINTER(c_int), # integer(c_int) :: frame_number - POINTER(c_float), # real(c_float), intent(in ) :: positions_x(N_CAMERA_POINTS) - POINTER(c_float), # real(c_float), intent(in ) :: positions_y(N_CAMERA_POINTS) - POINTER(c_float), # real(c_float), intent(in ) :: positions_z(N_CAMERA_POINTS) - POINTER(c_float), # real(c_float), intent(in ) :: rotation_matrix(9) - POINTER(c_float), # real(c_float), intent( out) :: loads(N_CAMERA_POINTS) - POINTER(c_int), # integer(c_int), intent( out) :: ErrStat_C - POINTER(c_char), # character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) - ] - self.WaveTank_CalcOutput.restype = c_int - - - def init(self, n_camera_points): - _error_status = c_int(0) - _error_message = create_string_buffer(self.ERROR_MSG_C_LEN) - - # Convert the string into a c_char byte array - # input_string = '\x00'.join(input_string_array) - # input_string = input_string.encode('utf-8') - # input_string_length = len(input_string) - - # # Convert the initial positions array into c_float array - # init_positions_c = (c_float * 6)(0.0, ) - # for i, p in enumerate(platform_init_pos): - # init_positions_c[i] = c_float(p) - - # self._numChannels = c_int(0) - - # gravity = c_float(9.80665) - # water_density = c_float(1025) - # water_depth = c_float(200) - # msl2swl = c_float(0) - # outrootname = "./seastate.SeaSt".encode('utf-8') - # wave_kinematics_mode = c_int(0) - # n_steps = c_int(801) - # time_interval = c_float(0.125) - # wave_elevation_series_flag = c_int(0) - self.WaveTank_Init( - self.input_file_names["MoorDyn"], - self.input_file_names["SeaState"], - self.input_file_names["AeroDyn"], - self.input_file_names["InflowWind"], - byref(c_int(n_camera_points)), - # create_string_buffer(outrootname), - # byref(gravity), - # byref(water_density), - # byref(water_depth), - # byref(msl2swl), - # byref(n_steps), - # byref(time_interval), - # byref(wave_elevation_series_flag), - # byref(wave_kinematics_mode), - byref(_error_status), - _error_message, - ) - if self.fatal_error(_error_status): - raise RuntimeError(f"Error {_error_status.value}: {_error_message.value}") - - def calc_output( - self, - frame_number: int, - positions_x: np.ndarray, - positions_y: np.ndarray, - positions_z: np.ndarray, - rotation_matrix: np.ndarray, - loads: np.ndarray, - ): - _error_status = c_int(0) - _error_message = create_string_buffer(self.ERROR_MSG_C_LEN) - - self.WaveTank_CalcOutput( - byref(c_int(frame_number)), - positions_x.ctypes.data_as(POINTER(c_float)), - positions_y.ctypes.data_as(POINTER(c_float)), - positions_z.ctypes.data_as(POINTER(c_float)), - rotation_matrix.ctypes.data_as(POINTER(c_float)), - loads.ctypes.data_as(POINTER(c_float)), - byref(_error_status), - _error_message, - ) - if self.fatal_error(_error_status): - raise RuntimeError(f"Error {_error_status.value}: {_error_message.value}") - - @property - def output_channel_names(self): - if len(self._channel_names.value.split()) == 0: - return [] - output_channel_names = self._channel_names.value.split() - output_channel_names = [n.decode('UTF-8') for n in output_channel_names] - return output_channel_names - - @property - def output_channel_units(self): - if len(self._channel_units.value.split()) == 0: - return [] - output_channel_units = self._channel_units.value.split() - output_channel_units = [n.decode('UTF-8') for n in output_channel_units] - return output_channel_units - - -if __name__=="__main__": - wavetanklib = WaveTankLib( - library_path, - { - "MoorDyn": "/Users/rmudafor/Development/openfast/reg_tests/r-test/modules/moordyn/py_md_5MW_OC4Semi/md_primary.inp", - "SeaState": "/Users/rmudafor/Development/openfast/reg_tests/r-test/modules/seastate/seastate_1/NRELOffshrBsline5MW_OC4DeepCwindSemi_SeaState.dat", - "AeroDyn": "/Users/rmudafor/Development/openfast/reg_tests/r-test/modules/aerodyn/ad_MHK_RM1_Floating/MHK_RM1_Floating_AeroDyn.dat", - "InflowWind": "/Users/rmudafor/Development/openfast/reg_tests/r-test/modules/inflowwind/py_ifw_turbsimff/ifw_primary.inp", - }, - ) - wavetanklib.init(n_camera_points=3) - - positions_x = np.zeros(1, dtype=np.float32) - positions_y = np.zeros(1, dtype=np.float32) - positions_z = np.zeros(1, dtype=np.float32) - rotation_matrix = np.zeros(9, dtype=np.float32) - loads = np.zeros(6, dtype=np.float32) - - for i in range(50): - wavetanklib.calc_output( - frame_number=i, - positions_x=positions_x, - positions_y=positions_y, - positions_z=positions_z, - rotation_matrix=rotation_matrix, - loads=loads, - ) diff --git a/glue-codes/python/pyOpenFAST/aerodyn_inflow.py b/glue-codes/python/pyOpenFAST/aerodyn_inflow.py index cbc8f3d315..62b332137e 100644 --- a/glue-codes/python/pyOpenFAST/aerodyn_inflow.py +++ b/glue-codes/python/pyOpenFAST/aerodyn_inflow.py @@ -60,6 +60,8 @@ import numpy as np import numpy.typing as npt +from .interface_abc import OpenFASTInterfaceType + #------------------------------------------------------------------------------- # Helper functions and classes #------------------------------------------------------------------------------- @@ -144,7 +146,7 @@ class MotionData: #------------------------------------------------------------------------------- # C-interface library class for AeroDyn x InflowWind #------------------------------------------------------------------------------- -class AeroDynInflowLib(CDLL): +class AeroDynInflowLib(OpenFASTInterfaceType): """A Python interface to the AeroDyn/InflowWind library. This class provides a modern Python interface for calling and running AeroDyn @@ -152,28 +154,6 @@ class AeroDynInflowLib(CDLL): of the underlying Fortran library. """ - #-------------------------------------- - # Error levels (from IfW) - #-------------------------------------- - error_levels: Dict[int, str] = { - 0: "None", - 1: "Info", - 2: "Warning", - 3: "Severe Error", - 4: "Fatal Error" - } - - #-------------------------------------- - # Constants - #-------------------------------------- - # NOTE: The length of the error message in Fortran is determined by the - # ErrMsgLen variable in the NWTC_Base.f90 file. If ErrMsgLen is modified, - # the corresponding size here must also be updated to match. - ERROR_MESSAGE_LENGTH: int = 1025 - DEFAULT_STRING_LENGTH: int = 1025 - CHANNEL_NAME_LENGTH: int = 20 - MAX_CHANNELS: int = 8000 - def __init__(self, library_path: Union[str, Path]) -> None: """Initializes the AeroDyn/InflowWind interface. @@ -199,11 +179,6 @@ def __init__(self, library_path: Union[str, Path]) -> None: self.aerodyn_inputs_passed_as_string: bool = True # Pass input file as string self.inflow_inputs_passed_as_string: bool = True # Pass input file as string - # Error handling setup - self.abort_error_level = 4 - self.error_status_c = c_int(0) - self.error_message_c = create_string_buffer(self.ERROR_MESSAGE_LENGTH) - # Channel information buffers self._channel_names_c = create_string_buffer( self.CHANNEL_NAME_LENGTH * self.MAX_CHANNELS @@ -220,6 +195,13 @@ def __init__(self, library_path: Union[str, Path]) -> None: self.transpose_dcm = 1 self.point_load_output = 1 + # MHK flag: 0->not MHK, 1->fixed bottom, 2->floating + self.mhk = 0 + + # External IfW data: 0->internal, 1->external IfW instance + # NOTE: if external, must call set pointer routine + self.externIfW = 0 + # 0->None, 1->Info, 2->Warning, 3->Severe Error, 4->Fatal Error self.debug_level = 0 @@ -313,7 +295,7 @@ def check_error(self) -> None: message = f"AeroDyn/InflowWind {error_level}: {error_msg}" # If the error level is fatal, call adi_end() and raise an error - if self.error_status_c.value >= self.abort_error_level: + if self.error_status_c.value >= self.abort_error_level.value: try: self.adi_end() except Exception as e: @@ -330,13 +312,37 @@ def adi_preinit(self) -> None: Raises: RuntimeError: If pre-initialization fails """ + # Prepare output file paths + vtk_output_dir_c = create_string_buffer( + self.output_vtk_dir.ljust(self.default_str_c_len).encode('utf-8') + ) + + # Convert VTK nacelle dimensions to C array + vtk_nac_dimension_c = to_c_array(self.vtk_nacelle_dimension, c_float) + self.ADI_C_PreInit( - byref(c_int(self.num_turbines)), # IN -> number of turbines - byref(c_int(self.transpose_dcm)), # IN -> transpose_dcm flag (0=false, 1=true) - byref(c_int(self.point_load_output)), # IN -> point_load_output flag (0=false, 1=true) - byref(c_int(self.debug_level)), # IN -> debug level (0=None to 4=Fatal) - byref(self.error_status_c), # OUT <- error status code - self.error_message_c # OUT <- error message buffer + byref(c_int(self.num_turbines)), # IN -> number of turbines + byref(c_int(self.transpose_dcm)), # IN -> transpose_dcm flag (0=false, 1=true) + byref(c_int(self.point_load_output)), # IN -> point_load_output flag (0=false, 1=true) + byref(c_float(self.gravity)), # IN -> gravity + byref(c_float(self.fluid_density)), # IN -> fluid density + byref(c_float(self.kinematic_viscosity)), # IN -> kinematic viscosity + byref(c_float(self.sound_speed)), # IN -> speed of sound + byref(c_float(self.atmospheric_pressure)), # IN -> atmospheric pressure + byref(c_float(self.vapor_pressure)), # IN -> vapor pressure + byref(c_float(self.water_depth)), # IN -> water depth + byref(c_float(self.mean_sea_level_offset)), # IN -> MSL to SWL offset + byref(c_int(self.mhk)), # IN -> mhk flag (0=not MHK, 1=fixed bottom, 2=floating) + byref(c_int(self.externIfW)), # IN -> external IfW instance (0=internal IfW, 1=external IfW with pointer to data (setpointer call required)) + vtk_output_dir_c, # IN -> directory for vtk output files + byref(c_int(self.write_vtk)), # IN -> write VTK flag + byref(c_int(self.vtk_type)), # IN -> VTK write type + byref(c_double(self.vtk_dt)), # IN -> VTK output time step + vtk_nac_dimension_c, # IN -> VTK nacelle dimensions + byref(c_float(self.vtk_hub_radius)), # IN -> VTK hub radius + byref(c_int(self.debug_level)), # IN -> debug level (0=None to 4=all meshes) + byref(self.error_status_c), # OUT <- error status code + self.error_message_c # OUT <- error message buffer ) self.check_error() @@ -411,14 +417,8 @@ def adi_init( # Prepare output file paths output_file_root_name_c = create_string_buffer( - self.output_root_name.ljust(self.DEFAULT_STRING_LENGTH).encode('utf-8') + self.output_root_name.ljust(self.default_str_c_len).encode('utf-8') ) - vtk_output_dir_c = create_string_buffer( - self.output_vtk_dir.ljust(self.DEFAULT_STRING_LENGTH).encode('utf-8') - ) - - # Convert VTK nacelle dimensions to C array - vtk_nac_dimension_c = to_c_array(self.vtk_nacelle_dimension, c_float) self.ADI_C_Init( byref(c_int(self.aerodyn_inputs_passed_as_string)), # IN -> AD input file is passed as string @@ -428,24 +428,10 @@ def adi_init( c_char_p(ifw_input_string), # IN -> IfW input file as string byref(c_int(ifw_input_string_length)), # IN -> IfW input file string length output_file_root_name_c, # IN -> rootname for ADI file writing - vtk_output_dir_c, # IN -> directory for vtk output files - byref(c_float(self.gravity)), # IN -> gravity - byref(c_float(self.fluid_density)), # IN -> fluid density - byref(c_float(self.kinematic_viscosity)), # IN -> kinematic viscosity - byref(c_float(self.sound_speed)), # IN -> speed of sound - byref(c_float(self.atmospheric_pressure)), # IN -> atmospheric pressure - byref(c_float(self.vapor_pressure)), # IN -> vapor pressure - byref(c_float(self.water_depth)), # IN -> water depth - byref(c_float(self.mean_sea_level_offset)), # IN -> MSL to SWL offset byref(c_int(self.interpolation_order)), # IN -> interpolation order (1: linear, 2: quadratic) byref(c_double(self.dt)), # IN -> time step byref(c_double(self.t_max)), # IN -> maximum simulation time byref(c_int(self.store_hub_height_velocity)), # IN -> store hub height velocity flag - byref(c_int(self.write_vtk)), # IN -> write VTK flag - byref(c_int(self.vtk_type)), # IN -> VTK write type - byref(c_double(self.vtk_dt)), # IN -> VTK output time step - vtk_nac_dimension_c, # IN -> VTK nacelle dimensions - byref(c_float(self.vtk_hub_radius)), # IN -> VTK hub radius byref(c_int(self.write_outputs)), # IN -> write outputs flag byref(c_double(self.output_timestep)), # IN -> output time step byref(self._num_channels_c), # OUT <- number of channels @@ -695,6 +681,22 @@ def _initialize_routines(self) -> None: POINTER(c_int), # numTurbines POINTER(c_int), # transposeDCM POINTER(c_int), # pointLoadOutput + POINTER(c_float), # gravity + POINTER(c_float), # defFldDens + POINTER(c_float), # defKinVisc + POINTER(c_float), # defSpdSound + POINTER(c_float), # defPatm + POINTER(c_float), # defPvap + POINTER(c_float), # WtrDpth + POINTER(c_float), # MSL2SWL + POINTER(c_int), # MHK + POINTER(c_int), # externIfW + POINTER(c_char), # OutVTKdir + POINTER(c_int), # WrVTK + POINTER(c_int), # WrVTK_Type + POINTER(c_double), # WrVTK_DT -- 0 or negative to do every step + POINTER(c_float), # VTKNacDim + POINTER(c_float), # VTKHubRad POINTER(c_int), # debuglevel POINTER(c_int), # ErrStat_C POINTER(c_char) # ErrMsg_C @@ -735,24 +737,10 @@ def _initialize_routines(self) -> None: POINTER(c_char_p), # IfW input file as string POINTER(c_int), # IfW input file string length POINTER(c_char), # OutRootName - POINTER(c_char), # OutVTKdir - POINTER(c_float), # gravity - POINTER(c_float), # defFldDens - POINTER(c_float), # defKinVisc - POINTER(c_float), # defSpdSound - POINTER(c_float), # defPatm - POINTER(c_float), # defPvap - POINTER(c_float), # WtrDpth - POINTER(c_float), # MSL2SWL POINTER(c_int), # InterpOrder POINTER(c_double), # dt POINTER(c_double), # tmax POINTER(c_int), # storeHHVel - POINTER(c_int), # WrVTK - POINTER(c_int), # WrVTK_Type - POINTER(c_double), # WrVTK_DT -- 0 or negative to do every step - POINTER(c_float), # VTKNacDim - POINTER(c_float), # VTKHubRad POINTER(c_int), # wrOuts -- file format for writing outputs POINTER(c_double), # DT_Outs -- timestep for outputs to file POINTER(c_int), # number of channels diff --git a/glue-codes/python/pyOpenFAST/fast.py b/glue-codes/python/pyOpenFAST/fast.py index 14fb2271f1..de29fd23e6 100644 --- a/glue-codes/python/pyOpenFAST/fast.py +++ b/glue-codes/python/pyOpenFAST/fast.py @@ -17,7 +17,6 @@ from .interface_abc import OpenFASTInterfaceType -IntfStrLen = 1025 # FAST_Library global NumFixedInputs = 51 # FAST_Library global @@ -127,7 +126,7 @@ def _initialize_routines(self) -> None: def init(self) -> None: _error_status = c_int(0) - _error_message = create_string_buffer(IntfStrLen) + _error_message = create_string_buffer(self.IntfStrLen) self.FAST_AllocateTurbines( byref(self.n_turbines), @@ -172,7 +171,7 @@ def init(self) -> None: def sim(self) -> None: _error_status = c_int(0) - _error_message = create_string_buffer(IntfStrLen) + _error_message = create_string_buffer(self.IntfStrLen) self.FAST_Start( byref(self.i_turb), @@ -213,7 +212,7 @@ def sim(self) -> None: def deinit(self) -> None: _error_status = c_int(0) - _error_message = create_string_buffer(IntfStrLen) + _error_message = create_string_buffer(self.IntfStrLen) if not self.ended: self.ended = True @@ -265,7 +264,7 @@ def total_output_steps(self) -> int: def get_hub_position(self) -> Tuple: _error_status = c_int(0) - _error_message = create_string_buffer(IntfStrLen) + _error_message = create_string_buffer(self.IntfStrLen) # Data buffers absolute_position = (c_float * 3)(0.0, ) diff --git a/glue-codes/python/pyOpenFAST/hydrodyn.py b/glue-codes/python/pyOpenFAST/hydrodyn.py index df9da2334a..507554a9fc 100644 --- a/glue-codes/python/pyOpenFAST/hydrodyn.py +++ b/glue-codes/python/pyOpenFAST/hydrodyn.py @@ -76,25 +76,9 @@ import numpy as np import datetime -class HydroDynLib(CDLL): - # Human readable error levels from IfW. - error_levels = { - 0: "None", - 1: "Info", - 2: "Warning", - 3: "Severe Error", - 4: "Fatal Error" - } - - # NOTE: the error message length in Fortran is controlled by the - # ErrMsgLen variable in the NWTC_Base.f90 file. If that ever - # changes, it may be necessary to update the corresponding size - # here. - error_msg_c_len = 1025 - - # NOTE: the length of the name used for any output file written by the - # HD Fortran code is 1025. - default_str_c_len = 1025 +from .interface_abc import OpenFASTInterfaceType + +class HydroDynLib(OpenFASTInterfaceType): def __init__(self, library_path): super().__init__(library_path) @@ -107,11 +91,6 @@ def __init__(self, library_path): self.seastate_inputs_passed_as_string: bool = True # Pass input file as string self.hydrodyn_inputs_passed_as_string: bool = True # Pass input file as string - # Create buffers for class data - self.abort_error_level = 4 - self.error_status_c = c_int(0) - self.error_message_c = create_string_buffer(self.error_msg_c_len) - # This is not sufficient for HD #FIXME: ChanLen may not always be 20 -- could be as much as 256 # Possible fix is to pass this length over to Fortran side. diff --git a/glue-codes/python/pyOpenFAST/inflowwind.py b/glue-codes/python/pyOpenFAST/inflowwind.py index bc741443e8..f2bcd94002 100644 --- a/glue-codes/python/pyOpenFAST/inflowwind.py +++ b/glue-codes/python/pyOpenFAST/inflowwind.py @@ -35,27 +35,9 @@ import datetime import os +from .interface_abc import OpenFASTInterfaceType -class InflowWindLib(CDLL): - # Human readable error levels from IfW. - error_levels = { - 0: "None", - 1: "Info", - 2: "Warning", - 3: "Severe Error", - 4: "Fatal Error" - } - - # NOTE: the error message length in Fortran is controlled by the - # ErrMsgLen variable in the NWTC_Base.f90 file. If that ever - # changes, it may be necessary to update the corresponding size - # here. - error_msg_c_len = 1025 - - # NOTE: the length of the name used for any output file written by the - # IfW Fortran code is 1025. - default_str_c_len = 1025 - +class InflowWindLib(OpenFASTInterfaceType): def __init__(self, library_path): super().__init__(library_path) self.library_path = library_path @@ -69,7 +51,7 @@ def __init__(self, library_path): # Create buffers for class data self.abort_error_level = 4 self.error_status_c = c_int(0) - self.error_message_c = create_string_buffer(self.error_msg_c_len) + self.error_message_c = create_string_buffer(self.ERROR_MESSAGE_LENGTH) # This buffer for the channel names and units is set arbitrarily large # to start. InflowWind only has a maximum of 9 outputs at present, but diff --git a/glue-codes/python/pyOpenFAST/interface_abc.py b/glue-codes/python/pyOpenFAST/interface_abc.py index 30ff532a2e..ad69e8b18b 100644 --- a/glue-codes/python/pyOpenFAST/interface_abc.py +++ b/glue-codes/python/pyOpenFAST/interface_abc.py @@ -17,6 +17,17 @@ class OpenFASTInterfaceType(CDLL): + #-------------------------------------- + # Constants + #-------------------------------------- + # NOTE: The length of the error message in Fortran is determined by the + # ErrMsgLen variable in the NWTC_Base.f90 file. If ErrMsgLen is modified, + # the corresponding size here must also be updated to match. + ERROR_MESSAGE_LENGTH: int = 8197 + DEFAULT_STRING_LENGTH: int = 1025 + CHANNEL_NAME_LENGTH: int = 20 + MAX_CHANNELS: int = 8000 + # Human readable error levels error_levels = { 0: "None", @@ -26,17 +37,25 @@ class OpenFASTInterfaceType(CDLL): 4: "Fatal Error" } + # NWTC Library sets the length of file names passed through the interfaces + IntfStrLen = 1025 + # NOTE: the error message length in Fortran is controlled by the # ErrMsgLen variable in the NWTC_Base.f90 file. If that ever # changes, it may be necessary to update the corresponding size # here. - ERROR_MSG_C_LEN = 1025 + ERROR_MSG_C_LEN = 8197 # NOTE: the length of the name used for any output file written by the - # HD Fortran code is 1025. + # Fortran code is 1025. default_str_c_len = 1025 + # error handling abort_error_level = c_int(4) + error_status_c = c_int(0) + error_message_c = create_string_buffer(ERROR_MESSAGE_LENGTH) + + def __init__(self, library_path: str): super().__init__(library_path) diff --git a/glue-codes/python/pyOpenFAST/moordyn.py b/glue-codes/python/pyOpenFAST/moordyn.py index 01272a2d40..63136970d5 100644 --- a/glue-codes/python/pyOpenFAST/moordyn.py +++ b/glue-codes/python/pyOpenFAST/moordyn.py @@ -46,11 +46,6 @@ def __init__(self, library_path): super().__init__(library_path) self._initialize_routines() - - # Create buffers for class data - self.error_status_c = c_int(0) - self.error_message_c = create_string_buffer(self.ERROR_MSG_C_LEN) - self.error_message = create_string_buffer(1025) self.ended = False # For error handling at end self._channel_names = create_string_buffer(256*1000) diff --git a/glue-codes/python/pyOpenFAST/seastate.py b/glue-codes/python/pyOpenFAST/seastate.py index d10cb0126f..944fd79cb7 100644 --- a/glue-codes/python/pyOpenFAST/seastate.py +++ b/glue-codes/python/pyOpenFAST/seastate.py @@ -27,13 +27,27 @@ c_float, c_char, c_char_p, - c_bool + c_bool, + c_void_p ) import numpy as np +import numpy.typing as npt from pathlib import Path +import datetime +import os +from dataclasses import dataclass from .interface_abc import OpenFASTInterfaceType +@dataclass +class MotionData: + """ + POD-style container for motion-related data i.e. state of a node. Only + position information for SeaState + """ + position: npt.NDArray[np.float32] + + class SeaStateLib(OpenFASTInterfaceType): """ This is the Python interface to the OpenFAST SeaState module. @@ -46,41 +60,70 @@ class SeaStateLib(OpenFASTInterfaceType): from the last call to calc_output. """ - def __init__(self, library_path: str, input_file_name: str): + def __init__(self, library_path): super().__init__(library_path) - - self.input_file_name = str( Path(input_file_name).absolute() ).encode('utf-8') + self.library_path = library_path self._initialize_routines() - - self.ended = False # For error handling at end + self.ended = False # For error handling at end # Create buffers for class data - # These will generally be overwritten by the Fortran code - self.num_outs_c = c_int(0) - self.output_channel_names = [] - self.output_channel_units = [] - self.output_values = None + self.error_status_c = c_int(0) + self.error_message_c = create_string_buffer(self.ERROR_MSG_C_LEN) + + + # This buffer for the channel names and units is set arbitrarily large + # to start. Channel name and unit lengths are currently hard + # coded to 20 (this must match ChanLen in NWTC_Base.f90). + self._channel_names_c = create_string_buffer(20 * 4000 + 1) + self._channel_units_c = create_string_buffer(20 * 4000 + 1) + + self.numResPts = 0 # Number of wind points we will + # request information from + # non-CalcOutput routines. + + self.WaveTimeShift = 0 # shift wave time (positive only) + + self.numChannels = 0 # Number of channels returned + + # flags + self.debuglevel = 0 # 0-4 levels + + #-------------------------------------- + # VTK settings + #-------------------------------------- + self.vtk_write = 0 # Default -> no vtk output, 0 none, 1 init, 2 animation + self.vtk_dt = 0. # Default -> all + self.vtk_output_dir = "" # Set to specify a directory relative to input files def _initialize_routines(self): - self.SeaSt_C_Init.argtypes = [ - POINTER(c_char_p), # intent(in ) :: InputFile_c(IntfStrLen) - POINTER(c_char_p), # intent(in ) :: OutRootName_c(IntfStrLen) + self.SeaSt_C_PreInit.argtypes = [ POINTER(c_float), # intent(in ) :: Gravity_c POINTER(c_float), # intent(in ) :: WtrDens_c POINTER(c_float), # intent(in ) :: WtrDpth_c POINTER(c_float), # intent(in ) :: MSL2SWL_c - POINTER(c_int), # intent(in ) :: NSteps_c - POINTER(c_float), # intent(in ) :: TimeInterval_c - POINTER(c_int), # intent(in ) :: WaveElevSeriesFlag_c - POINTER(c_int), # intent(in ) :: WrWvKinMod_c + POINTER(c_int), # intent(in ) :: debuglevel + POINTER(c_char), # intent(in ) :: vtk_output_dir_c + POINTER(c_int), # intent(in ) :: vtk_write + POINTER(c_double), # intent(in ) :: vtk_dt + POINTER(c_int), # intent( out) :: ErrStat_C + POINTER(c_char), # intent( out) :: ErrMsg_C(ErrMsgLen_C) + ] + self.SeaSt_C_PreInit.restype = None + + self.SeaSt_C_Init.argtypes = [ + POINTER(c_char), # intent(in ) :: InputFile_c(IntfStrLen) + POINTER(c_char), # intent(in ) :: OutRootName_c(IntfStrLen) + POINTER(c_double), # intent(in ) :: TimeInterval_c + POINTER(c_double), # intent(in ) :: TMax_c + POINTER(c_double), # intent(in ) :: WaveTimeShift (positive only) POINTER(c_int), # intent( out) :: NumChannels_c POINTER(c_char), # intent( out) :: OutputChannelNames_C POINTER(c_char), # intent( out) :: OutputChannelUnits_C POINTER(c_int), # intent( out) :: ErrStat_C POINTER(c_char), # intent( out) :: ErrMsg_C(ErrMsgLen_C) ] - self.SeaSt_C_Init.restype = c_int + self.SeaSt_C_Init.restype = None self.SeaSt_C_CalcOutput.argtypes = [ POINTER(c_double), # intent(in ) :: Time_C @@ -88,54 +131,176 @@ def _initialize_routines(self): POINTER(c_int), # intent( out) :: ErrStat_C POINTER(c_char), # intent( out) :: ErrMsg_C(ErrMsgLen_C) ] - self.SeaSt_C_CalcOutput.restype = c_int + self.SeaSt_C_CalcOutput.restype = None self.SeaSt_C_End.argtypes = [ POINTER(c_int), # intent( out) :: ErrStat_C POINTER(c_char) # intent( out) :: ErrMsg_C(ErrMsgLen_C) ] - self.SeaSt_C_End.restype = c_int + self.SeaSt_C_End.restype = None + + self.SeaSt_C_GetWaveFieldPointer.argtypes = [ + POINTER(c_void_p), # intent( out) :: pointer to the WaveField data + POINTER(c_int), # intent( out) :: ErrStat_C + POINTER(c_char), # intent( out) :: ErrMsg_C(ErrMsgLen_C) + ] + self.SeaSt_C_GetWaveFieldPointer.restype = None + + self.SeaSt_C_SetWaveFieldPointer.argtypes = [ + POINTER(c_void_p), # intent(in ) :: pointer to the WaveField data + POINTER(c_int), # intent( out) :: ErrStat_C + POINTER(c_char), # intent( out) :: ErrMsg_C(ErrMsgLen_C) + ] + self.SeaSt_C_SetWaveFieldPointer.restype = None + + + self.SeaSt_C_GetFluidVelAcc.argtypes = [ + POINTER(c_double), # intent(in ) :: Time_C + POINTER(c_float), # intent(in ) :: Pos_c(3) + POINTER(c_float), # intent( out) :: Vel_c(3) + POINTER(c_float), # intent( out) :: Acc_c(3) + POINTER(c_int), # intent( out) :: NodeInWater_C + POINTER(c_int), # intent( out) :: ErrStat_C + POINTER(c_char) # intent( out) :: ErrMsg_C(ErrMsgLen_C) + + ] + self.SeaSt_C_GetFluidVelAcc.restype = None + + self.SeaSt_C_GetSurfElev.argtypes = [ + POINTER(c_double), # intent(in ) :: Time_C + POINTER(c_float), # intent(in ) :: Pos_c(3) + POINTER(c_float), # intent( out) :: Elev_C + POINTER(c_int), # intent( out) :: ErrStat_C + POINTER(c_char) # intent( out) :: ErrMsg_C(ErrMsgLen_C) + ] + self.SeaSt_C_GetSurfElev.restype = None + + self.SeaSt_C_GetSurfNorm.argtypes = [ + POINTER(c_double), # intent(in ) :: Time_C + POINTER(c_float), # intent(in ) :: Pos_c(3) + POINTER(c_float), # intent( out) :: norm(3) + POINTER(c_int), # intent( out) :: ErrStat_C + POINTER(c_char) # intent( out) :: ErrMsg_C(ErrMsgLen_C) + ] + self.SeaSt_C_GetSurfNorm.restype = None + + self.SeaSt_C_GetElevMinMaxEstimate.argtypes = [ + POINTER(c_float), # intent( out) :: elevMin_c + POINTER(c_float), # intent( out) :: elevMax_c + POINTER(c_int), # intent( out) :: ErrStat_C + POINTER(c_char) # intent( out) :: ErrMsg_C(ErrMsgLen_C) + ] + self.SeaSt_C_GetElevMinMaxEstimate.restype = None + + + + def check_error(self) -> None: + """Checks for and handles any errors from the Fortran library. - def init( + Raises: + RuntimeError: If a fatal error occurs in the Fortran code + """ + # If the error status is 0, return + if self.error_status_c.value == 0: + return + + # Get the error level and error message + error_level = self.error_levels.get( + self.error_status_c.value, + f"Unknown Error Level: {self.error_status_c.value}" + ) + error_msg = self.error_message_c.raw.decode('utf-8').strip() + message = f"WaveTank library {error_level}: {error_msg}" + # If the error level is fatal, call WaveTank_End() and raise an error + if self.error_status_c.value >= self.abort_error_level.value: + try: + self.SeaSt_C_End( + byref(self.error_status_c), # OUT <- error status code + self.error_message_c # OUT <- error message buffer + ) + if self.error_status_c.value == 4: + error_msg = self.error_message_c.raw.decode('utf-8').strip() + print(f'WaveTank_End error: {error_msg}') + except Exception as e: + message += f"\nAdditional error during cleanup: {e}" + raise RuntimeError(message) + else: + print(message) + + + #FIXME: store these elsewhere + def seastate_preinit( self, gravity: float = 9.80665, water_density: float = 1025, water_depth: float = 200, msl2swl: float = 0, + ): + """Set environment variables and general setup + + Args: + + Raises: + ValueError: If values are outside reasonable bounds + RuntimeError: If preinit fails + """ + vtk_output_dir_c = create_string_buffer( + self.vtk_output_dir.ljust(self.default_str_c_len).encode('utf-8') + ) + self.SeaSt_C_PreInit( + byref(c_float(gravity)), + byref(c_float(water_density)), + byref(c_float(water_depth)), + byref(c_float(msl2swl)), + byref(c_int(self.debug_level)), # IN -> debug level (0=None to 4=all meshes) + vtk_output_dir_c, # IN -> directory for vtk output files + byref(c_int(self.vtk_write)), # IN -> write VTK flag + byref(c_double(self.vtk_dt)), # IN -> VTK output time step + byref(self.error_status_c), # OUT <- error status code + self.error_message_c # OUT <- error message buffer + ) + self.check_error() + + + def seastate_init( + self, + primary_ss_file, outrootname: str = "./seastate.SeaSt", - wave_kinematics_mode: int = 0, - n_steps: int = 801, + time_max: float = 60, time_interval: float = 0.125, - wave_elevation_series_flag: int = 0, ): - _error_status = c_int(0) - _error_message = create_string_buffer(self.ERROR_MSG_C_LEN) + + ss_file_c = create_string_buffer( + primary_ss_file.ljust(self.default_str_c_len).encode('utf-8') + ) + outrootname_c = create_string_buffer( + outrootname.ljust(self.default_str_c_len).encode('utf-8') + ) # This buffer for the channel names and units is set arbitrarily large # to start. Channel name and unit lengths are currently hard # coded to 20 (this must match ChanLen in NWTC_Base.f90). _channel_names = create_string_buffer(20 * 4000 + 1) _channel_units = create_string_buffer(20 * 4000 + 1) + self._numChannels = c_int(0) + self.SeaSt_C_Init( - c_char_p(self.input_file_name), - c_char_p(outrootname.encode('utf-8')), - byref(c_float(gravity)), - byref(c_float(water_density)), - byref(c_float(water_depth)), - byref(c_float(msl2swl)), - byref(c_int(n_steps)), - byref(c_float(time_interval)), - byref(c_int(wave_elevation_series_flag)), - byref(c_int(wave_kinematics_mode)), - byref(self.num_outs_c), + ss_file_c, + outrootname_c, + byref(c_double(time_interval)), + byref(c_double(time_max)), + byref(c_double(self.WaveTimeShift)), + byref(self._numChannels), _channel_names, _channel_units, - byref(_error_status), - _error_message, + byref(self.error_status_c), # OUT <- error status code + self.error_message_c # OUT <- error message buffer ) - if self.fatal_error(_error_status): - raise RuntimeError(f"Error {_error_status.value}: {_error_message.value}") + self.check_error() + + # Initialize output channels + self.numChannels = self._numChannels.value # if len(_channel_names.value.split()) == 0: # self.output_channel_names = [] @@ -150,38 +315,281 @@ def init( self.output_channel_units = [n.decode('UTF-8') for n in _channel_units.value.split()] # Allocate the data for the outputs - self.output_values = np.zeros( self.num_outs_c.value, dtype=c_float, order='C' ) + self.output_values = np.zeros( self._numChannels.value, dtype=c_float, order='C' ) + + + def seastate_calcOutput(self, time: float, output_channel_values: npt.NDArray[np.float32]) -> None: + """Calculate output values at the given time. + + Args: + time: Current simulation time + output_channel_values: Array to store calculated output values + + Raises: + ValueError: If output_channel_values array has wrong size + RuntimeError: If calculation fails + """ + if output_channel_values.size != self.numChannels: + raise ValueError( + f"Output array must have size {self.numChannels}, " + f"got {output_channel_values.size}" + ) - def calc_output(self, t): - _error_status = c_int(0) - _error_message = create_string_buffer(self.ERROR_MSG_C_LEN) + output_channel_values_c = (c_float * self.numChannels)(0.) self.SeaSt_C_CalcOutput( - byref(c_double(t)), # IN: time + byref(c_double(time)), # IN -> current simulation time self.output_values.ctypes.data_as(POINTER(c_float)), # OUT: output channel values - byref(_error_status), # OUT: ErrStat_C - _error_message # OUT: ErrMsg_C + byref(self.error_status_c), # OUT <- error status + self.error_message_c # OUT <- error message ) + self.check_error() - if self.fatal_error(_error_status): - self.end() - raise RuntimeError(f"Error {_error_status.value}: {_error_message.value}") + # Copy results back to numpy array + output_channel_values[:] = np.reshape(self.output_values, (self.numChannels)) - def end(self): - _error_status = c_int(0) - _error_message = create_string_buffer(self.ERROR_MSG_C_LEN) + def seastate_end(self): if not self.ended: self.ended = True self.SeaSt_C_End( - byref(_error_status), - _error_message, + byref(self.error_status_c), # OUT <- error status code + self.error_message_c # OUT <- error message buffer ) - if self.fatal_error(_error_status): - raise RuntimeError(f"Error {_error_status.value}: {_error_message.value}") + self.check_error() + + + def seastate_getWaveFieldPointer(self,ss_pointer: c_void_p) -> None: + self.SeaSt_C_GetWaveFieldPointer( + byref(ss_pointer), # IN -> pointer to the WaveField data + byref(self.error_status_c), # OUT <- error status code + self.error_message_c # OUT <- error message buffer + ) + self.check_error() + + def seastate_setWaveFieldPointer(self,ss_pointer: c_void_p) -> None: + self.SeaSt_C_SetWaveFieldPointer( + byref(ss_pointer), # IN -> pointer to the WaveField data + byref(self.error_status_c), # OUT <- error status code + self.error_message_c # OUT <- error message buffer + ) + self.check_error() + + + def get_fluidVelAcc(self, + time: float, + position: npt.NDArray[np.float32], + vel: npt.NDArray[np.float32], + acc: npt.NDArray[np.float32], + nodeInWater: int, + ) -> None: + """ + Get fluid velocity, acceleration, and if node is in water values at the given time. + Args: + time: Current simulation time + position: position in 3D to get info from + vel: velocity at position + acc: acceleration at position + nodeInWater: 1 if position is in the water, 0 if not. Note that + this is relative to SWL unless stretching is used + Raises: + RuntimeError: If calculation fails + """ + # I don't know why I have to convert the position, but I get garbage + # across the inteface if I don't (IANAPP: I am not a python programmer) + pos = np.zeros( 3, dtype=c_float ) + pos[0] = position[0] + pos[1] = position[1] + pos[2] = position[2] + vel = np.zeros( 3, dtype=c_float ) + acc = np.zeros( 3, dtype=c_float ) + nodeInWater_c = c_int(0) + self.SeaSt_C_GetFluidVelAcc( + byref(c_double(time)), # IN -> current simulation time + pos.ctypes.data_as(POINTER(c_float)), # IN -> position (3 vector) + vel.ctypes.data_as(POINTER(c_float)), # OUT <- velocity (3 vector) + acc.ctypes.data_as(POINTER(c_float)), # OUT <- acceleration (3 vector) + nodeInWater_c, # OUT <- node is in water (0=false, 1=true) + byref(self.error_status_c), # OUT <- error status + self.error_message_c # OUT <- error message + ) + self.check_error() + nodeInWater = nodeInWater_c.value + return vel,acc,nodeInWater + + + def get_surfElev(self, + time: float, + position: npt.NDArray[np.float32], + elev: float, + ) -> None: + """ + Get the surface elevation at an X,Y point. + Args: + time: Current simulation time + position: position in 2D to get info from (3D could be passed in) + elev: elevation in meters + Raises: + RuntimeError: If calculation fails + """ + # I don't know why I have to convert the position, but I get garbage + # across the inteface if I don't (IANAPP: I am not a python programmer) + pos = np.array(position).astype(c_float)[:3] + elev_c = c_float(0.0) + self.SeaSt_C_GetSurfElev( + byref(c_double(time)), # IN -> current simulation time + pos.ctypes.data_as(POINTER(c_float)), # IN -> position (3 vector) + elev_c, # OUT <- total wave elevation + byref(self.error_status_c), # OUT <- error status + self.error_message_c # OUT <- error message + ) + self.check_error() + elev = elev_c.value + return elev + + + def get_surfNorm(self, + time: float, + position: npt.NDArray[np.float32], + norm: npt.NDArray[np.float32], + ) -> None: + """ + Get the normal to the surface at an X,Y point. + Args: + time: Current simulation time + position: position in 2D to get info from (3D could be passed in) + norm: normal vector + Raises: + RuntimeError: If calculation fails + """ + # I don't know why I have to convert the position, but I get garbage + # across the inteface if I don't (IANAPP: I am not a python programmer) + pos = np.zeros( 2, dtype=c_float ) + pos[0] = position[0] + pos[1] = position[1] + norm = np.zeros( 3, dtype=c_float ) + self.SeaSt_C_GetSurfNorm( + byref(c_double(time)), # IN -> current simulation time + pos.ctypes.data_as(POINTER(c_float)), # IN -> position (3 vector) + norm.ctypes.data_as(POINTER(c_float)), # OUT <- normal vector to surface + byref(self.error_status_c), # OUT <- error status + self.error_message_c # OUT <- error message + ) + self.check_error() + return norm + + def get_elevMinMax(self) -> tuple[float, float]: + """ + Get estimate of the min and max total wave elevation. Will over + estimate range when 2nd order waves used + + Returns: + tuple[float, float]: A tuple containing (elevMin, elevMax) where: + - elevMin: minimum elevation estimate in meters + - elevMax: maximum elevation estimate in meters + + Raises: + RuntimeError: If calculation fails + """ + elevMin_c = c_float(0.0) + elevMax_c = c_float(0.0) + print("Calling SeaSt_C_GetElevMinMaxEstimate") + self.SeaSt_C_GetElevMinMaxEstimate( + elevMin_c, # out <- min elev + elevMax_c, # out <- max elev + byref(self.error_status_c), # OUT <- error status + self.error_message_c # OUT <- error message + ) + self.check_error() + elevMin = elevMin_c.value + elevMax = elevMax_c.value + return elevMin,elevMax + @property def num_outs(self): - return self.num_outs_c.value \ No newline at end of file + return self._numChannels.value + + +#=============================================================================== +# Helper classes for writing output channels to file. +# For the regression testing to mirror the output from the InfowWind Fortran +# driver. This may also have value for debugging the interfacing to SS. + +class ResultsOut(): + """ + This is only for testing purposes. Since we are not returning the + velocities to anything, we will write them to file as we go for + comparison in the regression test. When coupled to another code, the + velocities array would be passed back to the calling code for use in + the aerodynamic solver. + """ + def __init__(self, filename, NumResPts): + + self.results_file = open(filename, 'w') # open output file and write header info + + # write file header + t_string=datetime.datetime.now() + dt_string=datetime.date.today() + self.results_file.write(f"## This file was generated by SeaState called from Python on {dt_string.strftime('%b-%d-%Y')} at {t_string.strftime('%H:%M:%S')}{os.linesep}") + self.results_file.write(f"## This file contains outputs from calls to SeaState routines (not the CalcOutput) at the {NumResPts} points specified in the file {filename}{os.linesep}") + self.results_file.write(f"# {os.linesep}") + self.results_file.write(f"# {os.linesep}") + self.results_file.write(f"# {os.linesep}") + self.results_file.write(f"# {os.linesep}") + self.results_file.write(f" T x y z V_x V_y V_z A_x A_Y A_Z nodeInWater elev norm_x norm_y norm_z{os.linesep}") + self.results_file.write(f" (s) (m) (m) (m) (m/s) (m/s) (m/s) (m/s) (m/s) (m/s) (-) (m) (m/s) (m/s) (m/s) {os.linesep}") + self.opened = True + + def write(self,t,p,v,a,nodeInWater,elev,n): + self.results_file.write(' %11.3f %11.3f %11.3f %11.3f %11.3f %11.3f %11.3f %11.3f %11.3f %11.3f %11d %11.3f %11.3f %11.3f %11.3f\n' % (t,p[0],p[1],p[2],v[0],v[1],v[2],a[0],a[1],a[2],nodeInWater,elev,n[0],n[1],n[2])) + + def end(self): + if self.opened: + self.results_file.close() + self.opened = False + + + + +class WriteOutChans(): + """ + This is only for testing purposes. Since we are not returning the + output channels to anything, we will write them to file. When coupled to + another code, this data would be passed back for inclusion the any output + file there. + """ + def __init__(self,filename,chan_names,chan_units): + chan_names.insert(0,'Time') # add time index header + chan_units.insert(0,'(s)') # add time index unit + self.OutFile=open(filename,'wt') # open output file and write header info + # write file header + t_string=datetime.datetime.now() + dt_string=datetime.date.today() + self.OutFile.write(f"## This file was generated by SeaState c-bindings library on {dt_string.strftime('%b-%d-%Y')} at {t_string.strftime('%H:%M:%S')}\n") + self.OutFile.write(f"## This file contains output channels requested from the OutList section of the input file") + self.OutFile.write(f"{filename}\n") + self.OutFile.write("#\n") + self.OutFile.write("#\n") + self.OutFile.write("#\n") + self.OutFile.write("#\n") + l = len(chan_names) + f_string = "{:^15s}"+" {:^20s} "*(l-1) + self.OutFile.write(f_string.format(*chan_names) + '\n') + self.OutFile.write(f_string.format(*chan_units) + '\n') + self.opened = True + + def write(self,chan_data): + l = chan_data.shape[1] + f_string = "{:10.4f}"+"{:25.7f}"*(l-1) + for i in range(0,chan_data.shape[0]): + self.OutFile.write(f_string.format(*chan_data[i,:]) + '\n') + #if i==0: + # print(f"{chan_data[i,:]}") + + def end(self): + if self.opened: + self.OutFile.close() + self.opened = False diff --git a/glue-codes/python/pyOpenFAST/tdmslib.py b/glue-codes/python/pyOpenFAST/tdmslib.py new file mode 100644 index 0000000000..b7f6d6a063 --- /dev/null +++ b/glue-codes/python/pyOpenFAST/tdmslib.py @@ -0,0 +1,68 @@ +# -*- coding: utf-8 -*- +""" +Created on Wed Jun 5 11:26:52 2024 + +@author: schamot + +Description: + Code takes a .tdms file path as input and outputs the data as a dictionary. + + Parameters + ---------- + path : str + path to the .tdms file. + + Returns + ------- + pyDict : dict + Python dictionary of the tdms file. + +""" + +import nptdms + +def main(): + fileName = "Oscilloscope Data/UF HASEL tests/UF2down_3kVcycleForce.tdms" + output = TdmsToDict(fileName) + print(output) + +def TdmsToDict(path): + ''' + Code takes a .tdms file path as input and outputs the data as a dictionary. + + Parameters + ---------- + path : str + path to the .tdms file. + + Returns + ------- + pyDict : dict + Python dictionary of the tdms file. + + ''' + # Get the files requested + tdmsFile = path + + # open/read the tdms file + tdms_file = nptdms.TdmsFile.read(tdmsFile) + + # Set up python dictionary + pyDict = {} + # Get group names + for group in tdms_file.groups(): + #print(f'''Group: {group.name}''') + # Create group dictionary key + pyDict[group.name] = {} + # Get channel names per group + for channel in group.channels(): + #print(f'''\tChannel: {channel.name}''') + pyDict[group.name][channel.name] = channel[:] + # if the data has properties add them + if channel.properties != {}: + pyDict[group.name][channel.name + "_properties"] = channel.properties + + return pyDict + +if __name__ == "__main__": + main() \ No newline at end of file diff --git a/glue-codes/python/pyOpenFAST/wavetanktesting.py b/glue-codes/python/pyOpenFAST/wavetanktesting.py new file mode 100644 index 0000000000..625d25c732 --- /dev/null +++ b/glue-codes/python/pyOpenFAST/wavetanktesting.py @@ -0,0 +1,445 @@ +# 2025.12.23 +# This is a work in progress. It is used for testing of the +# wavetanktestinglib that can be coupled to labview. It is not complete at +# this point +from ctypes import ( + CDLL, + POINTER, + create_string_buffer, + byref, + c_byte, + c_int, + c_double, + c_float, + c_char, + c_char_p, + c_bool +) + +import numpy as np +import numpy.typing as npt +from dataclasses import dataclass +from datetime import datetime +from pathlib import Path +from typing import Any,Dict, List, Optional, Tuple, Union + +from pyOpenFAST.interface_abc import OpenFASTInterfaceType + +def to_c_array(array: npt.NDArray, c_type: Any = c_float) -> Any: + """Converts numpy array to C array of specified type. + + Args: + array: Input numpy array + c_type: C type to convert to (default: c_float) + + Returns: + C-compatible array of the specified type + """ + try: + if isinstance(array, np.ndarray): + flat_array = array.flatten() + return (c_type * len(flat_array))(*flat_array) + # If list/tuple, convert directly to C array + return (c_type * len(array))(*array) + except Exception as e: + raise TypeError(f"Failed to convert to C array: {e}") + +def to_c_string(input_array: List[str]) -> Tuple[bytes, int]: + """Converts input string array into a null-separated byte string for use in C. + + Args: + input_array: List of strings to join with null characters + + Returns: + Tuple containing: + - The encoded byte string + - Length of the encoded string + """ + encoded_string = '\x00'.join(input_array).encode('utf-8') + return encoded_string, len(encoded_string) + + +@dataclass +class MotionData: + """POD-style container for motion-related data i.e. state of a node.""" + pos: npt.NDArray[np.float32] # [x,y,z,roll,pitch,yaw] + vel: npt.NDArray[np.float32] # [x_dot,y_dot,z_dot,roll_dot,pitch_dot,yaw_dot] + acc: npt.NDArray[np.float32] # [x_ddot,y_ddot,z_ddot,roll_ddot,pitch_ddot,yaw_ddot] + +@dataclass +class LoadsData: + """POD-style container for motion-related data i.e. state of a node.""" + loads: npt.NDArray[np.float32] # [Fx,Fy,Fz,Mx,My,Mz] + +#------------------------------------------------------------------------------- +# Generate a debug file +#------------------------------------------------------------------------------- +class DriverDbg: + """ + A helper class for debugging the wavetankinterface. This class writes out all the + input positions/orientations, velocities, accelerations, and the resulting + forces and moments at the platform mesh point. If functioning correctly, this + will be identical to the corresponding values in the wavetank output + channels. + + NOTE: This may not output everything in the interface as updates have been made + since writing this, but this routine was not updated accordingly. + """ + + def __init__(self, filename: str) -> None: + """Initializes the debugging class and open the output file.""" + self.filename = filename + self.opened = True + + with open(filename, 'wt') as self.debug_file: + self._write_header() + + self.debug_file = open(filename, 'at') # switch to append mode + + def _write_header(self) -> None: + """Writes the header information to the debug file.""" + # Build header components + timestamp = datetime.now().strftime('%b-%d-%Y %H:%M:%S') + header_lines = [ + f"## This file was generated by wavetank_c_lib on {timestamp}", + f"## This file contains the resulting forces/moments at the referenc mesh point passed into the adi_c_lib", + "#", + "#", + "#", + "#" + ] + + # Write column headers + column_names = ["Time"] + column_units = ["(s)"] + # Position columns + for suffix in ["x", "y", "z"]: + column_names.append(f"{suffix}") + column_units.append("(m)") + # orientation columns + for suffix in ["phi", "theta", "psi"]: + column_names.append(f"{suffix}") + column_units.append("(rad)") + # Velocity columns + for suffix in ["Vx", "Vy", "Vz"]: + column_names.append(f"{suffix}") + column_units.append("(m/s)") + # Angular velocity columns + for suffix in ["RVx", "RVy", "RVz"]: + column_names.append(f"{suffix}") + column_units.append("(rad/s)") + # Acceleration columns + for suffix in ["Ax", "Ay", "Az"]: + column_names.append(f"{suffix}") + column_units.append("(m/s^2)") + # Angular acceleration columns + for suffix in ["RAx", "RAy", "RAz"]: + column_names.append(f"{suffix}") + column_units.append("(rad/s^2)") + # Force columns + for suffix in ["Fx", "Fy", "Fz"]: + column_names.append(f"{suffix}") + column_units.append("(N)") + # Moment columns + for suffix in ["Mx", "My", "Mz"]: + column_names.append(f"{suffix}") + column_units.append("(N-m)") + + f_string = "{:^25s}" + header_lines.append("".join([f_string.format(name) for name in column_names])) + header_lines.append("".join([f_string.format(unit) for name, unit in zip(column_names, column_units)])) + + self.debug_file.write("\n".join(header_lines) + "\n") + + def write( + self, + t: float, + body_motion: MotionData, + body_loads: LoadsData, + ) -> None: + """Writes the current state to the debug file.""" + row_data = [f"{t:10.4f}"] + + row_data.extend([f"{val:25.7e}" for val in body_motion.pos[:]]) + row_data.extend([f"{val:25.7e}" for val in body_motion.vel[:]]) + row_data.extend([f"{val:25.7e}" for val in body_motion.acc[:]]) + row_data.extend([f"{val:25.7e}" for val in body_loads.loads[:]]) + + self.debug_file.write("".join(row_data) + "\n") + self.debug_file.flush() + + def end(self) -> None: + """Closes the debug file.""" + if self.opened: + self.debug_file.close() + self.opened = False + + + +class WaveTankLib(OpenFASTInterfaceType): + + #-------------------------------------- + # Error levels + #-------------------------------------- + error_levels: Dict[int, str] = { + 0: "None", + 1: "Info", + 2: "Warning", + 3: "Severe Error", + 4: "Fatal Error" + } + + # Debug output file: When coupled into another code, an array of position/orientation, + # velocities, and accelerations are passed in, and an array of Forces + Moments is + # returned. For debugging, it may be useful to dump all off this to a file. + debug_output_file: str = "DbgOutputs.out" + debug_outputs: int = 1 # For checking the interface, set this to 1 + + #-------------------------------------- + # Constants + #-------------------------------------- + # NOTE: The length of the error message in Fortran is determined by the + # ErrMsgLen variable in the NWTC_Base.f90 file. If ErrMsgLen is modified, + # the corresponding size here must also be updated to match. + ERROR_MESSAGE_LENGTH: int = 8197 + DEFAULT_STRING_LENGTH: int = 1025 + + def __init__(self, library_path: str): + """ + + Args: + library_path (str): Path to the compile wavetank interface shared library + input_file_names (dict): Map of file names for each included module: + - WT_InputFile + """ + super().__init__(library_path) + + self._initialize_routines() + + self.ended = False # For error handling at end + self.print_error_level = 1 + + + # Error handling setup + self.abort_error_level = 4 + self.error_status_c = c_int(0) + self.error_message_c = create_string_buffer(self.ERROR_MESSAGE_LENGTH) + + # returned values + self.rootname_c = create_string_buffer(self.IntfStrLen) + self.vtkdir_c = create_string_buffer(self.IntfStrLen) + self.buoyWaveElev_c = c_float(0) # wave elevation at buoy + + def _initialize_routines(self): + self.WaveTank_Init.argtypes = [ + POINTER(c_char), # intent(in ) :: WT_InputFile_c(IntfStrLen) + POINTER(c_char), # intent( out) :: RootName_C(IntfStrLen) + POINTER(c_char), # intent( out) :: VTKdir_C(IntfStrLen) + POINTER(c_int), # intent( out) :: ErrStat_C + POINTER(c_char), # intent( out) :: ErrMsg_C(ErrMsgLen_C) + ] + self.WaveTank_Init.restype = None + + self.WaveTank_CalcStep.argtypes = [ + POINTER(c_double), # real(c_double) :: time + POINTER(c_float), # intent(in ) :: pos(6) + POINTER(c_float), # intent(in ) :: vel(6) + POINTER(c_float), # intent(in ) :: acc(6) + POINTER(c_float), # intent( out) :: FrcMom(6) + POINTER(c_float), # intent( out) :: buoyWaveElev + POINTER(c_int), # integer(c_int), intent( out) :: ErrStat_C + POINTER(c_char), # character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + ] + self.WaveTank_CalcStep.restype = None + + self.WaveTank_End.argtypes = [ + POINTER(c_int), # integer(c_int), intent( out) :: ErrStat_C + POINTER(c_char), # character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + ] + self.WaveTank_End.restype = c_int + + self.WaveTank_SetWaveFieldPointer.argtypes = [ + POINTER(c_int), # integer(c_int), intent( out) :: ErrStat_C + POINTER(c_char), # character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + ] + self.WaveTank_SetWaveFieldPointer.restype = None + + + def check_error(self) -> None: + """Checks for and handles any errors from the Fortran library. + + Raises: + RuntimeError: If a fatal error occurs in the Fortran code + """ + # If the error status is 0, return + if self.error_status_c.value == 0: + return + + # Get the error level and error message + error_level = self.error_levels.get( + self.error_status_c.value, + f"Unknown Error Level: {self.error_status_c.value}" + ) + error_msg = self.error_message_c.raw.decode('utf-8').strip() + message = f"WaveTank library {error_level}: {error_msg}" + # If the error level is fatal, call WaveTank_End() and raise an error + if self.error_status_c.value >= self.abort_error_level: + try: + self.WaveTank_End( + byref(self.error_status_c), # OUT <- error status code + self.error_message_c # OUT <- error message buffer + ) + if self.error_status_c.value == 4: + error_msg = self.error_message_c.raw.decode('utf-8').strip() + print(f'WaveTank_End error: {error_msg}') + except Exception as e: + message += f"\nAdditional error during cleanup: {e}" + raise RuntimeError(message) + else: + print(message) + + + def _validate_loads_data( + self, + loads: LoadsData, + name: str, + ) -> None: + """Validates motion data dimensions. + + Args: + motion: Motion data to validate + name: Name of the component for error messages + + Raises: + ValueError: If dimensions are incorrect + """ + expected_shape = 6 + + if loads.loads.shape[0] != expected_shape: + raise ValueError( + f"{name} loads must have shape {expected_shape}, " + f"got {loads.loads.shape}" + ) + + + def _validate_motion_data( + self, + motion: MotionData, + name: str, + ) -> None: + """Validates motion data dimensions. + + Args: + motion: Motion data to validate + name: Name of the component for error messages + + Raises: + ValueError: If dimensions are incorrect + """ + expected_shape = 6 + + if motion.pos.shape[0] != expected_shape: + raise ValueError( + f"{name} position must have shape {expected_shape}, " + f"got {motion.pos.shape}" + ) + + if motion.vel.shape[0] != expected_shape: + raise ValueError( + f"{name} velocity must have shape {expected_shape}, " + f"got {motion.vel.shape}" + ) + + if motion.acc.shape[0] != expected_shape: + raise ValueError( + f"{name} acceleration must have shape {expected_shape}, " + f"got {motion.acc.shape}" + ) + + def _prepare_motion_arrays( + self, + body: MotionData, + ) -> Dict[str, Any]: + """Prepares C-compatible arrays for motion data. + + Args: + body: body motion data + + Returns: + Dictionary containing all prepared C arrays + """ + return { + # body data + 'body_pos_c': to_c_array(body.pos, c_float), + 'body_vel_c': to_c_array(body.vel, c_float), + 'body_acc_c': to_c_array(body.acc, c_float), + } + + + + def init(self, input_file_names: dict): + _error_message = create_string_buffer(self.ERROR_MSG_C_LEN) + + # Create C-compatible string buffers for input file names + self.input_file_names = { + k: create_string_buffer(str(Path(v).absolute()).encode('utf-8'), self.IntfStrLen) + for k,v in input_file_names.items() + } + + # # Convert the initial positions array into c_float array + # init_positions_c = (c_float * 6)(0.0, ) + # for i, p in enumerate(platform_init_pos): + # init_positions_c[i] = c_float(p) + + self.WaveTank_Init( + self.input_file_names["WaveTankConfig"], + self.rootname_c, # OUT <- rootname of output files + self.vtkdir_c, # OUT <- directory for vtk output + byref(self.error_status_c), # OUT <- error status code + self.error_message_c # OUT <- error message buffer + ) + self.check_error() + # tmp = self.rootname_c.raw.decode('utf-8').strip() + # print(f'RootName_c: {tmp}') + # tmp = self.vtkdir_c.raw.decode('utf-8').strip() + # print(f'VTKdir_c: {tmp}') + + def calc_step( + self, + time: float, + body_motion: MotionData, + body_loads: LoadsData, + ): + self._validate_motion_data(body_motion, "body") + self._validate_loads_data(body_loads, "body") + + # loads storage + #tmp_loads_c=np.array([0, 0, 0, 0, 0, 0], dtype=c_float) + tmp_loads_c = (c_float * (6))(0.) + + # Convert data to C arrays + motion_arrays = self._prepare_motion_arrays(body_motion) + + self.WaveTank_CalcStep( + byref(c_double(time)), + motion_arrays['body_pos_c'], # IN -> body pos [x,y,z,roll,pitch,yaw] + motion_arrays['body_vel_c'], # IN -> body vel [TVx, TVy, TVz, RVx, RVy, RVz] + motion_arrays['body_acc_c'], # IN -> body acc [TAx, TAy, TAz, RAx, RAy, RAz] + tmp_loads_c, # OUT <- body forces and moments [Fx,Fy,Fz,Mx,My,Mz] + byref(self.buoyWaveElev_c), # OUT <- buoy wave elevation + byref(self.error_status_c), # OUT <- error status code + self.error_message_c # OUT <- error message buffer + ) + self.check_error() + + # Copy over loads + body_loads.loads = np.ctypeslib.as_array(tmp_loads_c).astype(np.float32).copy() + #print(f"body_loads.loads {body_loads.loads}") + + + def end(self) -> None: + self.WaveTank_End( + byref(self.error_status_c), # OUT <- error status code + self.error_message_c # OUT <- error message buffer + ) + self.check_error() diff --git a/glue-codes/python/pyproject.toml b/glue-codes/python/pyproject.toml index 133d56967b..5d43e8b265 100644 --- a/glue-codes/python/pyproject.toml +++ b/glue-codes/python/pyproject.toml @@ -10,6 +10,7 @@ readme = "README.md" requires-python = ">=3.9" authors = [ { name = "Rafael Mudafort", email = "Rafael.Mudafort@nrel.gov" }, + { name = "Andy Platt", email = "Andy.Platt@nrel.gov" }, ] license = { file = "LICENSE.txt" } keywords = ["openfast"] @@ -22,20 +23,21 @@ classifiers = [ "Programming Language :: Python :: 3.11", "Programming Language :: Python :: 3.12", "Programming Language :: Python :: 3.13", + "Programming Language :: Python :: 3.14", "Programming Language :: Python :: Implementation :: CPython", "Programming Language :: Python :: Implementation :: PyPy" ] dependencies = [ - "numpy~=2.0", - "matplotlib~=3.0", + "numpy>=1.26", + "matplotlib>=3.0", ] [project.optional-dependencies] windio = [ - "windio~=1.0", + "windio", ] develop = [ - "pytest~=8.0", + "pytest>=8.0", ] [tool.setuptools.packages.find] diff --git a/glue-codes/simulink/CMakeLists.txt b/glue-codes/simulink/CMakeLists.txt index 242c4ac4fb..a66d6ce71b 100644 --- a/glue-codes/simulink/CMakeLists.txt +++ b/glue-codes/simulink/CMakeLists.txt @@ -19,6 +19,7 @@ set(MEX_LIBS $ $ + $ $ $ $ diff --git a/modules/aerodyn/CMakeLists.txt b/modules/aerodyn/CMakeLists.txt index 3ace5a80d3..09f4ea1388 100644 --- a/modules/aerodyn/CMakeLists.txt +++ b/modules/aerodyn/CMakeLists.txt @@ -18,6 +18,7 @@ if (GENERATE_TYPES) generate_f90_types(src/AeroAcoustics_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/AeroAcoustics_Types.f90 -noextrap) generate_f90_types(src/AeroDyn_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/AeroDyn_Types.f90) generate_f90_types(src/AeroDyn_Inflow_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/AeroDyn_Inflow_Types.f90 -noextrap) + generate_f90_types(src/AeroDyn_Inflow_C_Binding_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/AeroDyn_Inflow_C_Binding_Types.f90 -noextrap) generate_f90_types(src/AirfoilInfo_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/AirfoilInfo_Types.f90 -noextrap) generate_f90_types(src/BEMT_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/BEMT_Types.f90) generate_f90_types(src/DBEMT_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/DBEMT_Types.f90) @@ -38,6 +39,15 @@ add_library(basicaerolib STATIC ) target_link_libraries(basicaerolib ifwlib nwtclibs) +# AeroAcoustics library +add_library(aeroacousticslib STATIC + src/AeroAcoustics_TNO.f90 + src/AeroAcoustics.f90 + src/AeroAcoustics_IO.f90 + src/AeroAcoustics_Types.f90 +) +target_link_libraries(aeroacousticslib basicaerolib nwtclibs) + # AeroDyn Library add_library(aerodynlib STATIC src/AeroDyn.f90 @@ -52,12 +62,6 @@ add_library(aerodynlib STATIC src/BEMT_Types.f90 src/DBEMT_Types.f90 - # AeroAcoustics - Main - src/AeroAcoustics_TNO.f90 - src/AeroAcoustics.f90 - src/AeroAcoustics_IO.f90 - src/AeroAcoustics_Types.f90 - # FVW lib src/FVW.f90 src/FVW_IO.f90 @@ -68,7 +72,7 @@ add_library(aerodynlib STATIC src/FVW_Tests.f90 src/FVW_Types.f90 ) -target_link_libraries(aerodynlib basicaerolib nwtclibs) +target_link_libraries(aerodynlib basicaerolib aeroacousticslib nwtclibs) # ADI lib add_library(adilib STATIC @@ -90,6 +94,13 @@ add_executable(aerodyn_driver ) target_link_libraries(aerodyn_driver aerodyn_driver_subs) +# AeroAcoustics driver +add_executable(aeroacoustics_driver + src/AeroAcoustics_Driver_Subs.f90 + src/AeroAcoustics_Driver.f90 +) +target_link_libraries(aeroacoustics_driver aeroacousticslib versioninfolib) + # UnsteadyAero Driver add_executable(unsteadyaero_driver src/UnsteadyAero_Driver.f90 @@ -97,16 +108,36 @@ add_executable(unsteadyaero_driver ) target_link_libraries(unsteadyaero_driver basicaerolib lindynlib versioninfolib) + # AeroDyn-InflowWind c-bindings interface library -add_library(aerodyn_inflow_c_binding SHARED +# create object instead of directly linking into shared and static -- causes issues in parallel builds +# This is only required because we are static linking the library for wavetank +# NOTE: target linking at the object, static, and shared libraries. Different CMake versions handle this +# slightly differently with unpredictable results if I don't. +add_library(aerodyn_inflow_c_binding_object OBJECT + src/AeroDyn_Inflow_C_Binding_Types.f90 src/AeroDyn_Inflow_C_Binding.f90 ) -target_link_libraries(aerodyn_inflow_c_binding aerodyn_driver_subs versioninfolib) +target_link_libraries(aerodyn_inflow_c_binding_object adilib aerodyn_driver_subs nwtclibs versioninfolib) +set_property(TARGET aerodyn_inflow_c_binding_object PROPERTY POSITION_INDEPENDENT_CODE 1) # required for shared libs + +# shared +add_library(aerodyn_inflow_c_binding SHARED $) +target_link_libraries(aerodyn_inflow_c_binding adilib aerodyn_driver_subs nwtclibs versioninfolib) if(APPLE OR UNIX) target_compile_definitions(aerodyn_inflow_c_binding PRIVATE IMPLICIT_DLLEXPORT) endif() -install(TARGETS aerodynlib basicaerolib aerodyn_driver_subs aerodyn_driver unsteadyaero_driver aerodyn_inflow_c_binding adilib +# C-bindings non-shared interface +# This is a workaround for building wavetank into a single DLL (also allows setting CU globaly for sending screen to file for labview integration) +add_library(aerodyn_inflow_c_bind_static STATIC $) +target_link_libraries(aerodyn_inflow_c_bind_static adilib aerodyn_driver_subs nwtclibs versioninfolib) +if(APPLE OR UNIX) + target_compile_definitions(aerodyn_inflow_c_bind_static PRIVATE IMPLICIT_DLLEXPORT) +endif() + + +install(TARGETS aerodynlib aeroacousticslib basicaerolib aerodyn_driver_subs aerodyn_driver aeroacoustics_driver unsteadyaero_driver aerodyn_inflow_c_binding adilib aerodyn_inflow_c_bind_static EXPORT "${CMAKE_PROJECT_NAME}Libraries" RUNTIME DESTINATION bin LIBRARY DESTINATION lib diff --git a/modules/aerodyn/src/AeroAcoustics.f90 b/modules/aerodyn/src/AeroAcoustics.f90 index 968693f6a1..9142a8eea4 100644 --- a/modules/aerodyn/src/AeroAcoustics.f90 +++ b/modules/aerodyn/src/AeroAcoustics.f90 @@ -22,6 +22,13 @@ ! References: ! [1] Brooks, T. F.; Pope, D. S. & Marcolini, M. A., Airfoil self-noise and prediction, ! NASA, NASA, 1989. https://ntrs.nasa.gov/search.jsp?R=19890016302 +! NOTE: This paper is also known as "BPM Airfoil Self-noise and Prediction paper" in the code documentation. +! NOTE: curve fit equations in the Brooks, Pope, and Marcolini paper use AoA in **degrees** (not radians). + +! [2] Moriarty, Guidati, Migliore, Recent Improvement of a Semi-Empirical Aeroacoustic +! Prediction Code for Wind Turbines, 2003, NREL/TP-500-34478 (https://docs.nrel.gov/docs/fy04osti/34478.pdf) +! [3] Lowson, M.V.; Assessment and Prediction of Wind Turbine Noise, Volumes 13-284 of ETSU W. 1993. https://books.google.com/books?id=IgVKGwAACAAJ + module AeroAcoustics use NWTC_Library @@ -32,25 +39,33 @@ module AeroAcoustics implicit none private + ! ..... Public Subroutines ................................................................................................... public :: AA_Init ! Initialization routine public :: AA_End ! Ending routine (includes clean up) public :: AA_UpdateStates ! Loose coupling routine for solving for constraint states, integrating ! continuous states, and updating discrete states public :: AA_CalcOutput ! Routine for computing outputs + + REAL(ReKi), parameter :: AA_u_min = 0.1_ReKi + REAL(ReKi), parameter :: AA_EPSILON = 1.E-16 ! EPSILON(AA_EPSILON) + + REAL(ReKi), parameter :: RotorRegionAlph_delta = 60.0_ReKi ! degrees : size of bin, must be a number that evenly divides 360 degrees + REAL(ReKi), parameter :: RotorRegionRad_delta = 5.0_ReKi ! meters : size of bin along blade span (rotor radius) + REAL(ReKi), parameter :: RotorRegionTimeSampling = 5.0_ReKi ! seconds (for Num_total_sampleTI) contains !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the start of the simulation to perform initialization steps. !! The parameters are set here and not changed during the simulation. !! The initial states and initial guess for the input are defined. -subroutine AA_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) - type(AA_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine +subroutine AA_Init( InitInp, u, p, xd, OtherState, y, m, Interval, AFInfo, InitOut, ErrStat, ErrMsg ) + type(AA_InitInputType), intent(inout) :: InitInp !< Input data for initialization routine; out because we move allocated array type(AA_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined type(AA_ParameterType), intent( out) :: p !< Parameters - type(AA_ContinuousStateType), intent( out) :: x !< Initial continuous states + !type(AA_ContinuousStateType), intent( out) :: x !< Initial continuous states type(AA_DiscreteStateType), intent( out) :: xd !< Initial discrete states - type(AA_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states + !type(AA_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states type(AA_OtherStateType), intent( out) :: OtherState !< Initial other states type(AA_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated; !! only the output mesh is initialized) @@ -64,33 +79,33 @@ subroutine AA_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut type(AA_InitOutputType), intent( out) :: InitOut !< Output for initialization routine integer(IntKi), intent( out) :: errStat !< Error status of the operation character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + type(AFI_ParameterType), intent(in ) :: AFInfo(:) !< The airfoil parameter data +! integer(IntKi), intent(in ) :: AFIndx(:,:) + ! Local variables integer(IntKi) :: errStat2 ! temporary error status of the operation character(ErrMsgLen) :: errMsg2 ! temporary error message type(AA_InputFile) :: InputFileData ! Data stored in the module's input file - integer(IntKi) :: UnEcho ! Unit number for the echo file character(*), parameter :: RoutineName = 'AA_Init' ! Initialize variables for this routine errStat = ErrID_None errMsg = "" - UnEcho = -1 ! Initialize the NWTC Subroutine Library call NWTC_Init( EchoLibVer=.FALSE. ) ! Display the module information call DispNVD( AA_Ver ) ! To get rid of a compiler warning. - x%DummyContState = 0.0_SiKi - z%DummyConstrState = 0.0_SiKi - OtherState%DummyOtherState = 0.0_SiKi + !x%DummyContState = 0.0_SiKi + !z%DummyConstrState = 0.0_SiKi !bjj: note that we haven't validated p%NumBlades before using it below! p%NumBlades = InitInp%NumBlades ! need this before reading the AD input file so that we know how many blade files to read - p%RootName = TRIM(InitInp%RootName)//'.NN' + p%RootName = TRIM(InitInp%RootName)//'.'//trim(AA_Nickname) ! Read the primary AeroAcoustics input file in AeroAcoustics_IO - call ReadInputFiles( InitInp%InputFile, InitInp%AFInfo, InputFileData, interval, p%RootName, UnEcho, ErrStat2, ErrMsg2 ) + call ReadInputFiles( InitInp%InputFile, AFInfo, InputFileData, interval, p%RootName, ErrStat2, ErrMsg2 ) if (Failed()) return ! Validate the inputs @@ -100,23 +115,26 @@ subroutine AA_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut if (InitInp%AirDens <= 0.0) call SetErrStat ( ErrID_Fatal, 'The air density (AirDens) must be greater than zero.', ErrStat, ErrMsg, RoutineName ) if (InitInp%KinVisc <= 0.0) call SetErrStat ( ErrID_Fatal, 'The kinesmatic viscosity (KinVisc) must be greater than zero.', ErrStat, ErrMsg, RoutineName ) if (InitInp%SpdSound <= 0.0) call SetErrStat ( ErrID_Fatal, 'The speed of sound (SpdSound) must be greater than zero.', ErrStat, ErrMsg, RoutineName ) + if (InitInp%NumBlNds < 1) call SetErrStat ( ErrID_Fatal, 'AeroAcoustics requires at least 1 node.', ErrStat, ErrMsg, RoutineName ) if (Failed()) return ! Define parameters - call SetParameters( InitInp, InputFileData, p, ErrStat2, ErrMsg2 ); if(Failed()) return + call SetParameters( InitInp, InputFileData, p, AFInfo, ErrStat2, ErrMsg2 ); if(Failed()) return ! Define and initialize inputs call Init_u( u, p, errStat2, errMsg2 ); if(Failed()) return - ! Define outputs here - call Init_y(y, u, p, errStat2, errMsg2); if(Failed()) return - ! Initialize states and misc vars - call Init_MiscVars(m, p, u, y, errStat2, errMsg2); if(Failed()) return - call Init_States(xd, p, errStat2, errMsg2); if(Failed()) return + call Init_MiscVars(m, p, errStat2, errMsg2); if(Failed()) return + call Init_States(xd, OtherState, p, errStat2, errMsg2); if(Failed()) return + + ! Define write outputs here (must initialize AFTER Init_MiscVars) + call Init_y(y, m, p, errStat2, errMsg2); if(Failed()) return ! Define initialization output here call AA_SetInitOut(p, InitOut, errStat2, errMsg2); if(Failed()) return - call AA_InitializeOutputFile(p, InputFileData,InitOut,errStat2, errMsg2); if(Failed()) return + if (AA_OutputToSeparateFile) then + call AA_InitializeOutputFile(p, InputFileData,InitOut,errStat2, errMsg2); if(Failed()) return + end if call Cleanup() contains @@ -128,15 +146,15 @@ end function Failed subroutine Cleanup() CALL AA_DestroyInputFile( InputFileData, ErrStat2, ErrMsg2 ) - IF ( UnEcho > 0 ) CLOSE( UnEcho ) end subroutine Cleanup end subroutine AA_Init !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets AeroAcoustics parameters for use during the simulation; these variables are not changed after AA_Init. -subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) - TYPE(AA_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine, out is needed because of copy below - TYPE(AA_InputFile), INTENT(IN ) :: InputFileData !< Data stored in the module's input file -- intent(out) only for move_alloc statements +subroutine SetParameters( InitInp, InputFileData, p, AFInfo, ErrStat, ErrMsg ) + TYPE(AA_InitInputType), INTENT(INOUT) :: InitInp !< Input data for initialization routine, out is needed because of copy below + TYPE(AA_InputFile), INTENT(INOUT) :: InputFileData !< Data stored in the module's input file -- intent(out) only for move_alloc statements TYPE(AA_ParameterType), INTENT(INOUT) :: p !< Parameters + type(AFI_ParameterType), intent(in ) :: AFInfo(:) !< The airfoil parameter data INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! Local variables @@ -145,17 +163,15 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) ! INTEGER(IntKi) :: simcou,coun ! simple loop counter INTEGER(IntKi) :: I,J,whichairfoil,K,i1_1,i10_1,i1_2,i10_2,iLE character(*), parameter :: RoutineName = 'SetParameters' - LOGICAL :: tri,LE_flag - REAL(ReKi) :: val1,val10,f2,f4,lefttip,rightip,jumpreg, dist1, dist10 + REAL(ReKi) :: val1,val10,f2,f4, dist1, dist10 + REAL(ReKi) :: BladeSpanUsedForNoise + ! Initialize variables for this routine ErrStat = ErrID_None ErrMsg = "" - !!Assign input fiel data to parameters + !!Assign input file data to parameters p%DT = InputFileData%DT_AA ! seconds - p%AA_Bl_Prcntge = InputFileData%AA_Bl_Prcntge ! % - p%fsample = 1/p%DT ! Hz - p%total_sample = 2**( ceiling(log(1*p%fsample)/log(2.0d0)))! 1 stands for the 1 seconds. Every 1 second Vrel spectra will be calculated for the dissipation calculation (change if more needed & recompile ) - p%total_sampleTI = 5/p%DT ! 10 seconds for TI sampling + p%Num_total_sampleTI = max( NINT(RotorRegionTimeSampling / InputFileData%DT_AA), 1 ) p%AAStart = InputFileData%AAStart p%IBLUNT = InputFileData%IBLUNT p%ILAM = InputFileData%ILAM @@ -169,10 +185,9 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) p%ROUND = InputFileData%ROUND p%alprat = InputFileData%ALPRAT p%NrOutFile = InputFileData%NrOutFile - p%delim = Tab p%outFmt = "ES15.6E3" p%NumBlNds = InitInp%NumBlNds - p%AirDens = InitInp%AirDens + p%AirDens = InitInp%AirDens p%KinVisc = InitInp%KinVisc p%SpdSound = InitInp%SpdSound p%HubHeight = InitInp%HubHeight @@ -182,46 +197,28 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) p%TI = InputFileData%TI p%avgV = InputFileData%avgV - ! Copy AFInfo into AA module - ! TODO Allocate AFInfo and AFindx variables (DONE AND DONE) - ALLOCATE(p%AFInfo( size(InitInp%AFInfo) ), STAT=ErrStat2) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating memory for the InitInp%AFInfo array.', ErrStat2, ErrMsg2, RoutineName) - RETURN - ENDIF - - do i=1,size(InitInp%AFInfo) - call AFI_CopyParam(InitInp%AFInfo(i), p%AFInfo(i), MESH_NEWCOPY, errStat2, errMsg2); if(Failed()) return - end do ! Check 1 - tri=.true. - IF( (p%ITURB.eq.2) .or. (p%IInflow.gt.1) )then + IF( (p%ITURB.eq.ITURB_TNO) .or. p%IInflow == IInflow_FullGuidati .OR. p%IInflow == IInflow_SimpleGuidati )then ! if tno is on or one of the guidati models is on, check if we have airfoil coordinates - DO k=1,size(p%AFInfo) ! if any of the airfoil coordinates are missing change calculation method - IF( (size(p%AFInfo(k)%X_Coord) .lt. 5) .or. (size(p%AFInfo(k)%Y_Coord).lt.5) )then - IF (tri) then ! Print the message for once only - CALL WrScr( 'Airfoil coordinates are missing: If Full or Simplified Guidati or Bl Calculation is on coordinates are needed ' ) - CALL WrScr( 'Calculation methods enforced as BPM for TBLTE and only Amiet for inflow ' ) - p%ITURB = 1 - p%IInflow = 1 - tri=.false. - ENDIF + DO k=1,size(AFInfo) ! if any of the airfoil coordinates are missing change calculation method + IF( AFInfo(k)%NumCoords .lt. 5 )then + CALL WrScr( 'Airfoil coordinates are missing: If Full or Simplified Guidati or Bl Calculation is on coordinates are needed ' ) + CALL WrScr( 'Calculation methods enforced as BPM for TBLTE and only Amiet for inflow ' ) + p%ITURB = ITURB_BPM + p%IInflow = IInflow_BPM + exit ! stop checking do loop ENDIF ENDDO ENDIF ! Check 2 ! if passed the first check and if tno, turn on boundary layer calculation - IF( (p%ITURB.eq.2)) then - p%X_BLMethod=X_BLMethod_Tables - ENDIF + IF( (p%ITURB.eq.ITURB_TNO)) p%X_BLMethod=X_BLMethod_Tables ! Check 3 ! if boundary layer is tripped then laminar b.l. vortex shedding mechanism is turned off - IF( p%ITRIP.gt.0 )then - p%ILAM=0 - ENDIF + IF( p%ITRIP /= ITRIP_None ) p%ILAM=ILAM_None ! set 1/3 octave band frequency as parameter and A weighting. CALL AllocAry( p%FreqList, 34, 'FreqList', ErrStat2, ErrMsg2); if(Failed()) return @@ -242,52 +239,60 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) enddo ! Observer Locations - call AllocAry(p%ObsX, p%NrObsLoc, 'p%ObsX', ErrStat2, ErrMsg2); if(Failed()) return - call AllocAry(p%ObsY, p%NrObsLoc, 'p%ObsY', ErrStat2, ErrMsg2); if(Failed()) return - call AllocAry(p%ObsZ, p%NrObsLoc, 'p%ObsZ', ErrStat2, ErrMsg2); if(Failed()) return - p%ObsX = InputFileData%ObsX - p%ObsY = InputFileData%ObsY - p%ObsZ = InputFileData%ObsZ + call MOVE_ALLOC(InputFileData%ObsXYZ,p%ObsXYZ) + ! - call AllocAry(p%BlAFID, p%NumBlNds, p%numBlades, 'p%BlAFID' , ErrStat2, ErrMsg2); if(Failed()) return - p%BlAFID=InitInp%BlAFID + call MOVE_ALLOC(InitInp%BlAFID,p%BlAFID) ! Blade Characteristics chord,span,trailing edge angle and thickness,airfoil ID for each segment call AllocAry(p%TEThick ,p%NumBlNds,p%NumBlades,'p%TEThick' ,ErrStat2,ErrMsg2); if(Failed()) return call AllocAry(p%TEAngle ,p%NumBlNds,p%NumBlades,'p%TEAngle' ,ErrStat2,ErrMsg2); if(Failed()) return call AllocAry(p%StallStart,p%NumBlNds,p%NumBlades,'p%StallStart',ErrStat2,ErrMsg2); if(Failed()) return - p%StallStart(:,:) = 0.0_ReKi + p%StallStart = 0.0_ReKi - do i=1,p%NumBlades + do i=1,p%NumBlades do j=1,p%NumBlNds whichairfoil = p%BlAFID(j,i) p%TEThick(j,i) = InputFileData%BladeProps(whichairfoil)%TEThick p%TEAngle(j,i) = InputFileData%BladeProps(whichairfoil)%TEAngle - if(p%AFInfo(whichairfoil)%NumTabs /=1 ) then + if(AFInfo(whichairfoil)%NumTabs /=1 ) then call SetErrStat(ErrID_Fatal, 'Number of airfoil tables within airfoil file different than 1, which is not supported.', ErrStat2, ErrMsg2, RoutineName ) if(Failed()) return endif - p%StallStart(j,i) = p%AFInfo(whichairfoil)%Table(1)%UA_BL%alpha1*180/PI ! approximate stall angle of attack [deg] (alpha1 in [rad]) + p%StallStart(j,i) = AFInfo(whichairfoil)%Table(1)%UA_BL%alpha1*180/PI ! approximate stall angle of attack [deg] (alpha1 in [rad]) enddo enddo - call AllocAry(p%BlSpn, p%NumBlNds, p%NumBlades, 'p%BlSpn' , ErrStat2, ErrMsg2); if(Failed()) return - call AllocAry(p%BlChord, p%NumBlNds, p%NumBlades, 'p%BlChord', ErrStat2, ErrMsg2); if(Failed()) return - call AllocAry(p%AerCent, 2, p%NumBlNds, p%NumBlades, 'p%AerCent', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(p%BlSpn, p%NumBlNds, p%NumBlades, 'p%BlSpn' , ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(p%BlElemSpn, p%NumBlNds, p%NumBlades, 'p%BlElemSpn', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(p%BlChord, p%NumBlNds, p%NumBlades, 'p%BlChord' , ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(p%AerCent, 2, p%NumBlNds, p%NumBlades, 'p%AerCent' , ErrStat2, ErrMsg2); if(Failed()) return p%BlSpn = InitInp%BlSpn p%BlChord = InitInp%BlChord - do j=p%NumBlNds,2,-1 - IF ( p%BlSpn(j,1) .lt. p%BlSpn(p%NumBlNds,1)*(100-p%AA_Bl_Prcntge)/100 )THEN ! assuming + p%startnode = max(1, p%NumBlNds - 1) + BladeSpanUsedForNoise = p%BlSpn(p%NumBlNds,1)*(1.0 - InputFileData%AA_Bl_Prcntge/100.0) + do j=p%NumBlNds-1,2,-1 + IF ( p%BlSpn(j,1) .lt. BladeSpanUsedForNoise )THEN p%startnode=j exit ! exit the loop endif enddo - - IF (p%startnode.lt.2) THEN - p%startnode=2 - ENDIF + p%startnode = max(min(p%NumBlNds,2),p%startnode) + + p%BlElemSpn = 0; + DO I = 1,p%numBlades + DO J = p%startnode,p%NumBlNds ! starts loop from startnode. + IF (J < 2) THEN + p%BlElemSpn(J,I) = p%BlSpn(J,I) !assume this is the innermost node + ELSEIF (J .EQ. p%NumBlNds) THEN + p%BlElemSpn(J,I) = p%BlSpn(J,I)-p%BlSpn(J-1,I) + ELSE + p%BlElemSpn(J,I) = (p%BlSpn(J,I)-p%BlSpn(J-1,I))/2 + (p%BlSpn(J+1,I)-p%BlSpn(J,I))/2 ! this is the average element size around this node, equivalent to (p%BlSpn(J+1,I) - p%BlSpn(J-1,I))/2 + ENDIF + end do + end do !print*, 'AeroAcoustics Module is using the blade nodes starting from ' ,p%startnode,' Radius in meter ',p%BlSpn(p%startnode,1) !AerodYnamic center extraction for each segment @@ -295,8 +300,13 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) do j=1,p%NumBlNds whichairfoil = p%BlAFID(j,i) ! just a temporary variable for clear coding ! airfoil coordinates read by AeroDyn. First value is the aerodynamic center - p%AerCent(1,J,I) = p%AFInfo(whichairfoil)%X_Coord(1) ! assigned here corresponding airfoil. - p%AerCent(2,J,I) = p%AFInfo(whichairfoil)%Y_Coord(1) ! assigned here corresponding airfoil. + if (AFInfo(whichairfoil)%NumCoords > 0) then + p%AerCent(1,J,I) = AFInfo(whichairfoil)%X_Coord(1) ! assigned here corresponding airfoil. + p%AerCent(2,J,I) = AFInfo(whichairfoil)%Y_Coord(1) ! assigned here corresponding airfoil. + else + p%AerCent(1,J,I) = 0.0_ReKi + p%AerCent(2,J,I) = 0.0_ReKi + end if enddo enddo @@ -320,77 +330,47 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) ENDDO if (p%X_BLMethod .eq. X_BLMethod_Tables) then - ! Copying inputdata list of AOA and Reynolds to parameters - call AllocAry( p%AOAListBL, size(InputFileData%AOAListBL), 'p%AOAListBL', errStat2, errMsg2); if(Failed()) return - call AllocAry( p%ReListBL, size(InputFileData%ReListBL) , 'p%ReListBL' , errStat2, errMsg2); if(Failed()) return - p%AOAListBL=InputFileData%AOAListBL - p%ReListBL=InputFileData%ReListBL - ! Allocate the suction and pressure side boundary layer parameters for output - will be used as tabulated data - call AllocAry(p%dstarall1 ,size(p%AOAListBL), size(p%ReListBL),size(p%AFInfo),'p%dstarall1' , errStat2, errMsg2); if(Failed()) return - call AllocAry(p%dstarall2 ,size(p%AOAListBL), size(p%ReListBL),size(p%AFInfo),'p%dstarall2' , errStat2, errMsg2); if(Failed()) return - call AllocAry(p%d99all1 ,size(p%AOAListBL), size(p%ReListBL),size(p%AFInfo),'p%d99all1' , errStat2, errMsg2); if(Failed()) return - call AllocAry(p%d99all2 ,size(p%AOAListBL), size(p%ReListBL),size(p%AFInfo),'p%d99all2' , errStat2, errMsg2); if(Failed()) return - call AllocAry(p%Cfall1 ,size(p%AOAListBL), size(p%ReListBL),size(p%AFInfo),'p%Cfall1' , errStat2, errMsg2); if(Failed()) return - call AllocAry(p%Cfall2 ,size(p%AOAListBL), size(p%ReListBL),size(p%AFInfo),'p%Cfall2' , errStat2, errMsg2); if(Failed()) return - call AllocAry(p%EdgeVelRat1,size(p%AOAListBL), size(p%ReListBL),size(p%AFInfo),'p%EdgeVelRat1', errStat2, errMsg2); if(Failed()) return - call AllocAry(p%EdgeVelRat2,size(p%AOAListBL), size(p%ReListBL),size(p%AFInfo),'p%EdgeVelRat2', errStat2, errMsg2); if(Failed()) return - p%dstarall1 =0.0_ReKi - p%dstarall2 =0.0_ReKi - p%d99all1 =0.0_ReKi - p%d99all2 =0.0_ReKi - p%Cfall1 =0.0_ReKi - p%Cfall2 =0.0_ReKi - p%EdgeVelRat1 =0.0_ReKi - p%EdgeVelRat2 =0.0_ReKi - - - ! --- BL data are read from files and just copy what was read from the files - p%dstarall1 = InputFileData%Suct_DispThick - p%dstarall2 = InputFileData%Pres_DispThick - p%d99all1 = InputFileData%Suct_BLThick - p%d99all2 = InputFileData%Pres_BLThick - p%Cfall1 = InputFileData%Suct_Cf - p%Cfall2 = InputFileData%Pres_Cf - p%EdgeVelRat1 = InputFileData%Suct_EdgeVelRat - p%EdgeVelRat2 = InputFileData%Pres_EdgeVelRat + call MOVE_ALLOC(InputFileData%AOAListBL,p%AOAListBL) + call MOVE_ALLOC(InputFileData%ReListBL,p%ReListBL) - if(Failed()) return + ! --- BL data are read from files and just copy what was read from the files + call MOVE_ALLOC(InputFileData%Suct_DispThick , p%dstarall1 ) + call MOVE_ALLOC(InputFileData%Pres_DispThick , p%dstarall2 ) + call MOVE_ALLOC(InputFileData%Suct_BLThick , p%d99all1 ) + call MOVE_ALLOC(InputFileData%Pres_BLThick , p%d99all2 ) + call MOVE_ALLOC(InputFileData%Suct_Cf , p%Cfall1 ) + call MOVE_ALLOC(InputFileData%Pres_Cf , p%Cfall2 ) + call MOVE_ALLOC(InputFileData%Suct_EdgeVelRat , p%EdgeVelRat1 ) + call MOVE_ALLOC(InputFileData%Pres_EdgeVelRat , p%EdgeVelRat2 ) endif - ! If simplified guidati is on, calculate the airfoil thickness at 1% and at 10% chord from input airfoil coordinates - IF (p%IInflow .EQ. 2) THEN - call AllocAry(p%AFThickGuida,2,size(p%AFInfo), 'p%AFThickGuida', errStat2, errMsg2); if(Failed()) return + ! If guidati is on, calculate the airfoil thickness at 1% and at 10% chord from input airfoil coordinates + IF (p%IInflow .EQ. IInflow_FullGuidati) THEN + call AllocAry(p%AFThickGuida,2,size(AFInfo), 'p%AFThickGuida', errStat2, errMsg2); if(Failed()) return p%AFThickGuida=0.0_Reki - DO k=1,size(p%AFInfo) ! for each airfoil interpolation + DO k=1,size(AFInfo) ! for each airfoil interpolation - ! IF ((MIN(p%AFInfo(k)%X_Coord) < 0.) .or. (MAX(p%AFInfo(k)%X_Coord) > 0.)) THEN - ! call SetErrStat ( ErrID_Fatal,'The coordinates of airfoil '//trim(num2lstr(k))//' are mot defined between x=0 and x=1. Code stops.' ,ErrStat, ErrMsg, RoutineName ) - ! ENDIF - - ! Flip the flag when LE is found and find index - LE_flag = .False. - DO i=3,size(p%AFInfo(k)%X_Coord) - IF (LE_flag .eqv. .False.) THEN - IF (p%AFInfo(k)%X_Coord(i) - p%AFInfo(k)%X_Coord(i-1) > 0.) THEN - LE_flag = .TRUE. - iLE = i - ENDIF - ENDIF + ! find index where LE is found + DO i=3,size(AFInfo(k)%X_Coord) + IF (AFInfo(k)%X_Coord(i) - AFInfo(k)%X_Coord(i-1) > 0.) THEN + iLE = i + exit ! end the innermost do loop (i) + ENDIF ENDDO ! From LE toward TE - dist1 = ABS( p%AFInfo(k)%X_Coord(iLE) - 0.01) - dist10 = ABS( p%AFInfo(k)%X_Coord(iLE) - 0.10) - DO i=iLE+1,size(p%AFInfo(k)%X_Coord) - IF (ABS(p%AFInfo(k)%X_Coord(i) - 0.01) < dist1) THEN + dist1 = ABS( AFInfo(k)%X_Coord(iLE) - 0.01) + dist10 = ABS( AFInfo(k)%X_Coord(iLE) - 0.10) + DO i=iLE+1,size(AFInfo(k)%X_Coord) + IF (ABS(AFInfo(k)%X_Coord(i) - 0.01) < dist1) THEN i1_1 = i - dist1 = ABS(p%AFInfo(k)%X_Coord(i) - 0.01) + dist1 = ABS(AFInfo(k)%X_Coord(i) - 0.01) ENDIF - IF (ABS(p%AFInfo(k)%X_Coord(i) - 0.1) < dist10) THEN + IF (ABS(AFInfo(k)%X_Coord(i) - 0.1) < dist10) THEN i10_1 = i - dist10 = ABS(p%AFInfo(k)%X_Coord(i) - 0.1) + dist10 = ABS(AFInfo(k)%X_Coord(i) - 0.1) ENDIF ENDDO @@ -398,52 +378,35 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) dist1 = 0.99 dist10 = 0.90 DO i=1,iLE-1 - IF (ABS(p%AFInfo(k)%X_Coord(i) - 0.01) < dist1) THEN + IF (ABS(AFInfo(k)%X_Coord(i) - 0.01) < dist1) THEN i1_2 = i - dist1 = ABS(p%AFInfo(k)%X_Coord(i) - 0.01) + dist1 = ABS(AFInfo(k)%X_Coord(i) - 0.01) ENDIF - IF (ABS(p%AFInfo(k)%X_Coord(i) - 0.1) < dist10) THEN + IF (ABS(AFInfo(k)%X_Coord(i) - 0.1) < dist10) THEN i10_2 = i - dist10 = ABS(p%AFInfo(k)%X_Coord(i) - 0.1) + dist10 = ABS(AFInfo(k)%X_Coord(i) - 0.1) ENDIF ENDDO - val1 = p%AFInfo(k)%Y_Coord(i1_1) - p%AFInfo(k)%Y_Coord(i1_2) - val10 = p%AFInfo(k)%Y_Coord(i10_1) - p%AFInfo(k)%Y_Coord(i10_2) + val1 = AFInfo(k)%Y_Coord(i1_1 ) - AFInfo(k)%Y_Coord(i1_2) + val10 = AFInfo(k)%Y_Coord(i10_1) - AFInfo(k)%Y_Coord(i10_2) p%AFThickGuida(1,k)=val1 ! 1 % chord thickness p%AFThickGuida(2,k)=val10 ! 10 % chord thickness ENDDO ENDIF - !! for turbulence intensity calculations on the fly every 5 meter the whole rotor area is divided vertically to store flow fields in each region - jumpreg=7 - p%toptip = CEILING(p%HubHeight+maxval(p%BlSpn(:,1)))+2 !Top Tip Height = Hub height plus radius - p%bottip = FLOOR(p%HubHeight-maxval(p%BlSpn(:,1)))-2 !Bottom Tip Height = Hub height minus radius - call AllocAry(p%rotorregionlimitsVert,ceiling(((p%toptip)-(p%bottip))/jumpreg), 'p%rotorregionlimitsVert', errStat2, errMsg2); if(Failed()) return - do i=0,size(p%rotorregionlimitsVert)-1 - p%rotorregionlimitsVert(i+1)=(p%bottip)+jumpreg*i - enddo - !! for turbulence intensity calculations on the fly every 5 meter the whole rotor area is divided horizontally to store flow fields in each region - jumpreg=7 - lefttip = 2*maxval(p%BlSpn(:,1))+5 ! - rightip = 0 ! - call AllocAry( p%rotorregionlimitsHorz,ceiling(((lefttip)-(rightip))/jumpreg), 'p%rotorregionlimitsHorz', errStat2, errMsg2); if(Failed()) return - do i=0,size(p%rotorregionlimitsHorz)-1 - p%rotorregionlimitsHorz(i+1)=rightip+jumpreg*i - enddo - jumpreg=60 ! 10 ! must be divisable to 360 - call AllocAry(p%rotorregionlimitsalph,INT((360/jumpreg)+1), 'p%rotorregionlimitsalph', errStat2, errMsg2); if(Failed()) return - do i=0,size(p%rotorregionlimitsalph)-1 - p%rotorregionlimitsalph(i+1)=jumpreg*i - enddo - jumpreg=5 - call AllocAry( p%rotorregionlimitsrad, (CEILING( maxval(p%BlSpn(:,1))/jumpreg )+2), 'p%rotorregionlimitsrad', errStat2, errMsg2); if(Failed()) return - do i=1,size(p%rotorregionlimitsrad)-1 - p%rotorregionlimitsrad(i+1)=jumpreg*i - enddo - p%rotorregionlimitsrad(1)=0.0_reki - p%rotorregionlimitsrad(size(p%rotorregionlimitsrad)-1)=p%rotorregionlimitsrad(size(p%rotorregionlimitsrad)-1)+3 + p%NumRotorRegionLimitsAlph = NINT(360./RotorRegionAlph_delta) + 1 + p%NumRotorRegionLimitsRad = CEILING( maxval(p%BlSpn)/RotorRegionRad_delta )+2 + + call AllocAry( p%RotorRegion_k_minus1, p%NumBlNds, p%NumBlades, 'p%RotorRegion_k_minus1', errStat2, errMsg2); if(Failed()) return + p%RotorRegion_k_minus1 = 0 + do i=1,p%NumBlades + do j=1,p%NumBlNds + p%RotorRegion_k_minus1(j,i) = CEILING( p%BlSpn(j,i) / RotorRegionRad_delta ) + p%RotorRegion_k_minus1(j,i) = MIN( p%NumRotorRegionLimitsRad - 1, MAX( 1, p%RotorRegion_k_minus1(j,i) ) ) !safety + end do + enddo contains logical function Failed() @@ -481,48 +444,44 @@ end function Failed end subroutine Init_u !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes AeroAcoustics output array variables for use during the simulation. -subroutine Init_y(y, u, p, errStat, errMsg) +subroutine Init_y(y, m, p, errStat, errMsg) type(AA_OutputType), intent( out) :: y !< Module outputs - type(AA_InputType), intent(inout) :: u !< Module inputs -- intent(out) because of mesh sibling copy + type(AA_MiscVarType), intent(in ) :: m !< misc/optimization data type(AA_ParameterType), intent(inout) :: p !< Parameters integer(IntKi), intent( out) :: errStat !< Error status of the operation character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + ! Local variables integer(intKi) :: ErrStat2 ! temporary Error status character(ErrMsgLen) :: ErrMsg2 ! temporary Error message character(*), parameter :: RoutineName = 'Init_y' - integer(intKi) :: nNoiseMechanism ! loop counter for blades + ! Initialize variables for this routine errStat = ErrID_None errMsg = "" - nNoiseMechanism = 7! 7 noise mechanisms - p%numOuts = p%NrObsLoc - p%NumOutsForSep = p%NrObsLoc*size(p%FreqList)*nNoiseMechanism - p%NumOutsForPE = p%NrObsLoc*size(p%Freqlist) - p%NumOutsForNodes = p%NrObsLoc*p%NumBlNds*p%NumBlades - call AllocAry(y%WriteOutput , p%numOuts , 'y%WriteOutput' , errStat2 , errMsg2); if(Failed()) return - call AllocAry(y%WriteOutputSep , p%NumOutsForSep , 'y%WriteOutputSep' , errStat2 , errMsg2); if(Failed()) return - call AllocAry(y%WriteOutputForPE , p%numOutsForPE , 'y%WriteOutputForPE' , errStat2 , errMsg2); if(Failed()) return - call AllocAry(y%DirectiviOutput , p%NrObsLoc , 'y%DirectiviOutput' , errStat2 , errMsg2); if(Failed()) return - call AllocAry(y%WriteOutputNode , p%NumOutsForNodes , 'y%WriteOutputSepFreq' , errStat2 , errMsg2); if(Failed()) return - call AllocAry(y%OASPL , p%NrObsLoc , p%NumBlNds , p%NumBlades , 'y%OASPL' , errStat2 , errMsg2); if(Failed()) return - call AllocAry(y%SumSpecNoise , size(p%FreqList) , p%NrObsLoc , p%NumBlades , 'y%SumSpecNoise' , errStat2 , errMsg2); if(Failed()) return - call AllocAry(y%SumSpecNoiseSep , 7 , p%NrObsLoc , size(p%FreqList) , 'y%SumSpecNoiseSep' , errStat2 , errMsg2); if(Failed()) return - call AllocAry(y%OASPL_Mech , nNoiseMechanism , p%NrObsLoc , p%NumBlNds , p%NumBlades , 'y%OASPL_Mech' , errStat2 , errMsg2); if(Failed()) return - call AllocAry(y%OutLECoords , 3 , size(p%FreqList) , p%NrObsLoc , p%NumBlades , 'y%OutLECoords' , errStat2 , errMsg2); if(Failed()) return - call AllocAry(y%PtotalFreq , p%NrObsLoc , size(p%FreqList) , 'y%PtotalFreq' , errStat2 , errMsg2); if(Failed()) return - - y%WriteOutput = 0.0_reki - y%WriteOutputSep = 0.0_reki - y%WriteOutputForPE = 0.0_reki - y%DirectiviOutput = 0.0_reki - y%WriteOutputNode = 0.0_reki - y%OASPL = 0.0_reki - y%OASPL_Mech = 0.0_reki - y%SumSpecNoise = 0.0_reki - y%SumSpecNoiseSep = 0.0_reki - y%OutLECoords = 0.0_reki - y%PtotalFreq = 0.0_reki + + p%numOutsAll = 0 + + p%numOutsAll(1) = SIZE(m%DirectiviOutput) + if (p%NrOutFile > 1) p%numOutsAll(2) = SIZE(m%PtotalFreq) ! SIZE returns total size, including all dimensions of the multi-dimensional array + if (p%NrOutFile > 2) p%numOutsAll(3) = SIZE(m%SumSpecNoiseSep) + if (p%NrOutFile > 3) p%numOutsAll(4) = SIZE(m%OASPL) + + if (AA_OutputToSeparateFile) then + p%numOuts = 0 + else + p%numOuts = SUM(p%numOutsAll) + end if + + call AllocAry(y%WriteOutput , p%numOutsAll(1), 'y%WriteOutput' , errStat2 , errMsg2); if(Failed()) return + call AllocAry(y%WriteOutputSep , p%numOutsAll(3), 'y%WriteOutputSep' , errStat2 , errMsg2); if(Failed()) return + call AllocAry(y%WriteOutputForPE , p%numOutsAll(2), 'y%WriteOutputForPE' , errStat2 , errMsg2); if(Failed()) return + call AllocAry(y%WriteOutputNodes , p%numOutsAll(4), 'y%WriteOutputSepFreq' , errStat2 , errMsg2); if(Failed()) return + + y%WriteOutput = 0.0_reki + y%WriteOutputSep = 0.0_reki + y%WriteOutputForPE = 0.0_reki + y%WriteOutputNodes = 0.0_reki contains logical function Failed() @@ -532,11 +491,9 @@ end function Failed end subroutine Init_y !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes (allocates) the misc variables for use during the simulation. -subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) +subroutine Init_MiscVars(m, p, errStat, errMsg) type(AA_MiscVarType), intent(inout) :: m !< misc/optimization data (not defined in submodules) type(AA_ParameterType), intent(in ) :: p !< Parameters - type(AA_InputType), intent(inout) :: u !< input for HubMotion mesh (create sibling mesh here) - type(AA_OutputType), intent(in ) :: y !< output (create mapping between output and otherstate mesh here) integer(IntKi), intent( out) :: errStat !< Error status of the operation character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None ! Local variables @@ -556,38 +513,30 @@ subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) call AllocAry(m%SPLP , size(p%FreqList), 'SPLP' , errStat2, errMsg2); if(Failed()) return call AllocAry(m%SPLS , size(p%FreqList), 'SPLS' , errStat2, errMsg2); if(Failed()) return call AllocAry(m%SPLALPH , size(p%FreqList), 'SPLALPH' , errStat2, errMsg2); if(Failed()) return - call AllocAry(m%SPLTBL , size(p%FreqList), 'SPLTBL' , errStat2, errMsg2); if(Failed()) return call AllocAry(m%SPLBLUNT , size(p%FreqList), 'SPLBLUNT' , errStat2, errMsg2); if(Failed()) return call AllocAry(m%SPLTIP , size(p%FreqList), 'SPLTIP' , errStat2, errMsg2); if(Failed()) return call AllocAry(m%SPLTI , size(p%FreqList), 'SPLTI' , errStat2, errMsg2); if(Failed()) return call AllocAry(m%SPLTIGui , size(p%FreqList), 'SPLTIGui' , errStat2, errMsg2); if(Failed()) return - call AllocAry(m%CfVar , 2 , 'CfVar' , errStat2, errMsg2); if(Failed()) return - call AllocAry(m%d99Var , 2 , 'd99Var' , errStat2, errMsg2); if(Failed()) return - call AllocAry(m%dstarVar , 2 , 'dstarVar' , errStat2, errMsg2); if(Failed()) return - call AllocAry(m%EdgeVelVar , 2 , 'EdgeVelVar', errStat2, errMsg2); if(Failed()) return + call AllocAry(m%LE_Location, 3, p%NumBlNds, p%numBlades, 'LE_Location', ErrStat2, ErrMsg2); if(Failed()) return - m%ChordAngleLE = 0.0_ReKi - m%SpanAngleLE = 0.0_ReKi + + ! arrays for computing WriteOutput values + call AllocAry(m%DirectiviOutput , p%NrObsLoc , 'm%DirectiviOutput' , errStat2 , errMsg2); if(Failed()) return + call AllocAry(m%SumSpecNoiseSep , nNoiseMechanism , size(p%FreqList) , p%NrObsLoc , 'm%SumSpecNoiseSep' , errStat2 , errMsg2); if(Failed()) return + call AllocAry(m%PtotalFreq , size(p%FreqList) , p%NrObsLoc , 'm%PtotalFreq' , errStat2 , errMsg2); if(Failed()) return + call AllocAry(m%OASPL , p%NrObsLoc , p%NumBlNds , p%NumBlades , 'm%OASPL' , errStat2 , errMsg2); if(Failed()) return + m%ChordAngleTE = 0.0_ReKi m%SpanAngleTE = 0.0_ReKi m%rTEtoObserve = 0.0_ReKi m%rLEtoObserve = 0.0_ReKi - m%SPLLBL = 0.0_ReKi - m%SPLP = 0.0_ReKi - m%SPLS = 0.0_ReKi - m%SPLALPH = 0.0_ReKi - m%SPLTBL = 0.0_ReKi - m%SPLBLUNT = 0.0_ReKi - m%SPLTIP = 0.0_ReKi - m%SPLTI = 0.0_ReKi + m%SPLTIGui = 0.0_ReKi m%CfVar = 0.0_ReKi m%d99Var = 0.0_ReKi m%dstarVar = 0.0_ReKi m%EdgeVelVar = 0.0_ReKi m%LE_Location = 0.0_ReKi - m%speccou = 0 - m%filesopen = 0 contains logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -596,54 +545,32 @@ end function Failed end subroutine Init_MiscVars !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes (allocates) the misc variables for use during the simulation. -subroutine Init_states(xd, p, errStat, errMsg) - type(AA_DiscreteStateType), intent(inout) :: xd ! - type(AA_ParameterType), intent(in ) :: p !< Parameters - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - ! Local variables - integer(intKi) :: k,ji - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'Init_DiscrStates' - ! Initialize variables for this routine - errStat = ErrID_None - errMsg = "" +subroutine Init_states(xd, OtherState, p, errStat, errMsg) + type(AA_DiscreteStateType), intent(inout) :: xd ! + type(AA_OtherStateType), intent(inout) :: OtherState !< Initial other states + type(AA_ParameterType), intent(in ) :: p !< Parameters + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'Init_states' + + ! Initialize variables for this routine + errStat = ErrID_None + errMsg = "" + + call AllocAry(xd%TIVx, p%NumBlNds, p%numBlades, 'xd%TIVx' , ErrStat2, ErrMsg2); if(Failed()) return + xd%TIVx = 0.0_ReKi + + if (p%TICalcMeth == TICalc_Every) then + call AllocAry(xd%RegVxStor, p%Num_total_sampleTI, p%NumRotorRegionLimitsRad-1,p%NumRotorRegionLimitsAlph-1,'xd%Vxst', ErrStat2,ErrMsg2); if(Failed()) return + call AllocAry(OtherState%allregcounter , p%NumRotorRegionLimitsRad-1,p%NumRotorRegionLimitsAlph-1,'OtherState%allregcounter', ErrStat2,ErrMsg2); if(Failed()) return + + xd%RegVxStor = 0.0_reki + OtherState%allregcounter = 0 + endif - call AllocAry(xd%MeanVrel, p%NumBlNds, p%numBlades, 'xd%MeanVrel' , ErrStat2, ErrMsg2); if(Failed()) return - call AllocAry(xd%VrelSq, p%NumBlNds, p%numBlades, 'xd%VrelSq' , ErrStat2, ErrMsg2); if(Failed()) return - call AllocAry(xd%TIVrel, p%NumBlNds, p%numBlades, 'xd%TIVrel' , ErrStat2, ErrMsg2); if(Failed()) return - call AllocAry(xd%MeanVxVyVz, p%NumBlNds, p%numBlades, 'xd%MeanVxVyVz', ErrStat2, ErrMsg2); if(Failed()) return - call AllocAry(xd%TIVx, p%NumBlNds, p%numBlades, 'xd%TIVx' , ErrStat2, ErrMsg2); if(Failed()) return - call AllocAry(xd%VxSq, p%NumBlNds, p%numBlades, 'xd%VxSq' , ErrStat2, ErrMsg2); if(Failed()) return - call AllocAry(xd%VrelStore, p%total_sample+1, p%NumBlNds, p%numBlades,'xd%VrelStore', ErrStat2, ErrMsg2) ! plus one just in case - if(Failed()) return - DO ji=1,size(xd%MeanVrel,2) - DO k=1,size(xd%MeanVrel,1) - xd%VrelSq (k,ji) = 0.0_ReKi ! Relative Velocity Squared for TI calculation (on the fly) - xd%MeanVrel (k,ji) = 0.0_ReKi ! Relative Velocity Mean calculation (on the fly) - xd%TIVrel(k,ji) = 0.0_ReKi ! Turbulence Intensity (for on the fly calculation) - xd%MeanVxVyVz (k,ji) = 0.0_ReKi ! - xd%TIVx (k,ji) = 0.0_ReKi ! - xd%VxSq (k,ji) = 0.0_ReKi ! - xd%VrelStore (1:size(xd%VrelStore,1),k,ji) = 0.0_ReKi ! - ENDDO - ENDDO - call AllocAry(xd%RegVxStor,p%total_sampleTI,size(p%rotorregionlimitsrad)-1,size(p%rotorregionlimitsalph)-1,'xd%Vxst',ErrStat2,ErrMsg2) - if(Failed()) return - call AllocAry(xd%allregcounter ,size(p%rotorregionlimitsrad)-1,size(p%rotorregionlimitsalph)-1,'xd%allregcounter',ErrStat2,ErrMsg2 ) - if(Failed()) return - call AllocAry(xd%VxSqRegion ,size(p%rotorregionlimitsrad)-1,size(p%rotorregionlimitsalph)-1,'xd%VxSqRegion' , ErrStat2, ErrMsg2) - if(Failed()) return - call AllocAry(xd%RegionTIDelete,size(p%rotorregionlimitsrad)-1,size(p%rotorregionlimitsalph)-1,'xd%RegionTIDelete', ErrStat2, ErrMsg2) - do ji=1,size(xd%allregcounter,2) - do k=1,size(xd%allregcounter,1) - xd%allregcounter(k,ji) = 2.0_Reki ! - xd%VxSqRegion(k,ji) = 0.0_ReKi ! - xd%RegionTIDelete(k,ji) = 0.0_ReKi ! - xd%RegVxStor(1:size(xd%RegVxStor,1),k,ji)=0.0_reki - enddo - enddo contains logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -651,12 +578,13 @@ logical function Failed() end function Failed end subroutine Init_states !---------------------------------------------------------------------------------------------------------------------------------- -subroutine AA_UpdateStates( t, n, m, u, p, xd, errStat, errMsg ) +subroutine AA_UpdateStates( t, n, m, u, p, xd, OtherState, errStat, errMsg ) real(DbKi), intent(in ) :: t !< Current simulation time in seconds integer(IntKi), intent(in ) :: n !< Current simulation time step n = 0,1,... type(AA_InputType), intent(in ) :: u !< Inputs at utimes (out only for mesh record-keeping in ExtrapInterp routine) TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters type(AA_DiscreteStateType), intent(inout) :: xd !< Input: Discrete states at t; + type(AA_OtherStateType), intent(inout) :: OtherState !< Other states (integers) type(AA_MiscVarType), intent(inout) :: m !< misc/optimization data integer(IntKi), intent( out) :: errStat !< Error status of the operation character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None @@ -664,61 +592,58 @@ subroutine AA_UpdateStates( t, n, m, u, p, xd, errStat, errMsg ) ! integer(intKi) :: ErrStat2 ! temporary Error status ! character(ErrMsgLen) :: ErrMsg2 ! temporary Error message character(*), parameter :: RoutineName = 'AA_UpdateStates' - REAL(ReKi),DIMENSION(p%NumBlNds,p%numBlades) :: TEMPSTD ! temporary standard deviation variable - REAL(ReKi) :: tempsingle,tempmean,angletemp,abs_le_x,ti_vx,U1,U2 ! temporary standard deviation variable - integer(intKi) :: i,j,k,rco, y0_a,y1_a,z0_a,z1_a - REAL(ReKi) :: yi_a,zi_a,yd_a,zd_a,c00_a,c10_a +! REAL(ReKi),DIMENSION(p%NumBlNds,p%numBlades) :: TEMPSTD ! temporary standard deviation variable + REAL(ReKi) :: InflowNorm,meanInflow,angletemp,abs_le_x ! temporary standard deviation variable + integer(intKi) :: i,j + integer(intKi) :: k_minus1,rco_minus1 ErrStat = ErrID_None ErrMsg = "" - ! Cumulative mean and standard deviation, states are updated as Vx Vy Vz changes at each time step - TEMPSTD = sqrt( u%Inflow(1,:,:)**2+u%Inflow(2,:,:)**2+u%Inflow(3,:,:)**2 ) - xd%MeanVxVyVz = (TEMPSTD + xd%MeanVxVyVz*n) / (n+1) - ! xd%VxSq = TEMPSTD**2 + xd%VxSq - ! TEMPSTD = sqrt( (xd%VxSq/(n+1)) - (xd%MeanVxVyVz**2) ) - ! xd%TIVx = (TEMPSTD / xd%MeanVxVyVz ) ! check inflow noise input for multiplication with 100 or not - - m%speccou= m%speccou+1 - IF( (p%TICalcMeth.eq.2) ) THEN + + !! Cumulative mean and standard deviation, states are updated as Vx Vy Vz changes at each time step + !TEMPSTD = sqrt( u%Inflow(1,:,:)**2+u%Inflow(2,:,:)**2+u%Inflow(3,:,:)**2 ) + !xd%MeanVxVyVz = (TEMPSTD + xd%MeanVxVyVz*n) / (n+1) + !! xd%VxSq = TEMPSTD**2 + xd%VxSq + !! TEMPSTD = sqrt( (xd%VxSq/(n+1)) - (xd%MeanVxVyVz**2) ) + !! xd%TIVx = (TEMPSTD / xd%MeanVxVyVz ) ! check inflow noise input for multiplication with 100 or not + + + IF( p%TICalcMeth == TICalc_Every ) THEN + call Calc_LE_Location_Array(p,m,u) ! sets m%LE_Location(:,:,:) + do i=1,p%NumBlades do j=1,p%NumBlNds abs_le_x=m%LE_Location(3,j,i)-p%hubheight - IF ((abs_le_x.lt.0).and.(m%LE_Location(2,j,i).lt.0)) THEN - angletemp=180+ATAN( ABS( m%LE_Location(2,j,i)/abs_le_x ) ) * R2D_D - ELSEIF ((abs_le_x.lt.0).and.(m%LE_Location(2,j,i).gt.0)) THEN - angletemp=180-ATAN( ABS( m%LE_Location(2,j,i)/abs_le_x ) ) * R2D_D - ELSEIF ((abs_le_x.gt.0).and.(m%LE_Location(2,j,i).lt.0)) THEN - angletemp=360-ATAN( ABS( m%LE_Location(2,j,i)/abs_le_x ) ) * R2D_D - ELSEIF ((abs_le_x.gt.0).and.(m%LE_Location(2,j,i).gt.0)) THEN - angletemp=ATAN( m%LE_Location(2,j,i)/abs_le_x ) * R2D_D - ELSE - CALL WrScr( 'problem in angletemp Aeroacoustics module' ) - ENDIF - !abs_le_x=ABS(abs_le_x) - do k=1,size(p%rotorregionlimitsrad) - IF (p%BlSpn(j,i)-p%rotorregionlimitsrad(k).lt.0) THEN ! it means location is in the k-1 region - !print*, abs_le_x,p%rotorregionlimitsrad(k),k-1 - GOTO 4758 - ENDIF - enddo - 4758 do rco=1,size(p%rotorregionlimitsalph) - IF (angletemp-p%rotorregionlimitsalph(rco).lt.0) THEN ! it means location is in the k-1 region - GOTO 9815 - ENDIF - enddo - 9815 xd%allregcounter(k-1,rco-1)=CEILING(xd%allregcounter(k-1,rco-1)+1.0_Reki) ! increase the sample amount in that specific 5 meter height vertical region - tempsingle = sqrt( u%Inflow(1,j,i)**2+u%Inflow(2,j,i)**2+u%Inflow(3,j,i)**2 ) ! + + if (EqualRealNos(abs_le_x, 0.0_ReKi)) then + rco_minus1 = 1 + else + angletemp = ATAN2(m%LE_Location(2,j,i), abs_le_x) * R2D ! returns angles in the range [-180, 180] degrees + if (angletemp<0.) angletemp = angletemp + 360. ! in calculation for rco_minus1 below, we compare angles in the range [0, 360] degrees + rco_minus1 = ceiling(angletemp / RotorRegionAlph_delta) + rco_minus1 = MIN( p%NumRotorRegionLimitsAlph-1, MAX(1, rco_minus1) ) ! safety + end if + + k_minus1 = p%RotorRegion_k_minus1(j,i) + + OtherState%allregcounter(k_minus1,rco_minus1) = OtherState%allregcounter(k_minus1,rco_minus1) + 1 ! increase the sample amount in that specific bin + + InflowNorm = TwoNorm( u%Inflow(:,j,i) ) + !note: p%Num_total_sampleTI = size(xd%RegVxStor,1) ! with storage region dependent moving average and TI - IF (INT(xd%allregcounter(k-1,rco-1)) .lt. (size(xd%RegVxStor,1)+1)) THEN - xd%RegVxStor(INT(xd%allregcounter(k-1,rco-1)),k-1,rco-1)=tempsingle - xd%TIVx(j,i) = 0 - xd%RegionTIDelete(k-1,rco-1)=0 + IF ( OtherState%allregcounter(k_minus1,rco_minus1) <= p%Num_total_sampleTI ) THEN + xd%RegVxStor(OtherState%allregcounter(k_minus1,rco_minus1),k_minus1,rco_minus1) = InflowNorm + xd%TIVx(j,i) = 0 ELSE - xd%RegVxStor((mod(INT(xd%allregcounter(k-1,rco-1))-size(xd%RegVxStor,1),size(xd%RegVxStor,1)))+1,k-1,rco-1)=tempsingle - tempmean=SUM(xd%RegVxStor(:,k-1,rco-1)) - tempmean=tempmean/size(xd%RegVxStor,1) - xd%RegionTIDelete(k-1,rco-1)=SQRT((SUM((xd%RegVxStor(:,k-1,rco-1)-tempmean)**2)) / size(xd%RegVxStor,1) ) - xd%TIVx(j,i) = xd%RegionTIDelete(k-1,rco-1) ! only the fluctuation + xd%RegVxStor( mod( OtherState%allregcounter(k_minus1,rco_minus1), p%Num_total_sampleTI )+1, k_minus1, rco_minus1)=InflowNorm + meanInflow = SUM( xd%RegVxStor(:,k_minus1,rco_minus1) ) /p%Num_total_sampleTI + + if ( EqualRealNos(meanInflow,0.0_ReKi)) then + xd%TIVx(j,i) = 0.0_ReKi + else + xd%TIVx(j,i) = SQRT( SUM((xd%RegVxStor(:,k_minus1,rco_minus1)-meanInflow)**2) / p%Num_total_sampleTI ) ! only the fluctuation (this is the population standard deviation, not TI) + xd%TIVx(j,i) = xd%TIVx(j,i) / meanInflow ! this is TI as a fraction (std(U)/mean(U)) + end if ENDIF enddo enddo @@ -728,39 +653,55 @@ subroutine AA_UpdateStates( t, n, m, u, p, xd, errStat, errMsg ) do j=1,p%NumBlNds ! We scale the incident turbulence intensity by the ratio of average to incident wind speed ! The scaled TI is used by the Amiet model - xd%TIVx(j,i)=p%TI*p%avgV/u%Vrel(J,I) + xd%TIVx(j,i)=p%TI * p%avgV/u%Vrel(J,I) enddo enddo endif + end subroutine AA_UpdateStates !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. -subroutine AA_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +subroutine AA_End( u, p, xd, OtherState, y, m, ErrStat, ErrMsg ) TYPE(AA_InputType), INTENT(INOUT) :: u !< System inputs TYPE(AA_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(AA_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states + !TYPE(AA_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states TYPE(AA_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states - TYPE(AA_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states + !TYPE(AA_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states TYPE(AA_OtherStateType), INTENT(INOUT) :: OtherState !< Other states TYPE(AA_OutputType), INTENT(INOUT) :: y !< System outputs TYPE(AA_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - ! Initialize ErrStat + + integer(IntKi) :: j + + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" - ! Destroy the input data: - CALL AA_DestroyInput( u, ErrStat, ErrMsg ) - ! Destroy the parameter data: - CALL AA_DestroyParam( p, ErrStat, ErrMsg ) - ! Destroy the state data: - CALL AA_DestroyContState( x, ErrStat, ErrMsg ) - CALL AA_DestroyDiscState( xd, ErrStat, ErrMsg ) - CALL AA_DestroyConstrState( z, ErrStat, ErrMsg ) - CALL AA_DestroyOtherState( OtherState, ErrStat, ErrMsg ) - CALL AA_DestroyMisc( m, ErrStat, ErrMsg ) - ! Destroy the output data: - CALL AA_DestroyOutput( y, ErrStat, ErrMsg ) + + + do j=1,SIZE(p%unOutFile) + if (p%unOutFile(j) > 0) then + close(p%unOutFile(j)) + p%unOutFile(j) = -1 + end if + end do + + + !! Destroy the input data: + !CALL AA_DestroyInput( u, ErrStat, ErrMsg ) + ! + !! Destroy the parameter data: + !CALL AA_DestroyParam( p, ErrStat, ErrMsg ) + ! + !! Destroy the state data: + !CALL AA_DestroyContState( x, ErrStat, ErrMsg ) + !CALL AA_DestroyDiscState( xd, ErrStat, ErrMsg ) + !CALL AA_DestroyConstrState( z, ErrStat, ErrMsg ) + !CALL AA_DestroyOtherState( OtherState, ErrStat, ErrMsg ) + !CALL AA_DestroyMisc( m, ErrStat, ErrMsg ) + !! Destroy the output data: + !CALL AA_DestroyOutput( y, ErrStat, ErrMsg ) END SUBROUTINE AA_End @@ -768,7 +709,7 @@ END SUBROUTINE AA_End !! This subroutine is used to compute the output channels (motions and loads) and place them in the WriteOutput() array. !! The descriptions of the output channels are not given here. Please see the included OutListParameters.xlsx sheet for !! for a complete description of each output parameter. -subroutine AA_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg) +subroutine AA_CalcOutput( t, u, p, xd, OtherState, y, m, ErrStat, ErrMsg) ! NOTE: no matter how many channels are selected for output, all of the outputs are calcalated ! All of the calculated output channels are placed into the m%AllOuts(:), while the channels selected for outputs are ! placed in the y%WriteOutput(:) array. @@ -776,9 +717,9 @@ subroutine AA_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg) REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds TYPE(AA_InputType), INTENT(IN ) :: u !< Inputs at Time t TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AA_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t + !TYPE(AA_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t TYPE(AA_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(AA_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t + !TYPE(AA_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t TYPE(AA_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t TYPE(AA_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- type(AA_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables @@ -791,27 +732,66 @@ subroutine AA_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AA_CalcOutput' ErrStat = ErrID_None ErrMsg = "" + ! assume integer divide is possible - call CalcObserve(t,p,m,u,xd,errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (t >= p%AAStart) THEN - IF (mod(t + 1E-10,p%DT) .lt. 1E-6) THEN - call CalcAeroAcousticsOutput(u,p,m,xd,y,errStat2,errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call Calc_WriteOutput( p, u, m, y, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call AA_WriteOutputLine(y, t, p, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + IF (t >= p%AAStart) THEN + + IF (.NOT. AA_OutputToSeparateFile .or. mod(t + 1E-10,p%DT) .lt. 1E-6) THEN !bjj: should check NINT(t/p%DT)? + call CalcObserve(p,m,u,errStat2, errMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName); if (ErrStat >= AbortErrLev) return + + call CalcAeroAcousticsOutput(u,p,m,xd,errStat2,errMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName); if (ErrStat >= AbortErrLev) return + + call Calc_WriteOutput( p, m, y, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName); if (ErrStat >= AbortErrLev) return + + if (AA_OutputToSeparateFile) then + call AA_WriteOutputLine(y, t, p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName); if (ErrStat >= AbortErrLev) return + end if ENDIF + ENDIF + end subroutine AA_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- +REAL(ReKi) FUNCTION Log10AA(X) RESULT(F) + REAL(ReKi),INTENT(IN) :: X + + F = LOG10( MAX(AA_EPSILON, X) ) + +END FUNCTION Log10AA +!----------------------------------------------------------------------------------------------------------------------------------! +SUBROUTINE Calc_LE_Location_Array(p,m,u) + TYPE(AA_ParameterType), intent(in ) :: p !< Parameters + TYPE(AA_InputType), intent(in ) :: u !< NN Inputs at Time + TYPE(AA_MiscVarType), intent(inout) :: m !< misc/optimization data (not defined in submodules) + ! Local variables. + INTEGER(intKi) :: I ! I A generic index for DO loops. + INTEGER(intKi) :: J ! J A generic index for DO loops. + + + ! Loop through the blades + DO I = 1,p%numBlades + ! Loop through the nodes along blade span + DO J = 1,p%NumBlNds + ! Transpose the rotational vector GlobalToLocal to obtain the rotation LocalToGlobal + ! LocalToGlobal = TRANSPOSE(u%RotGtoL(:,:,J,I)) + + ! Rotate the coordinates of leading and trailing edge from the local reference system to the global. Then add the coordinates of the aerodynamic center in the global coordinate system + ! The global coordinate system is located on the ground, has x pointing downwind, y pointing laterally, and z pointing vertically upwards + + !m%LE_Location(:,J,I) = RLEObservereal = MATMUL(LocalToGlobal, p%AFLeCo(:,J,I)) + u%AeroCent_G(:,J,I) + m%LE_Location(:,J,I) = MATMUL(p%AFLeCo(:,J,I), u%RotGtoL(:,:,J,I) ) + u%AeroCent_G(:,J,I) ! = because this is a matrix times a vector, we can do the transpose of the actual equation: MATMUL(TRANSPOSE(u%RotGtoL(:,:,J,I)), p%AFLeCo(:,J,I)) + u%AeroCent_G(:,J,I) + + ENDDO !J, blade nodes + ENDDO !I , number of blades + +END SUBROUTINE Calc_LE_Location_Array !----------------------------------------------------------------------------------------------------------------------------------! -SUBROUTINE CalcObserve(t,p,m,u,xd,errStat,errMsg) - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(AA_DiscreteStateType), INTENT(IN ) :: xd !< discrete state type +SUBROUTINE CalcObserve(p,m,u,errStat,errMsg) TYPE(AA_ParameterType), intent(in ) :: p !< Parameters TYPE(AA_InputType), intent(in ) :: u !< NN Inputs at Time TYPE(AA_MiscVarType), intent(inout) :: m !< misc/optimization data (not defined in submodules) @@ -823,10 +803,6 @@ SUBROUTINE CalcObserve(t,p,m,u,xd,errStat,errMsg) REAL(ReKi) :: RTEObserveG (3) ! Position vector from trailing edge to observer in the coordinate system located at the trailing edge and rotated as the global REAL(ReKi) :: RLEObserveG (3) ! Position vector from leading edge to observer in the coordinate system located at the leading edge and rotated as the global REAL(ReKi) :: RTEObservereal (3) ! Location of trailing edge in global coordinate system - REAL(ReKi) :: RLEObservereal (3) ! Location of leading edge in global coordinate system - REAL(ReKi) :: LocalToGlobal(3,3) ! Transformation matrix - REAL(ReKi) :: timeLE ! Time of sound propagation from leading edge to observer - REAL(ReKi) :: timeTE ! Time of sound propagation from trailing edge to observer REAL(ReKi) :: phi_e ! Spanwise directivity angle REAL(ReKi) :: theta_e ! Chordwise directivity angle INTEGER(intKi) :: I ! I A generic index for DO loops. @@ -838,435 +814,280 @@ SUBROUTINE CalcObserve(t,p,m,u,xd,errStat,errMsg) ErrStat = ErrID_None ErrMsg = "" - ! Loop through the blades - DO I = 1,p%numBlades - ! Loop through the nodes along blade span - DO J = 1,p%NumBlNds - ! Transpose the rotational vector GlobalToLocal to obtain the rotation LocalToGlobal - LocalToGlobal = TRANSPOSE(u%RotGtoL(:,:,J,I)) - ! Rotate the coordinates of leading and trailing edge from the local reference system to the global. Then add the coordinates of the aerodynamic center in the global coordinate system - ! The global coordinate system is located on the ground, has x pointing downwind, y pointing laterally, and z pointing vertically upwards - RTEObservereal = MATMUL(LocalToGlobal, p%AFTeCo(:,J,I)) + u%AeroCent_G(:,J,I) - RLEObservereal = MATMUL(LocalToGlobal, p%AFLeCo(:,J,I)) + u%AeroCent_G(:,J,I) - ! Compute the coordinates of the leading edge in the global coordinate system - m%LE_Location(1,J,I) = RLEObservereal(1) - m%LE_Location(2,J,I) = RLEObservereal(2) - m%LE_Location(3,J,I) = RLEObservereal(3) - ! If the time step is set to generate AA outputs - IF (t >= p%AAStart) THEN - IF ( mod(t + 1E-10,p%DT) .lt. 1E-6) THEN - ! Loop through the observers - DO K = 1,p%NrObsLoc - ! Calculate the position of the observer K in a reference system located at the trailing edge and oriented as the global reference system - RTEObserveG(1)=p%Obsx(K)-RTEObservereal(1) - RTEObserveG(2)=p%Obsy(K)-RTEObservereal(2) - RTEObserveG(3)=p%Obsz(K)-RTEObservereal(3) - ! Calculate the position of the observer K in a reference system located at the leading edge and oriented as the global reference system - RLEObserveG(1)=p%Obsx(K)-RLEObservereal(1) - RLEObserveG(2)=p%Obsy(K)-RLEObservereal(2) - RLEObserveG(3)=p%Obsz(K)-RLEObservereal(3) - ! Rotate back the two reference systems from global to local. - RTEObserve = MATMUL(u%RotGtoL(:,:,J,I), RTEObserveG) - RLEObserve = MATMUL(u%RotGtoL(:,:,J,I), RLEObserveG) - - ! Calculate absolute distance between node and observer - m%rTEtoObserve(K,J,I) = SQRT (RTEObserve(1)**2+RTEObserve(2)**2+RTEObserve(3)**2) - m%rLEtoObserve(K,J,I) = SQRT (RLEObserve(1)**2+RLEObserve(2)**2+RLEObserve(3)**2) - - ! Calculate time of noise propagation to observer - timeTE = m%rTEtoObserve(K,J,I) / p%SpdSound - timeLE = m%rLEtoObserve(K,J,I) / p%SpdSound + + call Calc_LE_Location_Array(p,m,u) ! sets m%LE_Location(:,:,:) + + ! Loop through the blades + DO I = 1,p%numBlades + ! Loop through the nodes along blade span + DO J = 1,p%NumBlNds + ! Rotate the coordinates of leading and trailing edge from the local reference system to the global. Then add the coordinates of the aerodynamic center in the global coordinate system + ! The global coordinate system is located on the ground, has x pointing downwind, y pointing laterally, and z pointing vertically upwards + RTEObservereal = MATMUL(p%AFTeCo(:,J,I), u%RotGtoL(:,:,J,I)) + u%AeroCent_G(:,J,I) ! Note that with the vector math, this is equivalent to MATMUL(TRANSPOSE(p%RotGtoL(:,:,J,I)), p%AFTeCo(:,J,I)) + u%AeroCent_G(:,J,I) + + ! Loop through the observers + DO K = 1,p%NrObsLoc + + RTEObserveG=p%ObsXYZ(:,K)-RTEObservereal ! Calculate the position of the observer K in a reference system located at the trailing edge and oriented as the global reference system + RLEObserveG=p%ObsXYZ(:,K)-m%LE_Location(:,J,I) ! Calculate the position of the observer K in a reference system located at the leading edge and oriented as the global reference system + ! Rotate back the two reference systems from global to local. + RTEObserve = MATMUL(u%RotGtoL(:,:,J,I), RTEObserveG) + RLEObserve = MATMUL(u%RotGtoL(:,:,J,I), RLEObserveG) + + ! Calculate absolute distance between node and observer + m%rTEtoObserve(K,J,I) = max(AA_Epsilon, TwoNorm(RTEObserve) ) + m%rLEtoObserve(K,J,I) = max(AA_Epsilon, TwoNorm(RLEObserve) ) + + ! Calculate time of noise propagation to observer + !timeTE = m%rTEtoObserve(K,J,I) / p%SpdSound + !timeLE = m%rLEtoObserve(K,J,I) / p%SpdSound - ! The local system has y alinged with the chord, x pointing towards the airfoil suction side, and z aligned with blade span from root towards tip - ! x ---> z_e - ! y ---> x_e - ! z ---> y_e - - ! Compute spanwise directivity angle phi for the trailing edge - phi_e = ATAN2 (RTEObserve(1) , RTEObserve(3)) - m%SpanAngleTE(K,J,I) = phi_e * R2D - - ! Compute chordwise directivity angle theta for the trailing edge - theta_e = ATAN2 ((RTEObserve(3) * COS (phi_e) + RTEObserve(1) * SIN (phi_e) ) , RTEObserve(2)) - m%ChordAngleTE(K,J,I) = theta_e * R2D + ! The local system has y alinged with the chord, x pointing towards the airfoil suction side, and z aligned with blade span from root towards tip + ! x ---> z_e + ! y ---> x_e + ! z ---> y_e + + ! Compute spanwise directivity angle phi for the trailing edge + phi_e = ATAN2 (RTEObserve(1) , RTEObserve(3)) + m%SpanAngleTE(K,J,I) = phi_e * R2D + + ! Compute chordwise directivity angle theta for the trailing edge + theta_e = ATAN2 ((RTEObserve(3) * COS (phi_e) + RTEObserve(1) * SIN (phi_e) ) , RTEObserve(2)) + m%ChordAngleTE(K,J,I) = theta_e * R2D - ! Compute spanwise directivity angle phi for the leading edge (it's the same angle for the trailing edge) - phi_e = ATAN2 (RLEObserve(1) , RLEObserve(3)) - m%SpanAngleLE(K,J,I) = phi_e * R2D + ! Compute spanwise directivity angle phi for the leading edge (it's the same angle for the trailing edge) + phi_e = ATAN2 (RLEObserve(1) , RLEObserve(3)) + m%SpanAngleLE(K,J,I) = phi_e * R2D - ! Compute chordwise directivity angle theta for the leading edge - theta_e = ATAN2 ((RLEObserve(3) * COS (phi_e) + RLEObserve(1) * SIN (phi_e) ) , RLEObserve(2)) - m%ChordAngleLE(K,J,I) = theta_e * R2D + ! Compute chordwise directivity angle theta for the leading edge + theta_e = ATAN2 ((RLEObserve(3) * COS (phi_e) + RLEObserve(1) * SIN (phi_e) ) , RLEObserve(2)) + m%ChordAngleLE(K,J,I) = theta_e * R2D + + ENDDO !K, observers + ENDDO !J, blade nodes + ENDDO !I , number of blades - ENDDO !K, observers - ENDIF ! every Xth time step or so.. - ENDIF ! only if the time step is more than user input value run this part - ENDDO !J, blade nodes - ENDDO !I , number of blades END SUBROUTINE CalcObserve !----------------------------------------------------------------------------------------------------------------------------------! -SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) - TYPE(AA_InputType), INTENT(IN ) :: u !< Inputs at Time t - TYPE(AA_OutputType), INTENT(INOUT) :: y !< - TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters +SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,errStat,errMsg) + TYPE(AA_InputType), INTENT(IN ) :: u !< Inputs at Time t + TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(AA_MiscVarType), INTENT(INOUT) :: m !< misc/optimization data (not defined in submodules) TYPE(AA_DiscreteStateType), INTENT(IN ) :: xd !< discrete state type - integer(IntKi), INTENT( OUT) :: errStat !< Error status of the operation - character(*), INTENT( OUT) :: errMsg !< Error message if ErrStat /= ErrID_None + integer(IntKi), INTENT( OUT) :: errStat !< Error status of the operation + character(*), INTENT( OUT) :: errMsg !< Error message if ErrStat /= ErrID_None ! Local variables. - integer(intKi) :: III !III A generic index for DO loops. - integer(intKi) :: I !I A generic index for DO loops. - integer(intKi) :: J !J A generic index for DO loops. - integer(intKi) :: K !,liop,cou ,JTEMP !K A generic index for DO loops. - integer(intKi) :: oi !K A generic index for DO loops. - REAL(ReKi) :: AlphaNoise ! - REAL(ReKi) :: UNoise ! - REAL(ReKi) :: elementspan ! -! REAL(ReKi),DIMENSION(p%NumBlNds) ::tempdel -! REAL(ReKi),DIMENSION(p%NrObsLoc,p%NumBlNds,p%numBlades) ::OASPLTBLAll - REAL(ReKi),DIMENSION(p%NrObsLoc,p%NumBlNds,p%numBlades,size(p%FreqList)) ::ForMaxLoc - REAL(ReKi),DIMENSION(size(y%OASPL_Mech,1),size(p%FreqList),p%NrObsLoc,p%NumBlNds,p%numBlades) :: ForMaxLoc3 -! REAL(ReKi),DIMENSION(size(p%FreqList),p%NrObsLoc,p%numBlades) ::SPL_Out - REAL(ReKi),DIMENSION(p%NumBlNds,p%numBlades) ::temp_dispthick - REAL(ReKi),DIMENSION(p%NumBlNds,p%numBlades) ::temp_dispthickchord - - real(ReKi) :: Ptotal - real(ReKi) :: PtotalLBL - real(ReKi) :: PtotalTBLP - real(ReKi) :: PtotalTBLS - real(ReKi) :: PtotalSep - real(ReKi) :: PtotalTBLAll - real(ReKi) :: PtotalBlunt - real(ReKi) :: PtotalTip - real(ReKi) :: PtotalInflow - real(ReKi) :: PLBL - real(ReKi) :: PTBLP - real(ReKi) :: PTBLS - real(ReKi) :: PTBLALH - real(ReKi) :: PTip - real(ReKi) :: PTI - real(ReKi) :: PBLNT !,adforma -! REAL(ReKi),DIMENSION(2) :: Cf ,d99, d_star -! TYPE(FFT_DataType) :: FFT_Data !< the instance of the FFT module we're using -! REAL(ReKi),DIMENSION(p%total_sample) :: spect_signal -! REAL(ReKi),DIMENSION(p%total_sample/2) :: spectra -! real(ReKi),ALLOCATABLE :: fft_freq(:) - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'CalcAeroAcousticsOutput' - + integer(intKi) :: III ! III A generic index for DO loops (frequency) + integer(intKi) :: I ! I A generic index for DO loops (blade) + integer(intKi) :: J ! J A generic index for DO loops (blade node) + integer(intKi) :: K ! K A generic index for DO loops (NrObsLoc) + integer(intKi) :: oi ! oi A generic index for DO loops (NoiseMechanism) + REAL(ReKi) :: AlphaNoise + REAL(ReKi) :: AlphaNoise_Deg ! + REAL(ReKi) :: UNoise ! + + real(ReKi) :: Ptotal + character(*), parameter :: RoutineName = 'CalcAeroAcousticsOutput' + ErrStat = ErrID_None ErrMsg = "" - !------------------- Fill with zeros -------------------------! - DO I = 1,p%numBlades;DO J = 1,p%NumBlNds;DO K = 1,p%NrObsLoc; - y%OASPL(k,j,i) = 0.0_Reki - DO oi=1,size(y%OASPL_Mech,1) - y%OASPL_Mech(oi,k,j,i)= 0.0_Reki - ENDDO; - ENDDO;ENDDO;ENDDO - - DO K = 1,p%NrObsLoc; - y%DirectiviOutput(K) = 0.0_Reki - DO I=1,p%NumBlades;DO III=1,size(p%FreqList); - y%SumSpecNoise(III,K,I) = 0.0_Reki - ForMaxLoc(K,1:p%NumBlNds,I,III)=0.0_Reki - DO oi=1,size(y%OASPL_Mech,1) - y%SumSpecNoiseSep(oi,K,III) = 0.0_Reki - ForMaxLoc3(oi,III,K,1:p%NumBlNds,I)=0.0_Reki - m%SPLLBL(III)=0.0_Reki - m%SPLP(III)=0.0_Reki - m%SPLS(III)=0.0_Reki - m%SPLALPH(III)=0.0_Reki - m%SPLBLUNT(III)=0.0_Reki - m%SPLTIP(III)=0.0_Reki - m%SPLti(III)=0.0_Reki - ENDDO - ENDDO;ENDDO - ENDDO - - DO K = 1,p%NrObsLoc; - DO III = 1,size(p%FreqList); - y%PtotalFreq(K,III) = 0.0_ReKi - ENDDO - ENDDO + !------------------- Initialize arrays with zeros -------------------------! + ! values for WriteOutput + m%OASPL = 0.0_Reki + m%DirectiviOutput = 0.0_Reki + m%SumSpecNoiseSep = 0.0_Reki + !---------------- + m%SPLLBL=0.0_Reki + m%SPLP=0.0_Reki + m%SPLS=0.0_Reki + m%SPLALPH=0.0_Reki + m%SPLBLUNT=0.0_Reki + m%SPLTIP=0.0_Reki + m%SPLti=0.0_Reki + + + DO I = 1,p%numBlades + DO J = p%startnode,p%NumBlNds ! starts loop from startnode. + !------------------------------!!------------------------------!!------------------------------!!------------------------------! + + Unoise = u%Vrel(J,I) + IF (abs(Unoise) < AA_u_min) then + Unoise = SIGN(AA_u_min, Unoise) + ENDIF + + AlphaNoise= u%AoANoise(J,I) + call MPi2Pi(AlphaNoise) ! make sure this is in an appropriate range [-pi,pi] + AlphaNoise_Deg = AlphaNoise * R2D_D ! convert to degrees since that is how this code is set up. - !------------------- initialize FFT -------------------------! - !!!IF (m%speccou .eq. p%total_sample)THEN - !!!CALL InitFFT ( p%total_sample, FFT_Data, ErrStat=ErrStat2 ) - !!! CALL SetErrStat(ErrStat2, 'Error in InitFFT', ErrStat, ErrMsg, 'CalcAeroAcousticsOutput' ) - !!!CALL AllocAry( fft_freq, size(spect_signal)/2-1, 'fft_freq', ErrStat2, ErrMsg2 ) - !!! CALL SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - !!!do liop=1,size(fft_freq) - !!! fft_freq(liop)=p%fsample*liop ! fRequncy x axis - !!! fft_freq(liop)=fft_freq(liop)/size(spect_signal) - !!!enddo - !!!ENDIF + !--------Read in Boundary Layer Data-------------------------! + IF (p%X_BLMethod .EQ. X_BLMethod_Tables) THEN + call BL_Param_Interp(p, m, Unoise, AlphaNoise_Deg, p%BlChord(J,I), p%BlAFID(J,I)) + m%d99Var = m%d99Var*p%BlChord(J,I) + m%dstarVar = m%dstarVar*p%BlChord(J,I) + ENDIF - - DO I = 1,p%numBlades - DO J = p%startnode,p%NumBlNds ! starts loop from startnode. !------------------------------!!------------------------------!!------------------------------!!------------------------------! !------------------------------!!------------------------------!!------------------------------!!------------------------------! !------------------------------!!------------------------------!!------------------------------!!------------------------------! - !--------Calculate Spectrum for dissipation calculation-------------------------! - !IF (m%speccou .eq. p%total_sample)THEN - !spect_signal=xd%VrelStore( 1:p%total_sample,J,I ) - ! CALL ApplyFFT_f( spect_signal, FFT_Data, ErrStat2 ) - ! IF (ErrStat2 /= ErrID_None ) THEN - ! CALL SetErrStat(ErrStat2, 'Error in ApplyFFT .', ErrStat, ErrMsg, 'CalcAeroAcousticsOutput' ) - ! ENDIF - !cou=1 - !O liop=2,size(spect_signal)-1,2 - !cou=cou+1 - !spectra(cou) = spect_signal(liop)*spect_signal(liop) + spect_signal(1+liop)*spect_signal(1+liop) - !ENDDO - !spectra(1)=spect_signal(1)*spect_signal(1) - !spectra=spectra/(size(spectra)*2) - ! m%speccou=0 - !ENDIF - - Unoise = u%Vrel(J,I) - IF (EqualRealNos(Unoise,0.0_ReKi)) then - Unoise = 0.1 ! TODO TODO a value consistent with the test above should be used + DO K = 1,p%NrObsLoc + Ptotal = 0.0_ReKi ! Total Sound Pressure - All (7) mechanisms, All Frequencies + + !--------Laminar Boundary Layer Vortex Shedding Noise----------------------------! + IF ( (p%ILAM .EQ. ILAM_BPM) .AND. (p%ITRIP .EQ. ITRIP_None) ) THEN + CALL LBLVS(AlphaNoise_Deg,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & + p%BlElemSpn(J,I),m%rTEtoObserve(K,J,I), p,m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLLBL,p%StallStart(J,I)) + + call TotalContributionFromType(m%SPLLBL,Ptotal,NoiseMech=1) + ENDIF + + !--------Turbulent Boundary Layer Trailing Edge Noise----------------------------! + IF ( p%ITURB /= ITURB_None ) THEN + !returns m%SPLP, m%SPLS, m%SPLALPH + CALL TBLTE(AlphaNoise_Deg,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & + p%BlElemSpn(J,I),m%rTEtoObserve(K,J,I), p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),p%StallStart(J,I), & + m%SPLP,m%SPLS,m%SPLALPH ) + + IF (p%ITURB .EQ. ITURB_TNO) THEN + m%EdgeVelVar=1.0_ReKi + !returns m%SPLP, m%SPLS from TBLTE + CALL TBLTE_TNO(UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & + p%BlElemSpn(J,I),m%rTEtoObserve(K,J,I),m%CfVar,m%d99var,m%EdgeVelVar ,p, & + m%SPLP,m%SPLS) + ENDIF + + ! If flag for TBL is ON, compute Pressure, Suction, and AoA contributions + call TotalContributionFromType(m%SPLP,Ptotal,NoiseMech=2) + call TotalContributionFromType(m%SPLS,Ptotal,NoiseMech=3) + call TotalContributionFromType(m%SPLALPH,Ptotal,NoiseMech=4) ENDIF - IF (J .EQ. p%NumBlNds) THEN - elementspan = (p%BlSpn(J,I)-p%BlSpn(J-1,I))/2 - ELSE - elementspan = (p%BlSpn(J,I)-p%BlSpn(J-1,I))/2 + (p%BlSpn(J+1,I)-p%BlSpn(J,I))/2 + + + !--------Blunt Trailing Edge Noise----------------------------------------------! + IF ( p%IBLUNT == IBLUNT_BPM ) THEN ! calculate m%SPLBLUNT(1:nFreq) + CALL BLUNT(AlphaNoise_Deg,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & + p%BlElemSpn(J,I),m%rTEtoObserve(K,J,I),p%TEThick(J,I),p%TEAngle(J,I), & + p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLBLUNT,p%StallStart(J,I) ) + + call TotalContributionFromType(m%SPLBLUNT,Ptotal,NoiseMech=5) ENDIF - AlphaNoise= u%AoANoise(J,I) * R2D_D - - - !--------Read in Boundary Layer Data-------------------------! - IF (p%X_BLMethod .EQ. X_BLMethod_Tables) THEN - call BL_Param_Interp(p,m,Unoise,AlphaNoise,p%BlChord(J,I),p%BlAFID(J,I), errStat2, errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - temp_dispthick(J,I) = m%d99Var(1) - m%d99Var = m%d99Var*p%BlChord(J,I) - m%dstarVar = m%dstarVar*p%BlChord(J,I) - temp_dispthickchord(J,I)=m%d99Var(1) + + + !--------Tip Noise--------------------------------------------------------------! + IF ( (p%ITIP == ITIP_ON) .AND. (J .EQ. p%NumBlNds) ) THEN ! calculate m%SPLTIP(1:nFreq) + CALL TIPNOIS(AlphaNoise_Deg,p%ALpRAT,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & + m%rTEtoObserve(K,J,I), p, m%SPLTIP) + + ! If flag for Tip is ON and the current blade node (J) is the last node (tip), compute Tip contribution + call TotalContributionFromType(m%SPLTIP,Ptotal,NoiseMech=6) ENDIF - !------------------------------!!------------------------------!!------------------------------!!------------------------------! - !------------------------------!!------------------------------!!------------------------------!!------------------------------! - !------------------------------!!------------------------------!!------------------------------!!------------------------------! - DO K = 1,p%NrObsLoc - !--------Laminar Boundary Layer Vortex Shedding Noise----------------------------! - IF ( (p%ILAM .EQ. 1) .AND. (p%ITRIP .EQ. 0) ) THEN - CALL LBLVS(AlphaNoise,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & - elementspan,m%rTEtoObserve(K,J,I), & - p,m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLLBL,p%StallStart(J,I),errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ENDIF - !--------Turbulent Boundary Layer Trailing Edge Noise----------------------------! - IF ( (p%ITURB .EQ. 1) .or. (p%ITURB .EQ. 2) ) THEN - CALL TBLTE(AlphaNoise,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & - elementspan,m%rTEtoObserve(K,J,I), p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),p%StallStart(J,I), & - m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,errStat2,errMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (p%ITURB .EQ. 2) THEN - m%SPLP=0.0_ReKi;m%SPLS=0.0_ReKi;m%SPLTBL=0.0_ReKi; - m%EdgeVelVar(1)=1.000d0;m%EdgeVelVar(2)=m%EdgeVelVar(1); - CALL TBLTE_TNO(UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & - elementspan,m%rTEtoObserve(K,J,I),m%CfVar,m%d99var,m%EdgeVelVar ,p, & - m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,errStat2 ,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ENDIF - ENDIF - !--------Blunt Trailing Edge Noise----------------------------------------------! - IF ( p%IBLUNT .EQ. 1 ) THEN - CALL BLUNT(AlphaNoise,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & - elementspan,m%rTEtoObserve(K,J,I),p%TEThick(J,I),p%TEAngle(J,I), & - p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLBLUNT,p%StallStart(J,I),errStat2,errMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ENDIF - !--------Tip Noise--------------------------------------------------------------! - IF ( (p%ITIP .EQ. 1) .AND. (J .EQ. p%NumBlNds) ) THEN - CALL TIPNOIS(AlphaNoise,p%ALpRAT,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & - m%rTEtoObserve(K,J,I), p, m%SPLTIP,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ENDIF - !--------Inflow Turbulence Noise ------------------------------------------------! - ! important checks to be done inflow tubulence inputs - IF (p%IInflow.gt.0) then - - ! Amiet's Inflow Noise Model is Calculated as long as InflowNoise is On - CALL InflowNoise(AlphaNoise,p%BlChord(J,I),Unoise,m%ChordAngleLE(K,J,I),m%SpanAngleLE(K,J,I),& - elementspan,m%rLEtoObserve(K,J,I),xd%TIVx(J,I),p,m%SPLti,errStat2,errMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! If Guidati model (simplified or full version) is also on then the 'SPL correction' to Amiet's model will be added - IF ( p%IInflow .EQ. 2 ) THEN - CALL Simple_Guidati(UNoise,p%BlChord(J,I),p%AFThickGuida(2,p%BlAFID(J,I)), & - p%AFThickGuida(1,p%BlAFID(J,I)),p,m%SPLTIGui,errStat2,errMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - m%SPLti=m%SPLti+m%SPLTIGui + 10. ! +10 is fudge factor to match NLR data - ELSEIF ( p%IInflow .EQ. 3 ) THEN - CALL WrScr('Full Guidati removed') - STOP - ENDIF - ENDIF - !----------------------------------------------------------------------------------------------------------------------------------! - ! ADD IN THIS SEGMENT'S CONTRIBUTION ON A MEAN-SQUARE - ! PRESSURE BASIS - !----------------------------------------------------------------------------------------------------------------------------------! - Ptotal = 0.0_ReKi ! Total Sound Pressure - All (7) mechanisms, All Frequencies - PtotalLBL= 0.0_ReKi ! Total Sound Pressure - Laminar Boundary Layer, All Frequencies - PtotalTBLP= 0.0_ReKi ! Total Sound Pressure - Turbulent Boundary Layer, Pressure Contribution, All Frequencies - PtotalTBLS= 0.0_ReKi ! Total Sound Pressure - Turbulent Boundary Layer, Suction Contribution, All Frequencies - PtotalSep= 0.0_ReKi ! Total Sound Pressure - Separation, All Frequencies - PtotalTBLAll = 0.0_ReKi ! Total Sound Pressure - Turbulent Boundary Layer, All Frequencies - PtotalBlunt= 0.0_ReKi ! Total Sound Pressure - Blunt Trailing Edge, All Frequencies - PtotalTip= 0.0_ReKi ! Total Sound Pressure - Tip Noise, All Frequencies - PtotalInflow= 0.0_ReKi ! Total Sound Pressure - Turbulent Inflow, All Frequencies - PLBL= 0.0_ReKi ! Laminar Boundary Layer - Current Iteration - PTBLP= 0.0_ReKi ! Turbulent Boundary Layer, Pressure Contribution - Current Iteration - PTBLS= 0.0_ReKi ! Turbulent Boundary Layer, Suction Contribution - Current Iteration - PTBLALH= 0.0_ReKi ! Turbulent Boundary Layer, Angle of Attack Contribution - Current Iteration (Feeds into PTotalSep. Consider renaming.) - PTip= 0.0_ReKi ! Tip Noise - Current Iteration - PTI= 0.0_ReKi ! Turbulent Inflow - Current Iteration - PBLNT= 0.0_ReKi ! Blunt Trailing Edge - Current Iteration + + !--------Inflow Turbulence Noise ------------------------------------------------! + ! important checks to be done inflow tubulence inputs + IF (p%IInflow /= IInflow_None) then - - DO III=1,size(p%FreqList) ! Loops through each 1/3rd octave center frequency - - ! If flag for LBL is ON and Boundary Layer Trip is OFF, then compute LBL - IF ( (p%ILAM .EQ. 1) .AND. (p%ITRIP .EQ. 0) ) THEN - IF (p%AweightFlag .eqv. .TRUE.) THEN - m%SPLLBL(III) = m%SPLLBL(III) + p%Aweight(III) ! A-weighting - ENDIF - - PLBL = 10.0_ReKi**(m%SPLLBL(III)/10.0_ReKi) ! SPL to Sound Pressure (P) Conversion for III Frequency - - PtotalLBL = PtotalLBL + PLBL ! Sum of Current LBL with LBL Running Total - Ptotal = Ptotal + PLBL ! Sum of Current LBL with Overall Running Total - y%PtotalFreq(K,III) = y%PtotalFreq(K,III) + PLBL ! Running sum of observer and frequency dependent sound pressure - - y%SumSpecNoiseSep(1,K,III) = PLBL + y%SumSpecNoiseSep(1,K,III) ! Assigns Current LBL to Appropriate Mechanism (1), Observer (K), and Frequency (III) - ENDIF - - ! If flag for TBL is ON, compute Pressure, Suction, and AoA contributions - IF ( p%ITURB .GT. 0 ) THEN - IF (p%AweightFlag .eqv. .TRUE.) THEN - m%SPLP(III) = m%SPLP(III) + p%Aweight(III) ! A-weighting - m%SPLS(III) = m%SPLS(III) + p%Aweight(III) ! A-weighting - m%SPLALPH(III) = m%SPLALPH(III) + p%Aweight(III) ! A-weighting - ENDIF - - PTBLP = 10.0_ReKi**(m%SPLP(III)/10.0_ReKi) ! SPL to P Conversion for III Frequency - PTBLS = 10.0_ReKi**(m%SPLS(III)/10.0_ReKi) ! SPL to P Conversion for III Frequency - PTBLALH = 10.0_ReKi**(m%SPLALPH(III)/10.0_ReKi) ! SPL to P Conversion for III Frequency - - PtotalTBLP = PtotalTBLP + PTBLP ! Sum of Current TBLP with TBLP Running Total - PtotalTBLS = PtotalTBLS + PTBLS ! Sum of Current TBLS with TBLS Running Total - PtotalSep = PtotalSep + PTBLALH ! Sum of Current TBLALH with TBLALH Running Total - - Ptotal = Ptotal + PTBLP + PTBLS + PTBLALH ! Sum of Current TBL with Overall Running Total - y%PtotalFreq(K,III) = y%PtotalFreq(K,III) + PTBLP + PTBLS + PTBLALH ! Running sum of observer and frequency dependent sound pressure - PtotalTBLAll = PtotalTBLAll + 10.0_ReKi**(m%SPLTBL(III)/10.0_ReKi) ! SPLTBL from comment on line 1794 is the mean-square sum of SPLP, SPLS, and SPLALPH. - ! So this should be equal to PTBLP+PTBLS+TBLALH - y%SumSpecNoiseSep(2,K,III) = PTBLP + y%SumSpecNoiseSep(2,K,III) ! Assigns Current TBLP to Appropriate Mechanism (2), Observer (K), and Frequency (III) - y%SumSpecNoiseSep(3,K,III) = PTBLS + y%SumSpecNoiseSep(3,K,III) ! Assigns Current TBLS to Appropriate Mechanism (2), Observer (K), and Frequency (III) - y%SumSpecNoiseSep(4,K,III) = PTBLALH + y%SumSpecNoiseSep(4,K,III) ! Assigns Current TBLALH to Appropriate Mechanism (2), Observer (K), and Frequency (III) - ENDIF - - ! If flag for Blunt TE is ON, compute Blunt contribution - IF ( p%IBLUNT .GT. 0 ) THEN ! NOTE: .EQ. 1 would be more accurate since only options are 0 and 1 - IF (p%AweightFlag .eqv. .TRUE.) THEN - m%SPLBLUNT(III) = m%SPLBLUNT(III) + p%Aweight(III) ! A-weighting - ENDIF - - PBLNT = 10.0_ReKi**(m%SPLBLUNT(III)/10.0_ReKi) ! SPL to P Conversion for III Frequency - - PtotalBlunt = PtotalBlunt + PBLNT ! Sum of Current Blunt with Blunt Running Total - Ptotal = Ptotal + PBLNT ! Sum of Current Blunt with Overall Running Total - y%PtotalFreq(K,III) = y%PtotalFreq(K,III) + PBLNT ! Running sum of observer and frequency dependent sound pressure - - y%SumSpecNoiseSep(5,K,III) = PBLNT + y%SumSpecNoiseSep(5,K,III) ! Assigns Current Blunt to Appropriate Mechanism (5), Observer (K), and Frequency (III) - ENDIF - - ! If flag for Tip is ON and the current blade node (J) is the last node (tip), compute Tip contribution - IF ( (p%ITIP .GT. 0) .AND. (J .EQ. p%NumBlNds) ) THEN ! NOTE: .EQ. 1 would again be more accurate - IF (p%AweightFlag .eqv. .TRUE.) THEN - m%SPLTIP(III) = m%SPLTIP(III) + p%Aweight(III) ! A-weighting - ENDIF - - PTip = 10.0_ReKi**(m%SPLTIP(III)/10.0_ReKi) ! SPL to P Conversion for III Frequency - - PtotalTip = PtotalTip + PTip ! Sum of Current Tip with Tip Running Total - Ptotal = Ptotal + PTip ! Sum of Current Tip with Overall Running Total - y%PtotalFreq(K,III) = y%PtotalFreq(K,III) + PTip ! Running sum of observer and frequency dependent sound pressure - - y%SumSpecNoiseSep(6,K,III) = PTip + y%SumSpecNoiseSep(6,K,III) ! Assigns Current Tip to Appropriate Mechanism (6), Observer (K), and Frequency (III) - ENDIF - - ! If flag for TI is ON, compute Turbulent Inflow contribution - IF ( (p%IInflow .GT. 0) ) THEN - IF (p%AweightFlag .eqv. .TRUE.) THEN - m%SPLti(III) = m%SPLti(III) + p%Aweight(III) ! A-weighting - ENDIF - - PTI = 10.0_ReKi**(m%SPLti(III)/10.0_ReKi) ! SPL to P Conversion for III Frequency - - PtotalInflow = PtotalInflow + PTI ! Sum of Current TI with TI Running Total - Ptotal = Ptotal + PTI ! Sum of Current TI with Overall Running Total - y%PtotalFreq(K,III) = y%PtotalFreq(K,III) + PTI ! Running sum of observer and frequency dependent sound pressure - - y%SumSpecNoiseSep(7,K,III) = PTI + y%SumSpecNoiseSep(7,K,III) ! Assigns Current TI to Appropriate Mechanism (7), Observer (K), and Frequency (III) - ENDIF + ! Amiet's Inflow Noise Model is Calculated as long as InflowNoise is On + CALL InflowNoise(AlphaNoise,p%BlChord(J,I),Unoise,m%ChordAngleLE(K,J,I),m%SpanAngleLE(K,J,I),& + p%BlElemSpn(J,I),m%rLEtoObserve(K,J,I),xd%TIVx(J,I),p,m%SPLti ) - ENDDO ! III = 1, size(p%FreqList) - - y%DirectiviOutput(K) = Ptotal + y%DirectiviOutput(K) ! Assigns Overall Pressure to Appropriate Observer for Directivity - IF (y%DirectiviOutput(K) .EQ. 0.) y%DirectiviOutput(K) = 1 ! Since these will all be converted via LOG10, they will produce an error if .EQ. 0. - ! Set .EQ. to 1 instead (LOG10(1)=0) - y%OASPL(K,J,I) = Ptotal + y%OASPL(K,J,I) ! Assigns Overall Pressure to Appropriate Observer/Blade/Node for Directivity - ENDDO ! Loop on observers - ENDDO ! Loop on blade nodes - ENDDO ! Loop on blades + ! If Guidati model (simplified or full version) is also on then the 'SPL correction' to Amiet's model will be added + IF ( p%IInflow .EQ. IInflow_FullGuidati ) THEN + CALL Simple_Guidati(UNoise,p%BlChord(J,I),p%AFThickGuida(2,p%BlAFID(J,I)), p%AFThickGuida(1,p%BlAFID(J,I)),p,m%SPLTIGui ) + m%SPLti = m%SPLti+m%SPLTIGui + 10. ! +10 is fudge factor to match NLR data + ELSEIF ( p%IInflow .EQ. IInflow_SimpleGuidati ) THEN + call setErrStat(ErrID_Fatal,'Full Guidati removed',ErrStat, ErrMsg,RoutineName) + return + ENDIF + + call TotalContributionFromType(m%SPLti,Ptotal,NoiseMech=7) ! compute Turbulent Inflow contribution + ENDIF + !m%DirectiviOutput(K) = Ptotal + m%DirectiviOutput(K) ! Assigns Overall Pressure to Appropriate Observer for Directivity + + m%OASPL(K,J,I) = Ptotal + m%OASPL(K,J,I) ! Assigns Overall Pressure to Appropriate Observer/Blade/Node for Directivity + ENDDO ! Loop on observers (K) + + ENDDO ! Loop on blade nodes (J) + ENDDO ! Loop on blades (I) ! If any Output file is wanted, convert DirectiviOutput from Directivity Factor to Directivity Index ! Ref: Fundamentals of Acoustics by Colin Hansen (1951) - y%DirectiviOutput = 10.*LOG10(y%DirectiviOutput) !! DirectiviOutput is used as total observer OASPL for Output File 1 + ! Since these will all be converted via LOG10, they will produce an error if .EQ. 0., Set .EQ. to 1 instead (LOG10(1)=0) - DO I = 1,p%numBlades - DO J = 1,p%NumBlNds - DO K = 1,p%NrObsLoc - IF (y%OASPL(K,J,I) .EQ. 0.) y%OASPL(K,J,I) = 1 - ENDDO - ENDDO - ENDDO - IF (p%NrOutFile .gt. 0) y%OASPL = 10.*LOG10(y%OASPL) !! OASPL is used as observer/blade/node OASPL for Output File 4 + DO K = 1,p%NrObsLoc + m%DirectiviOutput(K) = SUM(m%SumSpecNoiseSep(:,:,K)) + + IF (m%DirectiviOutput(K) .NE. 0.) m%DirectiviOutput(K) = 10.*LOG10(m%DirectiviOutput(K)) !! DirectiviOutput is used as total observer OASPL for Output File 1 + ENDDO ! Loop on observers + + IF (p%NrOutFile .gt. 1) THEN - ! Procedure for Output file 2 - IF (p%NrOutFile .gt. 1) THEN + ! Procedure for Output file 2 DO K = 1,p%NrObsLoc DO III=1,size(p%FreqList) - IF (y%PtotalFreq(K,III) .EQ. 0.) y%PtotalFreq(K,III) = 1 - y%PtotalFreq(K,III) = 10.*LOG10(y%PtotalFreq(K,III)) ! P to SPL conversion + m%PtotalFreq(III,K) = SUM( m%SumSpecNoiseSep(:,III,K) ) + + IF (m%PtotalFreq(III,K) .NE. 0.) m%PtotalFreq(III,K) = 10.*LOG10(m%PtotalFreq(III,K)) ! P to SPL conversion ENDDO ENDDO - ENDIF - ! If 3rd Output file is needed, these will need to be converted via LOG10. Change to equal 1 to avoid error. - DO K = 1,p%NrObsLoc - DO III = 1,size(p%FreqList) - DO oi = 1,7 - IF (y%SumSpecNoiseSep(oi,K,III) .EQ. 0.) y%SumSpecNoiseSep(oi,K,III) = 1 + ! Procedure for Output file 3; If 3rd Output file is needed, convert P to SPL (skip values = 0). + IF (p%NrOutFile .gt. 2) THEN + DO K = 1,p%NrObsLoc + DO III = 1,size(p%FreqList) + DO oi = 1,nNoiseMechanism + IF (m%SumSpecNoiseSep(oi,III,K) .NE. 0.) m%SumSpecNoiseSep(oi,III,K) = 10.*LOG10(m%SumSpecNoiseSep(oi,III,K)) ! P to SPL Conversion + ENDDO + ENDDO ENDDO - ENDDO - ENDDO + + ! Procedure for Output file 3; If 4th Output file is needed, convert P to SPL (skip values = 0). + IF (p%NrOutFile .gt. 3) THEN + DO I = 1,p%numBlades + DO J = 1,p%NumBlNds + DO K = 1,p%NrObsLoc + IF (m%OASPL(K,J,I) .NE. 0.) m%OASPL(K,J,I) = 10.*LOG10(m%OASPL(K,J,I)) + ENDDO + ENDDO + ENDDO + END IF ! file 4 + + ENDIF ! file 3 + + END IF ! file 2 + - ! Procedure for Output file 3 - IF (p%NrOutFile .gt. 2) THEN - y%SumSpecNoiseSep = 10.*LOG10(y%SumSpecNoiseSep) ! P to SPL Conversion - ENDIF +contains + + subroutine TotalContributionFromType(SPL,Ptotal,NoiseMech) + REAL(ReKi), intent(inout) :: SPL(:) + INTEGER(IntKi), intent(in ) :: NoiseMech ! number of noise mechanism (index into SumSpecNoiseSep) + REAL(ReKi), intent(inout) :: Ptotal + REAL(ReKi) :: Pt + REAL(ReKi) :: P_SumAllFreq + + IF (p%AweightFlag) THEN + SPL = SPL + p%Aweight ! A-weighting for all frequencies + ENDIF + + P_SumAllFreq = 0.0_ReKi + + do III=1,size(p%FreqList) ! Loops through each 1/3rd octave center frequency + + Pt = 10.0_ReKi**(SPL(III)/10.0_ReKi) ! SPL to P Conversion for III Frequency + + P_SumAllFreq = P_SumAllFreq + Pt ! Sum for Running Total + m%SumSpecNoiseSep(NoiseMech,III,K) = m%SumSpecNoiseSep(NoiseMech,III,K) + Pt ! Running sum of observer and frequency dependent sound pressure + + end do + Ptotal = Ptotal + P_SumAllFreq + end subroutine END SUBROUTINE CalcAeroAcousticsOutput !==================================================================================================================================! -SUBROUTINE LBLVS(ALPSTAR,C,U,THETA,PHI,L,R,p,d99Var2,dstarVar1,dstarVar2,SPLLAM,StallVal,errStat,errMsg) - REAL(ReKi), INTENT(IN ) :: ALPSTAR ! AOA +SUBROUTINE LBLVS(ALPSTAR,C,U,THETA,PHI,L,R,p,d99Var2,dstarVar1,dstarVar2,SPLLAM,StallVal) + REAL(ReKi), INTENT(IN ) :: ALPSTAR ! AOA, deg REAL(ReKi), INTENT(IN ) :: C ! Chord Length REAL(ReKi), INTENT(IN ) :: U ! Unoise FREESTREAM VELOCITY METERS/SEC REAL(ReKi), INTENT(IN ) :: THETA ! DIRECTIVITY ANGLE DEGREES @@ -1279,11 +1100,7 @@ SUBROUTINE LBLVS(ALPSTAR,C,U,THETA,PHI,L,R,p,d99Var2,dstarVar1,dstarVar2,SPLLAM, REAL(ReKi), INTENT(IN ) :: StallVal ! TYPE(AA_ParameterType), INTENT(IN ) :: p ! Noise module Parameters REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLLAM ! - INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation - character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'LBLVS' + ! Local variables real(ReKi) :: STPRIM ! STROUHAL NUMBER BASED ON PRESSURE SIDE BOUNDARY LAYER THICKNESS --- real(ReKi) :: M ! MACH NUMBER @@ -1302,74 +1119,92 @@ SUBROUTINE LBLVS(ALPSTAR,C,U,THETA,PHI,L,R,p,d99Var2,dstarVar1,dstarVar2,SPLLAM, real(ReKi) :: E ! STROUHAL NUMBER RATIO --- real(ReKi) :: SCALE ! GEOMETRIC SCALING TERM integer(intKi) :: I ! I A generic index for DO loops. - ErrStat = ErrID_None - ErrMsg = "" + !compute reynolds number and mach number M = U / p%SpdSound ! MACH NUMBER RC = U * C/p%KinVisc ! REYNOLDS NUMBER BASED ON CHORD + ! compute boundary layer thicknesses IF (p%X_BLMethod .eq. X_BLMethod_Tables) THEN DELTAP = d99Var2 DSTRS = dstarVar1 DSTRP = dstarVar2 ELSE - CALL THICK(C,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL THICK(C,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal) ENDIF + ! compute directivity function - CALL DIRECTH_TE(M,THETA,PHI,DBARH,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + DBARH = DIRECTH_TE(M,THETA,PHI) IF (DBARH <= 0) THEN SPLLAM = 0. RETURN ENDIF + ! compute reference strouhal number ! Eq 55 from BPM Airfoil Self-noise and Prediction paper - IF (RC .LE. 1.3E+05) ST1PRIM = .18 - IF((RC .GT. 1.3E+05).AND.(RC.LE.4.0E+05))ST1PRIM=.001756*RC**.3931 - IF (RC .GT. 4.0E+05) ST1PRIM = .28 + if (RC .LE. 1.3E+05) then + ST1PRIM = .18 + elseif (RC.LE.4.0E+05) then + ST1PRIM=.001756*RC**.3931 + else + ST1PRIM = .28 + end if STPKPRM = 10.**(-.04*ALPSTAR) * ST1PRIM ! Eq 56 from BPM Airfoil Self-noise and Prediction paper ! compute reference reynolds number ! Eq 59 from BPM Airfoil Self-noise and Prediction paper - IF (ALPSTAR .LE. 3.0) RC0=10.**(.215*ALPSTAR+4.978) - IF (ALPSTAR .GT. 3.0) RC0=10.**(.120*ALPSTAR+5.263) + IF (ALPSTAR .LE. 3.0) then + RC0=10.**(.215*ALPSTAR+4.978) + else + RC0=10.**(.120*ALPSTAR+5.263) + end if + ! compute peak scaled spectrum level D = RC / RC0 ! Used in Eq 58 from BPM Airfoil Self-noise and Prediction paper - IF (D .LE. .3237) G2 =77.852*LOG10(D)+15.328 ! Begin Eq 58 from BPM Airfoil Self-noise and Prediction paper - IF ((D .GT. .3237).AND.(D .LE. .5689)) G2 = 65.188*LOG10(D) + 9.125 - IF ((D .GT. .5689).AND.(D .LE. 1.7579)) G2 = -114.052 * LOG10(D)**2 - IF ((D .GT. 1.7579).AND.(D .LE. 3.0889)) G2 = -65.188*LOG10(D)+9.125 - IF (D .GT. 3.0889) G2 =-77.852*LOG10(D)+15.328 ! end + if (D .LE. .3237) then + G2 =77.852*LOG10AA(D)+15.328 ! Begin Eq 58 from BPM Airfoil Self-noise and Prediction paper + elseif (D .LE. .5689) then + G2 = 65.188*LOG10(D) + 9.125 + elseif (D .LE. 1.7579) then + G2 = -114.052 * LOG10(D)**2 + elseif (D .LE. 3.0889) then + G2 = -65.188*LOG10(D)+9.125 + else + G2 =-77.852*LOG10(D)+15.328 + end if + ! compute angle-dependent level for shape curve - G3 = 171.04 - 3.03 * ALPSTAR ! Eq 60 from BPM Airfoil Self-noise and Prediction paper - SCALE = 10. * LOG10(DELTAP*M**5*DBARH*L/R**2) ! From Eq 53 from BPM Airfoil Self-noise and Prediction paper + G3 = 171.04 - 3.03 * ALPSTAR ! Eq 60 from BPM Airfoil Self-noise and Prediction paper + SCALE = 10. * Log10AA(DELTAP*M**5*DBARH*L/R**2) ! From Eq 53 from BPM Airfoil Self-noise and Prediction paper + ! Compute scaled sound pressure levels for each strouhal number DO I=1,SIZE(p%FreqList) STPRIM = p%FreqList(I) * DELTAP / U ! Eq 54 from BPM Airfoil Self-noise and Prediction paper - E = STPRIM / STPKPRM ! Used in Eq 57 from BPM Airfoil Self-noise and Prediction paper - IF (E .LE. .5974) G1 = 39.8*LOG10(E)-11.12 ! Begin Eq 57 from BPM Airfoil Self-noise and Prediction paper - IF ((E .GT. .5974).AND.(E .LE. .8545)) G1 = 98.409 * LOG10(E) + 2.0 - IF ((E .GT. .8545).AND.(E .LE. 1.17)) G1 = -5.076+SQRT(2.484-506.25*(LOG10(E))**2) - IF ((E .GT. 1.17).AND.(E .LE. 1.674)) G1 = -98.409 * LOG10(E) + 2.0 - IF (E .GT. 1.674) G1 = -39.80*LOG10(E)-11.12 ! end + E = STPRIM / STPKPRM ! Used in Eq 57 from BPM Airfoil Self-noise and Prediction paper + IF (E .LE. .5974) then + G1 = 39.8*LOG10AA(E)-11.12 ! Begin Eq 57 from BPM Airfoil Self-noise and Prediction paper + ELSEIF(E .LE. .8545) then + G1 = 98.409 * LOG10(E) + 2.0 + ELSEIF (E .LE. 1.17) then + G1 = -5.076+SQRT(2.484-506.25*(LOG10(E))**2) + ELSEIF (E .LE. 1.674) then + G1 = -98.409 * LOG10(E) + 2.0 + ELSE + G1 = -39.80*LOG10(E)-11.12 + END IF SPLLAM(I) = G1 + G2 + G3 + SCALE ! Eq 53 from BPM Airfoil Self-noise and Prediction paper ENDDO END SUBROUTINE LBLVS !==================================================================================================================================! -SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,d99Var2,dstarVar1,dstarVar2,StallVal,SPLP,SPLS,SPLALPH,SPLTBL,errStat,errMsg) +SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,d99Var2,dstarVar1,dstarVar2,StallVal,SPLP,SPLS,SPLALPH) REAL(ReKi), INTENT(IN ) :: ALPSTAR ! AOA(deg) REAL(ReKi), INTENT(IN ) :: C ! Chord Length (m) -! REAL(ReKi), INTENT(IN ) :: U ! Unoise(m/s) -! REAL(ReKi), INTENT(IN ) :: THETA ! DIRECTIVITY ANGLE (deg) -! REAL(ReKi), INTENT(IN ) :: PHI ! DIRECTIVITY ANGLE (deg) + REAL(ReKi), INTENT(IN ) :: U ! Unoise(m/s) + REAL(ReKi), INTENT(IN ) :: THETA ! DIRECTIVITY ANGLE (deg) + REAL(ReKi), INTENT(IN ) :: PHI ! DIRECTIVITY ANGLE (deg) REAL(ReKi), INTENT(IN ) :: L ! SPAN(m) REAL(ReKi), INTENT(IN ) :: R ! SOURCE TO OBSERVER DISTANCE (m) + TYPE(AA_ParameterType), INTENT(IN ) :: p ! Noise Module Parameters -! REAL(ReKi) :: ALPSTAR ! AOA(deg) -! REAL(ReKi) :: C ! Chord Length (m) - REAL(ReKi) :: U ! Unoise(m/s) - REAL(ReKi) :: THETA ! DIRECTIVITY ANGLE (deg) - REAL(ReKi) :: PHI ! DIRECTIVITY ANGLE (deg) ! REAL(ReKi) :: L ! SPAN(m) ! REAL(ReKi) :: R ! SOURCE TO OBSERVER DISTANCE (m) @@ -1378,16 +1213,10 @@ SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,d99Var2,dstarVar1,dstarVar2,StallVa REAL(ReKi), INTENT(IN ) :: dstarVar2 ! REAL(ReKi), INTENT(IN ) :: StallVal ! - TYPE(AA_ParameterType), INTENT(IN ) :: p ! Noise Module Parameters REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLP ! SOUND PRESSURE LEVEL DUE TO PRESSURE SIDE OF AIRFOIL (db) REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLS ! SOUND PRESSURE LEVEL DUE TO SUCTION SIDE OF AIRFOIL (db) - REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLTBL ! TOTAL SOUND PRESSURE LEVEL DUE TO TBLTE MECHANISM (db) REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLALPH ! SOUND PRESSURE LEVEL DUE TO ANGLE OF ATTACK CONTRIBUTION (db) - INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation - character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'TBLTE' + ! Local variables real(ReKi) :: STP ! PRESSURE SIDE STROUHAL NUMBER --- real(ReKi) :: STS ! SUCTION SIDE STROUHAL NUMBER --- @@ -1428,41 +1257,36 @@ SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,d99Var2,dstarVar1,dstarVar2,StallVa real(ReKi) :: BETA0 ! USED IN 'B' COMPUTATION --- real(ReKi) :: K1 ! AMPLITUDE FUNCTION (DB) real(ReKi) :: K2 ! AMPLITUDE FUNCTION (DB) - real(ReKi) :: P1 ! PRESSURE SIDE PRESSURE (NT/M2) - real(ReKi) :: P2 ! SUCTION SIDE PRESSURE (NT/M2) - real(ReKi) :: P4 ! PRESSURE FROM ANGLE OF ATTACK CONTRIBUTION (NT/M2) + !real(ReKi) :: P1 ! PRESSURE SIDE PRESSURE (NT/M2) + !real(ReKi) :: P2 ! SUCTION SIDE PRESSURE (NT/M2) + !real(ReKi) :: P4 ! PRESSURE FROM ANGLE OF ATTACK CONTRIBUTION (NT/M2) real(ReKi) :: M ! MACH NUMBER real(ReKi) :: RC ! REYNOLDS NUMBER BASED ON CHORD real(ReKi) :: DELTAP ! PRESSURE SIDE BOUNDARY LAYER THICKNESS METERS real(ReKi) :: XCHECK ! USED TO CHECK FOR ANGLE OF ATTACK CONTRIBUTION real(ReKi) :: DBARH ! HIGH FREQUENCY DIRECTIVITY --- real(ReKi) :: DBARL ! LOW FREQUENCY DIRECTIVITY --- - + integer(intKi) :: I ! I A generic index for DO loops. LOGICAL :: SWITCH !!LOGICAL FOR COMPUTATION OF ANGLE OF ATTACK CONTRIBUTION - - - ErrStat = ErrID_None - ErrMsg = "" ! Compute reynolds number and mach number M = U / p%SpdSound RC = U * C/p%KinVisc + ! Compute boundary layer thicknesses IF (p%X_BLMethod .eq. X_BLMethod_Tables) THEN DELTAP = d99Var2 DSTRS = dstarVar1 DSTRP = dstarVar2 ELSE - CALL THICK(C,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL THICK(C,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal) ENDIF + ! Compute directivity function - CALL DIRECTL(M,THETA,PHI,DBARL,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL DIRECTH_TE(M,THETA,PHI,DBARH,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + DBARL = DIRECTL(M,THETA,PHI) + DBARH = DIRECTH_TE(M,THETA,PHI) ! IF (DBARH <= 0) THEN ! SPLP = 0. ! SPLS = 0. @@ -1472,52 +1296,76 @@ SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,d99Var2,dstarVar1,dstarVar2,StallVa ! Calculate the reynolds numbers based on pressure and suction displacement thickness RDSTRS = DSTRS * U / p%KinVisc RDSTRP = DSTRP * U / p%KinVisc + ! Determine peak strouhal numbers to be used for 'a' and 'b' curve calculations ST1 = .02 * M ** (-.6) ! Eq 32 from BPM Airfoil Self-noise and Prediction paper + ! Eq 34 from BPM Airfoil Self-noise and Prediction paper - IF (ALPSTAR .LE. 1.333) ST2 = ST1 - IF ((ALPSTAR .GT. 1.333).AND.(ALPSTAR .LE. StallVal)) ST2 = ST1*10.**(.0054*(ALPSTAR-1.333)**2) - IF (ALPSTAR .GT. StallVal) ST2 = 4.72 * ST1 + IF (ALPSTAR .LE. 1.333) then + ST2 = ST1 + elseif (ALPSTAR .LE. StallVal) then + ST2 = ST1*10.**(.0054*(ALPSTAR-1.333)**2) + else + ST2 = 4.72 * ST1 + end if + ST1PRIM = (ST1+ST2)/2. ! Eq 33 from BPM Airfoil Self-noise and Prediction paper - CALL A0COMP(RC,A0) ! compute -20 dB dropout (returns A0) - CALL A0COMP(3.0_ReKi*RC,A02) ! compute -20 dB dropout for AoA > AoA_0 (returns A02) + A0 = A0COMP(RC) ! compute -20 dB dropout (returns A0) + A02 = A0COMP(3.0_ReKi*RC) ! compute -20 dB dropout for AoA > AoA_0 (returns A02) ! Evaluate minimum and maximum 'a' curves at a0 - CALL AMIN(A0,AMINA0) - CALL AMAX(A0,AMAXA0) - CALL AMIN(A02,AMINA02) - CALL AMAX(A02,AMAXA02) + AMINA0 = AMIN(A0) + AMAXA0 = AMAX(A0) + AMINA02 = AMIN(A02) + AMAXA02 = AMAX(A02) ! Compute 'a' max/min ratio ! Eq 39 from BPM Airfoil Self-noise and Prediction paper ARA0 = (20. + AMINA0) / (AMINA0 - AMAXA0) ARA02 = (20. + AMINA02)/ (AMINA02- AMAXA02) + ! Compute b0 to be used in 'b' curve calculations ! Eq 44 from BPM Airfoil Self-noise and Prediction paper - IF (RC .LT. 9.52E+04) B0 = .30 - IF ((RC .GE. 9.52E+04).AND.(RC .LT. 8.57E+05)) & - B0 = (-4.48E-13)*(RC-8.57E+05)**2 + .56 - IF (RC .GE. 8.57E+05) B0 = .56 + IF (RC .LT. 9.52E+04) then + B0 = .30 + elseif (RC .LT. 8.57E+05) then + B0 = (-4.48E-13)*(RC-8.57E+05)**2 + .56 + else + B0 = .56 + end if + ! Evaluate minimum and maximum 'b' curves at b0 - CALL BMIN(B0,BMINB0) - CALL BMAX(B0,BMAXB0) + BMINB0 = BMIN(B0) + BMAXB0 = BMAX(B0) ! Compute 'b' max/min ratio BRB0 = (20. + BMINB0) / (BMINB0 - BMAXB0) ! For each center frequency, compute an 'a' prediction for the pressure side STPEAK = ST1 - IF (RC .LT. 2.47E+05) K1 = -4.31 * LOG10(RC) + 156.3 ! Begin Eq 47 from BPM Airfoil Self-noise and Prediction paper - IF((RC .GE. 2.47E+05).AND.(RC .LE. 8.0E+05)) K1 = -9.0 * LOG10(RC) + 181.6 - IF (RC .GT. 8.0E+05) K1 = 128.5 ! end - IF (RDSTRP .LE. 5000.) DELK1 = -ALPSTAR*(5.29-1.43*LOG10(RDSTRP)) ! Begin Eq 48 from BPM Airfoil Self-noise and Prediction paper - IF (RDSTRP .GT. 5000.) DELK1 = 0.0 ! end - + IF (RC .LT. 2.47E+05) then + K1 = -4.31 * LOG10AA(RC) + 156.3 ! Begin Eq 47 from BPM Airfoil Self-noise and Prediction paper + elseif (RC .LE. 8.0E+05) then + K1 = -9.0 * LOG10(RC) + 181.6 + else + K1 = 128.5 + end if + + IF (RDSTRP .LE. 5000.) then + DELK1 = -ALPSTAR*(5.29-1.43*LOG10AA(RDSTRP)) ! Begin Eq 48 from BPM Airfoil Self-noise and Prediction paper + else + DELK1 = 0.0 + end if + GAMMA = 27.094 * M + 3.31 ! Begin Eq 49 from BPM Airfoil Self-noise and Prediction paper BETA = 72.650 * M + 10.74 GAMMA0 = 23.430 * M + 4.651 BETA0 =-34.190 * M - 13.820 ! end - IF (ALPSTAR .LE. (GAMMA0-GAMMA)) K2 = -1000.0 ! Begin Eq 49 from BPM Airfoil Self-noise and Prediction paper - IF ((ALPSTAR.GT.(GAMMA0-GAMMA)).AND.(ALPSTAR.LE.(GAMMA0+GAMMA))) & - K2=SQRT(BETA**2-(BETA/GAMMA)**2*(ALPSTAR-GAMMA0)**2)+BETA0 - IF (ALPSTAR .GT. (GAMMA0+GAMMA)) K2 = -12.0 + if (ALPSTAR .LE. (GAMMA0-GAMMA)) then + K2 = -1000.0 ! Begin Eq 49 from BPM Airfoil Self-noise and Prediction paper + else if (ALPSTAR.LE.(GAMMA0+GAMMA)) then + K2=SQRT(BETA**2-(BETA/GAMMA)**2*(ALPSTAR-GAMMA0)**2)+BETA0 + else + K2 = -12.0 + end if K2 = K2 + K1 ! end + ! Check for 'a' computation for suction side XCHECK = GAMMA0 SWITCH = .FALSE. @@ -1527,48 +1375,50 @@ SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,d99Var2,dstarVar1,dstarVar2,StallVa IF ((ALPSTAR .GE. XCHECK).OR.(ALPSTAR .GT. StallVal))SWITCH=.TRUE. DO I=1,size(p%FreqList) STP= p%FreqList(I) * DSTRP / U ! Eq 31 from BPM Airfoil Self-noise and Prediction paper - A = LOG10( STP / STPEAK ) ! Eq 37 from BPM Airfoil Self-noise and Prediction paper - CALL AMIN(A,AMINA) - CALL AMAX(A,AMAXA) + A = LOG10AA( STP / STPEAK ) ! Eq 37 from BPM Airfoil Self-noise and Prediction paper + AMINA = AMIN(A) + AMAXA = AMAX(A) AA = AMINA + ARA0 * (AMAXA - AMINA) ! Eq 40 from BPM Airfoil Self-noise and Prediction paper - SPLP(I)=AA+K1-3.+10.*LOG10(DSTRP*M**5*DBARH*L/R**2)+DELK1 ! Eq 25 from BPM Airfoil Self-noise and Prediction paper + SPLP(I)=AA+K1-3.+10.*LOG10AA(DSTRP*M**5*DBARH*L/R**2)+DELK1 ! Eq 25 from BPM Airfoil Self-noise and Prediction paper STS = p%FreqList(I) * DSTRS / U ! Eq 31 from BPM Airfoil Self-noise and Prediction paper IF (.NOT. SWITCH) THEN - A = LOG10( STS / ST1PRIM ) - CALL AMIN(A,AMINA) - CALL AMAX(A,AMAXA) + A = LOG10AA( STS / ST1PRIM ) + AMINA = AMIN(A) + AMAXA = AMAX(A) AA = AMINA + ARA0 * (AMAXA - AMINA) - SPLS(I) = AA+K1-3.+10.*LOG10(DSTRS*M**5*DBARH* L/R**2) ! Eq 26 from BPM Airfoil Self-noise and Prediction paper + SPLS(I) = AA+K1-3.+10.*LOG10AA(DSTRS*M**5*DBARH* L/R**2) ! Eq 26 from BPM Airfoil Self-noise and Prediction paper ! 'B' CURVE COMPUTATION ! B = ABS(LOG10(STS / ST2)) - B = LOG10(STS / ST2) ! abs not needed absolute taken in the AMAX,AMIN ! Eq 43 from BPM Airfoil Self-noise and Prediction paper - CALL BMIN(B,BMINB) - CALL BMAX(B,BMAXB) + B = LOG10AA(STS / ST2) ! abs not needed absolute taken in the BMAX,BMIN ! Eq 43 from BPM Airfoil Self-noise and Prediction paper + BMINB = BMIN(B) + BMAXB = BMAX(B) BB = BMINB + BRB0 * (BMAXB-BMINB) ! Eq 46 from BPM Airfoil Self-noise and Prediction paper - SPLALPH(I)=BB+K2+10.*LOG10(DSTRS*M**5*DBARH*L/R**2) ! Eq 27 from BPM Airfoil Self-noise and Prediction paper + SPLALPH(I)=BB+K2+10.*LOG10AA(DSTRS*M**5*DBARH*L/R**2) ! Eq 27 from BPM Airfoil Self-noise and Prediction paper ELSE ! The 'a' computation is dropped if 'switch' is true - SPLS(I) = 10.*LOG10(DSTRS*M**5*DBARL*L/R**2) + SPLS(I) = 10.*LOG10AA(DSTRS*M**5*DBARL*L/R**2) + ! SPLP(I) = 0.0 + 10.*LOG10(DSTRS*M**5*DBARL*L/R**2) ! changed the line below because the SPLP should be calculatd with DSTRP not with DSTRS - SPLP(I) = 10.*LOG10(DSTRP*M**5*DBARL*L/R**2) ! this is correct + SPLP(I) = 10.*LOG10AA(DSTRP*M**5*DBARL*L/R**2) ! this is correct + ! B = ABS(LOG10(STS / ST2)) - B = LOG10(STS / ST2) ! abs not needed absolute taken in the AMAX,AMIN - CALL AMIN(B,AMINB) - CALL AMAX(B,AMAXB) + B = LOG10AA(STS / ST2) ! abs not needed absolute taken in the AMAX,AMIN + AMINB = AMIN(B) + AMAXB = AMAX(B) BB = AMINB + ARA02 * (AMAXB-AMINB) - SPLALPH(I)=BB+K2+10.*LOG10(DSTRS*M**5*DBARL*L/R**2) + SPLALPH(I)=BB+K2+10.*LOG10AA(DSTRS*M**5*DBARL*L/R**2) ENDIF ! Sum all contributions from 'a' and 'b' on both pressure and suction side on a mean-square pressure basis IF (SPLP(I) .LT. -100.) SPLP(I) = -100. ! Similar to Eq 28 of BPM Airfoil Self-noise and Prediction paper IF (SPLS(I) .LT. -100.) SPLS(I) = -100. ! Similar to Eq 29 of BPM Airfoil Self-noise and Prediction paper IF (SPLALPH(I) .LT. -100.) SPLALPH(I) = -100. ! Eq 30 of BPM Airfoil Self-noise and Prediction paper recommends SPLALPH = 10log(stuff) + A' + K2, where A' is calculated same as A but with x3 Rc - P1 = 10.**(SPLP(I) / 10.) ! SPL_Pressure - P2 = 10.**(SPLS(I) / 10.) ! SPL_Suction - P4 = 10.**(SPLALPH(I) / 10.) ! SPL_AoA - SPLTBL(I) = 10. * LOG10(P1 + P2 + P4) ! Eq 24 from BPM Airfoil Self-noise and Prediction paper + !P1 = 10.**(SPLP(I) / 10.) ! SPL_Pressure + !P2 = 10.**(SPLS(I) / 10.) ! SPL_Suction + !P4 = 10.**(SPLALPH(I) / 10.) ! SPL_AoA + !SPLTBL(I) = 10. * LOG10AA(P1 + P2 + P4) ! Eq 24 from BPM Airfoil Self-noise and Prediction paper @@ -1576,8 +1426,8 @@ SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,d99Var2,dstarVar1,dstarVar2,StallVa END SUBROUTINE TBLTE !==================================================================================================================================! -SUBROUTINE TIPNOIS(ALPHTIP,ALPRAT2,C,U ,THETA,PHI, R,p,SPLTIP, errStat, errMsg) - REAL(ReKi), INTENT(IN ) :: ALPHTIP !< AOA +SUBROUTINE TIPNOIS(ALPHTIP,ALPRAT2,C,U ,THETA,PHI, R,p,SPLTIP) + REAL(ReKi), INTENT(IN ) :: ALPHTIP !< AOA, deg REAL(ReKi), INTENT(IN ) :: ALPRAT2 !< TIP LIFT CURVE SLOPE --- REAL(ReKi), INTENT(IN ) :: C !< Chord Length REAL(ReKi), INTENT(IN ) :: U !< FREESTREAM VELOCITY METERS/SEC @@ -1586,12 +1436,8 @@ SUBROUTINE TIPNOIS(ALPHTIP,ALPRAT2,C,U ,THETA,PHI, R,p,SPLTIP, errStat, errMsg) REAL(ReKi), INTENT(IN ) :: R !< SOURCE TO OBSERVER DISTANCE METERS TYPE(AA_ParameterType) , INTENT(IN ) :: p !< Parameters REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLTIP !< - INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation - character(*), INTENT( OUT) :: errMsg !< Error message if ErrStat /= ErrID_None + ! local variables - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'tipnoise' REAL(ReKi) :: M ! MACH NUMBER --- REAL(ReKi) :: MM ! MAXIMUM MACH NUMBER --- REAL(ReKi) :: ALPTIPP ! CORRECTED TIP ANGLE OF ATTACK DEGREES @@ -1602,8 +1448,7 @@ SUBROUTINE TIPNOIS(ALPHTIP,ALPRAT2,C,U ,THETA,PHI, R,p,SPLTIP, errStat, errMsg) REAL(ReKi) :: L ! CHARACTERISTIC LENGTH FOR TIP METERS REAL(ReKi) :: TERM ! SCALING TERM --- integer(intKi) :: I !I A generic index for DO loops. - ErrStat = ErrID_None - ErrMsg = "" + IF (alphtip.eq.0.) THEN SPLTIP= 0 RETURN @@ -1615,8 +1460,7 @@ SUBROUTINE TIPNOIS(ALPHTIP,ALPRAT2,C,U ,THETA,PHI, R,p,SPLTIP, errStat, errMsg) ALPTIPP = ABS(ALPHTIP) * ALPRAT2 M = U / p%SpdSound ! MACH NUMBER ! Compute directivity function - CALL DIRECTH_TE(M,THETA,PHI,DBARH,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + DBARH = DIRECTH_TE(M,THETA,PHI) IF (p%ROUND) THEN L = .008 * ALPTIPP * C ! Eq 63 from BPM Airfoil Self-noise and Prediction paper ELSE @@ -1628,7 +1472,7 @@ SUBROUTINE TIPNOIS(ALPHTIP,ALPRAT2,C,U ,THETA,PHI, R,p,SPLTIP, errStat, errMsg) ENDIF MM = (1. + .036*ALPTIPP) * M ! Eq 64 from BPM Airfoil Self-noise and Prediction paper UM = MM * p%SpdSound ! Eq 65 from BPM Airfoil Self-noise and Prediction paper - TERM = M*M*MM**3*L**2*DBARH/R**2 ! TERM = M^2 * M_max^5 *l^2 *D / r^2 according to Semi-Empirical Aeroacoustic Noise Prediction Code for Wind Turbines paper + TERM = M*M*MM**3*L**2*DBARH/R**2 ! TERM = M^2 * M_max^5 *l^2 *D / r^2 according to Semi-Empirical Aeroacoustic Noise Prediction Code for Wind Turbines paper ! Term is correct according to Eq 61 from BPM Airfoil self-noise and Prediction paper IF (TERM .NE. 0.0) THEN SCALE = 10.*LOG10(TERM) @@ -1636,13 +1480,13 @@ SUBROUTINE TIPNOIS(ALPHTIP,ALPRAT2,C,U ,THETA,PHI, R,p,SPLTIP, errStat, errMsg) SCALE = 0.0 ENDIF DO I=1,size(p%FreqList) - STPP = p%FreqList(I) * L / UM ! Eq 62 from BPM Airfoil Self-noise and Prediction paper - SPLTIP(I) = 126.-30.5*(LOG10(STPP)+.3)**2 + SCALE ! Eq 61 from BPM Airfoil Self-noise and Prediction paper + STPP = p%FreqList(I) * L / UM ! Eq 62 from BPM Airfoil Self-noise and Prediction paper + SPLTIP(I) = 126.-30.5*(LOG10AA(STPP)+.3)**2 + SCALE ! Eq 61 from BPM Airfoil Self-noise and Prediction paper ENDDO END SUBROUTINE TipNois !==================================================================================================================================! -SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,TINoise,p,SPLti,errStat,errMsg) - REAL(ReKi), INTENT(IN ) :: AlphaNoise ! AOA +SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,TINoise,p,SPLti) + REAL(ReKi), INTENT(IN ) :: AlphaNoise ! AOA, radians REAL(ReKi), INTENT(IN ) :: Chord ! Chord Length REAL(ReKi), INTENT(IN ) :: U ! REAL(ReKi), INTENT(IN ) :: THETA ! @@ -1650,18 +1494,14 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,TINoise,p,SPLti,errSt REAL(ReKi), INTENT(IN ) :: d ! element span REAL(ReKi), INTENT(IN ) :: RObs ! distance to observer ! REAL(ReKi), INTENT(IN ) :: MeanVNoise ! - REAL(ReKi), INTENT(IN ) :: TINoise ! + REAL(ReKi), INTENT(IN ) :: TINoise ! turbulence intensity (NOT in percent) ! REAL(ReKi), INTENT(IN ) :: LE_Location ! ! REAL(ReKi), INTENT(IN ) :: dissip ! TYPE(AA_ParameterType), INTENT(IN ) :: p ! Parameters REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLti ! - INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation - character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'InflowNoise' -! local variables + + ! local variables REAL(ReKi) :: Beta2 ! Prandtl-Glauert correction factor REAL(ReKi) :: DBARH ! High-frequency directivity correction factor REAL(ReKi) :: DBARL ! Low-frequency directivity correction factor @@ -1671,20 +1511,13 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,TINoise,p,SPLti,errSt REAL(ReKi) :: Mach ! local mach number REAL(ReKi) :: Sears ! Sears function REAL(ReKi) :: SPLhigh ! predicted high frequency sound pressure level -! REAL(ReKi) :: Ums ! mean square turbulence level REAL(ReKi) :: WaveNumber ! wave number - non-dimensional frequency REAL(ReKi) :: Kbar ! nafnoise REAL(ReKi) :: khat ! nafnoise -! REAL(ReKi) :: Kh ! nafnoise REAL(ReKi) :: ke ! nafnoise - REAL(ReKi) :: alpstar ! nafnoise -! REAL(ReKi) :: mu ! nafnoise REAL(ReKi) :: tinooisess ! nafnoise - ! REAL(ReKi) :: L_Gammas ! nafnoise INTEGER(intKi) :: I !I A generic index for DO loops. - ErrStat = ErrID_None - ErrMsg = "" !!!--- NAF NOISE IDENTICAL Mach = U/p%SpdSound @@ -1699,25 +1532,23 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,TINoise,p,SPLti,errSt !tinooisess=0.1 !Ums = (tinooisess*U)**2 !Ums = (tinooisess*8)**2 - CALL DIRECTL(Mach,THETA,PHI,DBARL,errStat2,errMsg2) ! assume that noise is low-freq in nature because turbulence length scale is large - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL DIRECTH_LE(Mach,THETA,PHI,DBARH,errStat2,errMsg2) ! Directivity for the leading edge at high frequencies - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + DBARL = DIRECTL(Mach,THETA,PHI) ! assume that noise is low-freq in nature because turbulence length scale is large + DBARH = DIRECTH_LE(Mach,THETA,PHI) ! Directivity for the leading edge at high frequencies + IF (DBARH <= 0) THEN SPLti = 0. RETURN ENDIF - + ! In the following lines, bibliography will be referenced as: a) Moriarty, Guidati, Migliore, Recent Improvement of a Semi-Empirical Aeroacoustic - ! Prediction Code for Wind Turbines - ! ref b) Lowson, Assessment and Prediction of Wind Turbine Noise + ! Prediction Code for Wind Turbines (https://docs.nrel.gov/docs/fy04osti/34478.pdf) + ! ref b) Lowson, Assessment and Prediction of Wind Turbine Noise () !*********************************************** Model 1: !!! Nafnoise source code version see below Frequency_cutoff = 10*U/PI/Chord Ke = 3.0/(4.0*p%Lturb) Beta2 = 1-Mach*Mach - ALPSTAR = AlphaNoise*PI/180. DO I=1,size(p%FreqList) IF (p%FreqList(I) <= Frequency_cutoff) THEN @@ -1726,35 +1557,44 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,TINoise,p,SPLti,errSt Directivity = DBARH ENDIF - WaveNumber = 2.0*PI*p%FreqList(I)/U + WaveNumber = TwoPi*p%FreqList(I)/U Kbar = WaveNumber*Chord/2.0 Khat = WaveNumber/Ke ! mu = Mach*WaveNumber*Chord/2.0/Beta2 - - SPLhigh = 10.*LOG10(p%AirDens*p%AirDens*p%SpdSound**4*p%Lturb*(d/2.)/ & - (RObs*RObs)*(Mach**5)*tinooisess*tinooisess*(Khat**3)* & - (1+Khat**2)**(-7./3.)*Directivity) + 78.4 ! ref a) + + !Note: when we set RObs in CalcObserve(), we make sure it is >= AA_EPSILON ! avoid divide-by-zero + ! tinooisess could be 0, especially on the first step, so we need to check (use LOG10AA instead of LOG10) + SPLhigh = 10.*LOG10AA(p%AirDens**2 * p%SpdSound**4 * p%Lturb * (d/2.) / (RObs**2) *(Mach**5) * & + tinooisess**2 *(Khat**3)* (1+Khat**2)**(-7./3.) * Directivity) + 78.4 ! ref a; [2] ) + !bjj 01-13-2026: comparing with Eq 8 in ref [2], + ! (1) The paper uses "Kbar" instead of Khat (which the code uses). + ! (2) In the paper, "I" is in percent and it adds the constant 58.4. In the code, we have "I" as a fraction and I is squared, so + ! 10*log10(x*100^2)+58.4 = 10*(log10(x)+log10(100^2)) + 58.4 = 10*log10(x) + 10*log10(100^2) + 58.4 = 10*log10(x) + 40 + 58.4 + ! Seems like we should be adding 98.4 instead of 78.4 in this code. However, I also haven't found documentation for the "component due to angles of attack" below, + ! so maybe this isn't wrong. + !!! SPLhigh = 10.*LOG10(p%Lturb*(d/2.)/ & !!! (RObs*RObs)*(Mach**5)*tinooisess*tinooisess*(WaveNumber**3) & !!! *(1+WaveNumber**2)**(-7./3.)*Directivity) + 181.3 - SPLhigh = SPLhigh + 10.*LOG10(1+ 9.0*ALPSTAR*ALPSTAR) ! Component due to angles of attack, ref a) + SPLhigh = SPLhigh + 10.*LOG10(1+ 9.0*AlphaNoise**2) ! Component due to angles of attack, ref a [2]) - Sears = 1/(2.*PI*Kbar/Beta2+1/(1+2.4*Kbar/Beta2)) ! ref a) + Sears = 1./(TwoPi*Kbar/Beta2 + 1./(1.+2.4*Kbar/Beta2)) ! ref a [2]) - !!! Sears = 1/(2.*PI*WaveNumber/Beta2+1/(1+2.4*WaveNumber/Beta2)) ! ref b) + !!! Sears = 1/(2.*PI*WaveNumber/Beta2+1/(1+2.4*WaveNumber/Beta2)) ! ref b [3]) - LFC = 10*Sears*Mach*Kbar*Kbar/Beta2 ! ref a) - !!! LFC = 10*Sears*Mach*WaveNumber*WaveNumber/Beta2 ! ref b) + LFC = MAX(AA_Epsilon, 10*Sears*Mach*Kbar**2/Beta2) ! ref a) + !!! LFC = 10*Sears*Mach*WaveNumber**2/Beta2 ! ref b [3]) - !!! IF (mu<(PI/4.0)) THEN ! ref b) - !!! SPLti(I) = SPLhigh + 10.*ALOG10(LFC) ! ref b) - !!! ELSE ! ref b) - !!! SPLti(I) = SPLhigh ! ref b) + !!! IF (mu<(PI/4.0)) THEN ! ref b [3]) + !!! SPLti(I) = SPLhigh + 10.*ALOG10(LFC) ! ref b [3]) + !!! ELSE ! ref b [3]) + !!! SPLti(I) = SPLhigh ! ref b [3]) !!!ENDIF - SPLti(I) = SPLhigh + 10.*LOG10(LFC/(1+LFC)) + SPLti(I) = SPLhigh + 10.*LOG10AA(LFC/(1+LFC)) ENDDO + !!!*********************************************** end of Model 1 ! ! ********************************* Model 2: @@ -1850,10 +1690,8 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,TINoise,p,SPLti,errSt !! !!! Calculate directivity...? !!!!! ---------------------------- -!! CALL DIRECTL(Mach,THETA,PHI,DBARL,errStat2,errMsg2) !yes, assume that noise is low-freq in nature because turbulence length scale is large -!! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) -!! CALL DIRECTH_LE(Mach,THETA,PHI,DBARH,errStat2,errMsg2) -!! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) +!! DBARL = DIRECTL(Mach,THETA,PHI) !yes, assume that noise is low-freq in nature because turbulence length scale is large +!! DBARH = DIRECTH_LE(Mach,THETA,PHI) !! IF (DBARH <= 0) THEN !! SPLti = 0. !! RETURN @@ -1884,8 +1722,8 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,TINoise,p,SPLti,errSt END SUBROUTINE InflowNoise !==================================================================================================== -SUBROUTINE BLUNT(ALPSTAR,C,U ,THETA,PHI,L,R,H,PSI,p,d99Var2,dstarVar1,dstarVar2,SPLBLUNT,StallVal,errStat,errMsg) - REAL(ReKi), INTENT(IN ) :: ALPSTAR ! AOA +SUBROUTINE BLUNT(ALPSTAR,C,U ,THETA,PHI,L,R,H,PSI,p,d99Var2,dstarVar1,dstarVar2,SPLBLUNT,StallVal) + REAL(ReKi), INTENT(IN ) :: ALPSTAR ! AOA, deg REAL(ReKi), INTENT(IN ) :: C ! Chord Length REAL(ReKi), INTENT(IN ) :: U ! Unoise REAL(ReKi), INTENT(IN ) :: THETA ! DIRECTIVITY ANGLE --- @@ -1900,12 +1738,7 @@ SUBROUTINE BLUNT(ALPSTAR,C,U ,THETA,PHI,L,R,H,PSI,p,d99Var2,dstarVar1,dstarVar2, REAL(ReKi), INTENT(IN ) :: StallVal !< Stall angle at station i TYPE(AA_ParameterType), INTENT(IN ) :: p ! Parameters REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLBLUNT ! - INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation - character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None ! Local variables - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'BLUNT' real(ReKi) :: STPPP ! STROUHAL NUMBER --- real(ReKi) :: M ! MACH NUMBER --- real(ReKi) :: RC ! REYNOLDS NUMBER BASED ON CHORD --- @@ -1920,7 +1753,6 @@ SUBROUTINE BLUNT(ALPSTAR,C,U ,THETA,PHI,L,R,H,PSI,p,d99Var2,dstarVar1,dstarVar2, real(ReKi) :: ATERM ! USED TO COMPUTE PEAK STROUHAL NO. --- real(ReKi) :: STPEAK ! PEAK STROUHAL NUMBER --- real(ReKi) :: ETA ! RATIO OF STROUHAL NUMBERS --- - real(ReKi) :: HDSTARL ! MINIMUM ALLOWED VALUE OF HDSTAR --- real(ReKi) :: G514 ! G5 EVALUATED AT PSI=14.0 DB real(ReKi) :: HDSTARP ! MODIFIED VALUE OF HDSTAR --- real(ReKi) :: G50 ! G5 EVALUATED AT PSI=0.0 DB @@ -1929,9 +1761,7 @@ SUBROUTINE BLUNT(ALPSTAR,C,U ,THETA,PHI,L,R,H,PSI,p,d99Var2,dstarVar1,dstarVar2, REAL(ReKi),DIMENSION(size(p%FreqList)) :: G5 ! SPECTRUM SHAPE FUNCTION DB ! corrected (EB_DTU) real(ReKi) :: G5Sum ! SPECTRUM SHAPE FUNCTION DB real(ReKi) :: SCALE ! SCALING FACTOR --- - - ErrStat = ErrID_None - ErrMsg = "" + real(ReKi) :: LogVal ! temp variable to help us not take log10(0) --- ! Reynolds number and mach number M = U / p%SpdSound @@ -1942,142 +1772,185 @@ SUBROUTINE BLUNT(ALPSTAR,C,U ,THETA,PHI,L,R,H,PSI,p,d99Var2,dstarVar1,dstarVar2, DSTRS = dstarVar1 DSTRP = dstarVar2 ELSE - CALL THICK(C,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL THICK(C,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal) ENDIF + ! Compute average displacement thickness DSTRAVG = (DSTRS + DSTRP) / 2. HDSTAR = H / DSTRAVG DSTARH = 1. /HDSTAR ! Compute directivity function - CALL DIRECTH_TE(M,THETA,PHI,DBARH,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + DBARH = DIRECTH_TE(M,THETA,PHI) IF (DBARH <= 0) THEN SPLBLUNT = 0. RETURN ENDIF + ! Compute peak strouhal number eq 72 in BPM Airfoil Self-noise and Prediction paper ATERM = .212 - .0045 * PSI - IF (HDSTAR .GE. .2) & - STPEAK = ATERM / (1.+.235*DSTARH-.0132*DSTARH**2) ! this is what it used to be in nafnoise and fast noise module + IF (HDSTAR .GE. .2) then + STPEAK = ATERM / (1.+.235*DSTARH-.0132*DSTARH**2) ! this is what it used to be in nafnoise and fast noise module !! STPEAK = ATERM / (1+0.235*(DSTARH)**(-1)-0.0132*DSTARH**(-2)) ! check if this one is correct (EB_DTU) - IF (HDSTAR .LT. .2) & - STPEAK = .1 * HDSTAR + .095 - .00243 * PSI + else + STPEAK = .1 * HDSTAR + .095 - .00243 * PSI + end if + ! Compute scaled spectrum level eq 74 of BPM Airfoil Self-noise and Prediction paper - IF (HDSTAR .LE. 5.) G4=17.5*LOG10(HDSTAR)+157.5-1.114*PSI - IF (HDSTAR .GT. 5.) G4=169.7 - 1.114 * PSI + if (HDSTAR .LE. 5.) then + G4=17.5*LOG10AA(HDSTAR)+157.5-1.114*PSI + else + G4=169.7 - 1.114 * PSI + end if + ! For each frequency, compute spectrum shape referenced to 0 db - SCALE = 10. * LOG10(M**5.5*H*DBARH*L/R**2) + SCALE = 10. * LOG10AA(M**5.5 * H * DBARH * L / R**2) G5Sum=0.0_Reki DO I=1,SIZE(p%FreqList) STPPP = p%FreqList(I) * H / U - ETA = LOG10(STPPP/STPEAK) - HDSTARL = HDSTAR - CALL G5COMP(HDSTARL,ETA,G514,errStat2,errMsg2 ) ! compute G5 for Phi=14deg - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ETA = LOG10AA(STPPP/STPEAK) + G514 = G5COMP(HDSTAR,ETA) ! compute G5 for Phi=14deg + HDSTARP = 6.724 * HDSTAR **2-4.019*HDSTAR+1.107 ! eq 82 from BPM Airfoil Self-noise and Prediction paper - CALL G5COMP(HDSTARP,ETA,G50,errStat2,errMsg2 ) ! recompute G5 for Phi=0deg - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + G50 = G5COMP(HDSTARP,ETA) ! recompute G5 for Phi=0deg + G5(I) = G50 + .0714 * PSI * (G514-G50) ! interpolate G5 from G50 and G514 IF (G5(I) .GT. 0.) G5(I) = 0. G5Sum = 10**(G5(I)/10)+G5Sum ! to be subtracted - SPLBLUNT(I) = G4 + G5(I) + SCALE - 10*log10(1/G5Sum) ! equation mentioned there is plus but it is stated subtract, thus ''- 10*log10(1/G5Sum)'' + if ( G5Sum .ne. 0) then + LogVal = MAX(AA_EPSILON,1/G5Sum) + else + LogVal = 1 + end if + SPLBLUNT(I) = G4 + G5(I) + SCALE - 10*log10(LogVal) ! equation mentioned there is plus but it is stated subtract, thus ''- 10*log10(1/G5Sum)'' end do END SUBROUTINE Blunt !==================================================================================================== -SUBROUTINE G5COMP(HDSTAR,ETA,G5,errStat,errMsg) +REAL(ReKi) FUNCTION G5COMP(HDSTAR,ETA) result(G5) REAL(ReKi), INTENT(IN ) :: HDSTAR !< REAL(ReKi), INTENT(IN ) :: ETA !< - REAL(ReKi), INTENT( OUT) :: G5 !< - INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: errMsg !< Error message if ErrStat /= ErrID_None + ! Local variables -! INTEGER(intKi) :: ErrStat2 ! temporary Error status -! CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message - CHARACTER(*), parameter :: RoutineName = 'BLUNT' real(ReKi) :: K real(ReKi) :: M real(ReKi) :: MU - real(ReKi) :: ETALIMIT real(ReKi) :: ETA0 - ErrStat = ErrID_None - ErrMsg = "" - IF ( HDSTAR .LT. .25) MU = .1211 ! begin eq 78 from BPM Airfoil Self-noise and Prediction paper - IF ((HDSTAR .GT. .25).AND.(HDSTAR .LE. .62)) MU =-.2175*HDSTAR + .1755 - IF ((HDSTAR .GT. .62).AND.(HDSTAR .LT. 1.15)) MU =-.0308*HDSTAR + .0596 - IF ( HDSTAR .GE. 1.15) MU = .0242 ! end - IF ( HDSTAR .LE. .02 ) M = 0.0 ! begin eq 79 from BPM Airfoil Self-noise and Prediction paper - IF ((HDSTAR .GE. .02 ).AND.(HDSTAR .LT. .5)) M = 68.724*HDSTAR - 1.35 - IF ((HDSTAR .GT. .5 ).AND.(HDSTAR .LE. .62)) M = 308.475*HDSTAR - 121.23 - IF ((HDSTAR .GT. .62 ).AND.(HDSTAR .LE. 1.15)) M = 224.811*HDSTAR - 69.354 - IF ((HDSTAR .GT. 1.15).AND.(HDSTAR .LT. 1.2)) M = 1583.28*HDSTAR - 1631.592 - IF ( HDSTAR .GT. 1.2 ) M = 268.344 - IF ( M .LT. 0.0 ) M = 0.0 ! end + + IF ( HDSTAR .LT. .25) then + MU = .1211 ! begin eq 78 from BPM Airfoil Self-noise and Prediction paper + elseif (HDSTAR .LE. .62) then + MU =-.2175*HDSTAR + .1755 + elseif (HDSTAR .LT. 1.15) then + MU =-.0308*HDSTAR + .0596 + else + MU = .0242 + end if + + IF ( HDSTAR .LE. .02 ) then + M = 0.0 ! begin eq 79 from BPM Airfoil Self-noise and Prediction paper + elseif (HDSTAR .LT. 0.5) then + M = 68.724*HDSTAR - 1.35 + elseif (HDSTAR .LE. .62) then + M = 308.475*HDSTAR - 121.23 + elseif (HDSTAR .LE. 1.15) then + M = 224.811*HDSTAR - 69.354 + elseif (HDSTAR .LT. 1.2) then + M = 1583.28*HDSTAR - 1631.592 + else + M = 268.344 + end if + M = MAX(M, 0.0_ReKi) !bjj: not sure this is necessary... previous iterations of this statement missed some of the cases so may have had uninitialized values; otherwise, it's not possible to get M<0 + ETA0 = -SQRT((M*M*MU**4)/(6.25+M*M*MU*MU)) ! eq 80 from BPM Airfoil Self-noise and Prediction paper - K = 2.5*SQRT(1.-(ETA0/MU)**2)-2.5-M*ETA0 ! eq 81 from BPM Airfoil Self-noise and Prediction paper - ETALIMIT = 0.03615995 ! one of the bounds given in eq 76 of BPM Airfoil Self-noise and Prediction paper - IF (ETA .LE. ETA0) G5 = M * ETA + K ! begin eq 76 from BPM Airfoil Self-noise and Prediction paper - IF((ETA.GT.ETA0).AND.(ETA .LE. 0.)) G5 = 2.5*SQRT(1.-(ETA/MU)**2)-2.5 - IF((ETA.GT.0. ).AND.(ETA.LE.ETALIMIT)) G5 = SQRT(1.5625-1194.99*ETA**2)-1.25 - IF (ETA.GT.ETALIMIT) G5 = -155.543 * ETA + 4.375 ! end -END SUBROUTINE G5Comp + + IF (ETA .LE. ETA0) then + K = 2.5*SQRT(1.-(ETA0/MU)**2)-2.5-M*ETA0 ! eq 81 from BPM Airfoil Self-noise and Prediction paper + G5 = M * ETA + K ! begin eq 76 from BPM Airfoil Self-noise and Prediction paper + elseif (ETA .LE. 0.) then + G5 = 2.5*SQRT(1.-(ETA/MU)**2)-2.5 + elseif (ETA .LE. 0.03615995) then + G5 = SQRT(1.5625-1194.99*ETA**2)-1.25 + else + G5 = -155.543 * ETA + 4.375 + end if + +END FUNCTION G5Comp !==================================================================================================== !> This subroutine defines the curve fit corresponding to the a-curve for the minimum allowed reynolds number. -SUBROUTINE AMIN(A,AMINA) +REAL(ReKi) FUNCTION AMIN(A) result(AMINA) REAL(ReKi), INTENT(IN ) :: A - REAL(ReKi), INTENT(OUT ) :: AMINA REAL(ReKi) :: X1 + X1 = ABS(A) - IF (X1 .LE. .204) AMINA=SQRT(67.552-886.788*X1**2)-8.219 - IF((X1 .GT. .204).AND.(X1 .LE. .244))AMINA=-32.665*X1+3.981 - IF (X1 .GT. .244)AMINA=-142.795*X1**3+103.656*X1**2-57.757*X1+6.006 -END SUBROUTINE AMIN + IF (X1 .LE. .204) then + AMINA=SQRT(67.552-886.788*X1**2)-8.219 + elseif (X1 .LE. .244) then + AMINA=-32.665*X1+3.981 + else + AMINA=-142.795*X1**3+103.656*X1**2-57.757*X1+6.006 + end if + +END FUNCTION AMIN !==================================================================================================== !> This subroutine defines the curve fit corresponding to the a-curve for the maximum allowed reynolds number. -SUBROUTINE AMAX(A,AMAXA) +REAL(ReKi) FUNCTION AMAX(A) result(AMAXA) REAL(ReKi), INTENT(IN ) :: A - REAL(ReKi), INTENT(OUT ) :: AMAXA REAL(ReKi) :: X1 + X1 = ABS(A) - IF (X1 .LE. .13)AMAXA=SQRT(67.552-886.788*X1**2)-8.219 - IF((X1 .GT. .13).AND.(X1 .LE. .321))AMAXA=-15.901*X1+1.098 - IF (X1 .GT. .321)AMAXA=-4.669*X1**3+3.491*X1**2-16.699*X1+1.149 -END SUBROUTINE AMAX + IF (X1 .LE. .13) then + AMAXA=SQRT(67.552-886.788*X1**2)-8.219 + elseif (X1 .LE. .321) then + AMAXA=-15.901*X1+1.098 + else + AMAXA=-4.669*X1**3+3.491*X1**2-16.699*X1+1.149 + end if + +END FUNCTION AMAX !==================================================================================================== !> This subroutine defines the curve fit corresponding to the b-curve for the minimum allowed reynolds number. -SUBROUTINE BMIN(B,BMINB) +REAL(ReKi) FUNCTION BMIN(B) result(BMINB) REAL(ReKi), INTENT(IN ) :: B - REAL(ReKi), INTENT(OUT ) :: BMINB REAL(ReKi) :: X1 + X1 = ABS(B) - IF (X1 .LE. .13)BMINB=SQRT(16.888-886.788*X1**2)-4.109 - IF((X1 .GT. .13).AND.(X1 .LE. .145))BMINB=-83.607*X1+8.138 - IF (X1.GT..145)BMINB=-817.81*X1**3+355.21*X1**2-135.024*X1+10.619 -END SUBROUTINE BMin + IF (X1 .LE. .13) then + BMINB=SQRT(16.888-886.788*X1**2)-4.109 + elseif (X1 .LE. .145) then + BMINB=-83.607*X1+8.138 + else + BMINB=-817.81*X1**3+355.21*X1**2-135.024*X1+10.619 + end if + +END FUNCTION BMin !==================================================================================================== !> Define the curve fit corresponding to the b-curve for the maximum allowed reynolds number. -SUBROUTINE BMAX(B,BMAXB) +REAL(ReKi) FUNCTION BMAX(B) result(BMAXB) REAL(ReKi), INTENT(IN ) :: B - REAL(ReKi), INTENT(OUT ) :: BMAXB REAL(ReKi) :: X1 X1 = ABS(B) - IF (X1 .LE. .1) BMAXB=SQRT(16.888-886.788*X1**2)-4.109 - IF((X1 .GT. .1).AND.(X1 .LE. .187))BMAXB=-31.313*X1+1.854 - IF (X1.GT..187)BMAXB=-80.541*X1**3+44.174*X1**2-39.381*X1+2.344 -END SUBROUTINE BMax + IF (X1 .LE. .1) then + BMAXB=SQRT(16.888-886.788*X1**2)-4.109 + else if (X1 .LE. .187) then + BMAXB=-31.313*X1+1.854 + else + BMAXB=-80.541*X1**3+44.174*X1**2-39.381*X1+2.344 + end if +END FUNCTION BMax !==================================================================================================== !> Determine where the a-curve takes on a value of -20 db. -SUBROUTINE A0COMP(RC,A0) +REAL(ReKi) FUNCTION A0COMP(RC) result(A0) REAL(ReKi), INTENT(IN ) :: RC - REAL(ReKi), INTENT(OUT ) :: A0 - IF (RC .LT. 9.52E+04) A0 = .57 - IF ((RC .GE. 9.52E+04).AND.(RC .LT. 8.57E+05)) & - A0 = (-9.57E-13)*(RC-8.57E+05)**2 + 1.13 - IF (RC .GE. 8.57E+05) A0 = 1.13 -END SUBROUTINE A0COMP + IF (RC .LT. 9.52E+04) then + A0 = .57 + elseif (RC .LT. 8.57E+05) then + A0 = (-9.57E-13)*(RC-8.57E+05)**2 + 1.13 + else + A0 = 1.13 + end if +END FUNCTION A0COMP !==================================================================================================== !> Compute zero angle of attack boundary layer thickness (meters) and reynolds number -SUBROUTINE THICK(C,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal,errStat,errMsg) +SUBROUTINE THICK(C,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal) !! VARIABLE NAME DEFINITION UNITS !! ------------- ---------- ----- !! ALPSTAR ANGLE OF ATTACK DEGREES @@ -2097,166 +1970,165 @@ SUBROUTINE THICK(C,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal,errStat,errMsg) !! RC REYNOLDS NUMBER BASED ON CHORD --- !! U FREESTREAM VELOCITY METERS/SEC !! KinViscosity KINEMATIC VISCOSITY M2/SEC - REAL(ReKi), INTENT(IN ) :: ALPSTAR !< AOA + REAL(ReKi), INTENT(IN ) :: ALPSTAR !< AOA, deg REAL(ReKi), INTENT(IN ) :: C !< Chord Length REAL(ReKi), INTENT(IN ) :: RC !< RC= U*C/KinViscosity TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters - REAL(ReKi), INTENT( OUT) :: DELTAP !< - REAL(ReKi), INTENT( OUT) :: DSTRS !< - REAL(ReKi), INTENT( OUT) :: DSTRP !< + REAL(ReKi), INTENT( OUT) :: DELTAP !< Pressure side boundary layer thickness + REAL(ReKi), INTENT( OUT) :: DSTRS !< Suction side displacement thickness + REAL(ReKi), INTENT( OUT) :: DSTRP !< Pressure side displacement thickness REAL(ReKi), INTENT(IN ) :: StallVal !< Stall angle at station i - INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation - character(*), INTENT( OUT) :: errMsg !< Error message if ErrStat /= ErrID_None + ! Local variables ! integer(intKi) :: ErrStat2 ! temporary Error status ! character(ErrMsgLen) :: ErrMsg2 ! temporary Error message character(*), parameter :: RoutineName = 'Thick' real(ReKi) :: DELTA0 ! BOUNDARY LAYER THICKNESS AT ZERO ANGLE OF ATTACK METERS real(ReKi) :: DSTR0 ! DISPLACEMENT THICKNESS AT ZERO ANGLE OF ATTACK METERS - ErrStat = ErrID_None - ErrMsg = "" + real(ReKi) :: LogRC ! LOG10(RC) + + LogRC = LOG10AA( RC ) + ! Boundary layer thickness - DELTA0 = 10.**(1.6569-0.9045*LOG10(RC)+0.0596*LOG10(RC)**2)*C ! (untripped) Eq. (5) of [1] - IF (p%ITRIP .GT. 0) DELTA0 = 10.**(1.892 -0.9045*LOG10(RC)+0.0596*LOG10(RC)**2)*C ! (heavily tripped) Eq. (2) of [1] - IF (p%ITRIP .EQ. 2) DELTA0=.6*DELTA0 + DELTA0 = 10.**(1.6569-0.9045*LogRC+0.0596*LogRC**2)*C ! (untripped) Eq. (5) of [1] + IF (p%ITRIP /= ITRIP_None) DELTA0 = 10.**(1.892 -0.9045*LogRC+0.0596*LogRC**2)*C ! (heavily tripped) Eq. (2) of [1] + IF (p%ITRIP .EQ. ITRIP_Light) DELTA0=.6*DELTA0 + ! Pressure side boundary layer thickness, Eq (8) of [1] DELTAP = 10.**(-.04175*ALPSTAR+.00106*ALPSTAR**2)*DELTA0 + ! Compute zero angle of attack displacement thickness - IF ((p%ITRIP .EQ. 1) .OR. (p%ITRIP .EQ. 2)) THEN + IF (p%ITRIP /= ITRIP_None) THEN ! Heavily tripped, Eq. (3) of [1] - IF (RC .LE. .3E+06) DSTR0 = .0601 * RC **(-.114)*C - IF (RC .GT. .3E+06) & - DSTR0=10.**(3.411-1.5397*LOG10(RC)+.1059*LOG10(RC)**2)*C + IF (RC .LE. .3E+06) THEN + DSTR0 = .0601 * RC **(-.114)*C + ELSE + DSTR0=10.**(3.411-1.5397*LogRC+.1059*LogRC**2)*C + END IF ! Lightly tripped - IF (p%ITRIP .EQ. 2) DSTR0 = DSTR0 * .6 + IF (p%ITRIP .EQ. ITRIP_Light) DSTR0 = DSTR0 * .6 ELSE ! Untripped, Eq. (6) of [1] - DSTR0=10.**(3.0187-1.5397*LOG10(RC)+.1059*LOG10(RC)**2)*C + DSTR0=10.**(3.0187-1.5397*LogRC+.1059*LogRC**2)*C ENDIF + ! Pressure side displacement thickness, Eq. (9) of [1] - DSTRP = 10.**(-.0432*ALPSTAR+.00113*ALPSTAR**2)*DSTR0 + DSTRP = 10.**(-.0432*ALPSTAR+.00113*ALPSTAR**2)*DSTR0 ! IF (p%ITRIP .EQ. 3) DSTRP = DSTRP * 1.48 ! commented since itrip is never 3 check if meant 2.(EB_DTU) + ! Suction side displacement thickness - IF (p%ITRIP .EQ. 1) THEN - ! Heavily tripped, Eq. (12) of [1] - IF (ALPSTAR .LE. 5.) DSTRS=10.**(.0679*ALPSTAR)*DSTR0 - IF((ALPSTAR .GT. 5.).AND.(ALPSTAR .LE. StallVal)) & - DSTRS = .381*10.**(.1516*ALPSTAR)*DSTR0 - IF (ALPSTAR .GT. StallVal)DSTRS=14.296*10.**(.0258*ALPSTAR)*DSTR0 - ELSE + IF (p%ITRIP .EQ. ITRIP_Heavy) THEN + ! Heavily tripped, Eq. (12) of [1] + IF (ALPSTAR .LE. 5.) THEN + DSTRS=10.**(.0679*ALPSTAR)*DSTR0 + ELSEIF (ALPSTAR .LE. StallVal) THEN + DSTRS = 0.381 * 10.**(.1516*ALPSTAR)*DSTR0 + ELSE + DSTRS = 14.296 * 10.**(.0258*ALPSTAR)*DSTR0 + ENDIF + ELSE ! Untripped or lightly tripped, Eq. (15) of [1] - IF (ALPSTAR .LE. 7.5)DSTRS =10.**(.0679*ALPSTAR)*DSTR0 - IF((ALPSTAR .GT. 7.5).AND.(ALPSTAR .LE. StallVal)) & - DSTRS = .0162*10.**(.3066*ALPSTAR)*DSTR0 - IF (ALPSTAR .GT. StallVal) DSTRS = 52.42*10.**(.0258*ALPSTAR)*DSTR0 - ENDIF + IF (ALPSTAR .LE. 7.5) THEN + DSTRS =10.**(.0679*ALPSTAR)*DSTR0 + ELSEIF(ALPSTAR .LE. StallVal) THEN + DSTRS = .0162*10.**(.3066*ALPSTAR)*DSTR0 + ELSE + DSTRS = 52.42*10.**(.0258*ALPSTAR)*DSTR0 + ENDIF + ENDIF + END SUBROUTINE Thick !==================================================================================================== !> This subroutine computes the high frequency directivity function for the trailing edge -SUBROUTINE DIRECTH_TE(M,THETA,PHI,DBAR, errStat, errMsg) +REAL(ReKi) FUNCTION DIRECTH_TE(M,THETA,PHI) result(DBAR) REAL(ReKi), INTENT(IN ) :: THETA ! REAL(ReKi), INTENT(IN ) :: PHI ! REAL(ReKi), INTENT(IN ) :: M ! - REAL(ReKi), INTENT( OUT) :: DBAR ! - INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation - character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None ! Local variables - character(*), parameter :: RoutineName = 'Directh_te' real(ReKi) :: MC - real(ReKi) :: DEGRAD + real(ReKi), parameter :: DEGRAD = .017453 real(ReKi) :: PHIR real(ReKi) :: THETAR - ErrStat = ErrID_None - ErrMsg = "" - DEGRAD = .017453 + MC = .8 * M THETAR = THETA * DEGRAD PHIR = PHI * DEGRAD - DBAR = 2.*SIN(THETAR/2.)**2*SIN(PHIR)**2/((1.+M*COS(THETAR))* (1.+(M-MC)*COS(THETAR))**2) ! eq B1 in BPM Airfoil Self-noise and Prediction paper -END SUBROUTINE DIRECTH_TE + DBAR = 2.*SIN(THETAR/2.)**2 * SIN(PHIR)**2 / ((1.+M*COS(THETAR))* (1.+(M-MC)*COS(THETAR))**2) ! eq B1 in BPM Airfoil Self-noise and Prediction paper +END FUNCTION DIRECTH_TE !==================================================================================================== !> This subroutine computes the high frequency directivity function for the leading edge -SUBROUTINE DIRECTH_LE(M,THETA,PHI,DBAR, errStat, errMsg) +REAL(ReKi) FUNCTION DIRECTH_LE(M,THETA,PHI) result(DBAR) REAL(ReKi), INTENT(IN ) :: THETA ! REAL(ReKi), INTENT(IN ) :: PHI ! REAL(ReKi), INTENT(IN ) :: M ! - REAL(ReKi), INTENT( OUT) :: DBAR ! - INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation - character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None + ! Local variables - character(*), parameter :: RoutineName = 'Directh_le' - real(ReKi) :: DEGRAD + real(ReKi), parameter :: DEGRAD = .017453 real(ReKi) :: PHIR real(ReKi) :: THETAR - ErrStat = ErrID_None - ErrMsg = "" - DEGRAD = .017453 + THETAR = THETA * DEGRAD PHIR = PHI * DEGRAD DBAR = 2.*COS(THETAR/2.)**2*SIN(PHIR)**2/(1.+M*COS(THETAR))**3 -END SUBROUTINE DIRECTH_LE +END FUNCTION DIRECTH_LE !==================================================================================================== !> This subroutine computes the high frequency directivity function for the input observer location ! Paper: -SUBROUTINE DIRECTL(M,THETA,PHI,DBAR, errStat, errMsg) +REAL(ReKi) FUNCTION DIRECTL(M,THETA,PHI) result(DBAR) REAL(ReKi), INTENT(IN ) :: THETA !< REAL(ReKi), INTENT(IN ) :: PHI !< REAL(ReKi), INTENT(IN ) :: M !< - REAL(ReKi), INTENT( OUT) :: DBAR !< - INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation - character(*), INTENT( OUT) :: errMsg !< Error message if ErrStat /= ErrID_None + ! Local variables - character(*), parameter :: RoutineName = 'DirectL' real(ReKi) :: MC - real(ReKi) :: DEGRAD + real(ReKi), parameter :: DEGRAD = .017453 real(ReKi) :: PHIR real(ReKi) :: THETAR - ErrStat = ErrID_None - ErrMsg = "" + ! This subroutine computes the low frequency directivity function for the input observer location - DEGRAD = .017453 + MC = .8 * M THETAR = THETA * DEGRAD PHIR = PHI * DEGRAD DBAR = (SIN(THETAR)*SIN(PHIR))**2/(1.+M*COS(THETAR))**4 ! eq B2 in BPM Airfoil Self-noise and Prediction paper -END SUBROUTINE DIRECTL +END FUNCTION DIRECTL !==================================================================================================================================! !=============================== Simplified Guidati Inflow Turbulence Noise Addition =============================================! !==================================================================================================================================! ! Uses simple correction for turbulent inflow noise from Moriarty et. al 2005 ! Paper: Prediction of Turbulent Inflow and Trailing-Edge Noise for Wind Turbines, by Moriarty, Guidati, and Migliore -SUBROUTINE Simple_Guidati(U,Chord,thick_10p,thick_1p,p,SPLti,errStat,errMsg) +SUBROUTINE Simple_Guidati(U,Chord,thick_10p,thick_1p,p,SPLti) REAL(ReKi), INTENT(IN ) :: U ! Vrel REAL(ReKi), INTENT(IN ) :: Chord ! Chord Length REAL(ReKi), INTENT(IN ) :: thick_10p ! REAL(ReKi), INTENT(IN ) :: thick_1p ! TYPE(AA_ParameterType), INTENT(IN ) :: p ! Parameters REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLti ! - INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation - character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None ! local variables -! integer(intKi) :: ErrStat2 ! temporary Error status -! character(ErrMsgLen) :: ErrMsg2 ! temporary Error message character(*), parameter :: RoutineName = 'Simple_Guidati' INTEGER(intKi) :: loop1 ! temporary REAL(ReKi) :: TI_Param ! Temporary variable thickness ratio dependent REAL(ReKi) :: slope ! Temporary variable thickness ratio dependent + REAL(ReKi) :: const1 ! Temporary variable + REAL(ReKi) :: const2 ! Temporary variable - ErrStat = ErrID_None - ErrMsg = "" - TI_Param = thick_1p + thick_10p ! Eq 2 slope = 1.123*TI_Param + 5.317*TI_Param*TI_Param ! Eq 3 + const1 = -slope*TwoPi*chord/U + const2 = -slope*5.0d0 + do loop1 =1,size(p%FreqList) - SPLti(loop1) = -slope*(2*PI*p%FreqList(loop1)*chord/U + 5.0d0) ! Eq 4 +! SPLti(loop1) = -slope*(TwoPi * chord/U * p%FreqList(loop1) + 5.0d0) ! Eq 4 + SPLti(loop1) = const1 * p%FreqList(loop1) + const2 ! Eq 4 enddo ! Outputs Delta_SPL, the difference in SPL between the airfoil and a flat plate. + END SUBROUTINE Simple_Guidati !==================================================================================================================================! !================================ Turbulent Boundary Layer Trailing Edge Noise ====================================================! !=================================================== TNO START ====================================================================! -SUBROUTINE TBLTE_TNO(U,THETA,PHI,D,R,Cfall,d99all,EdgeVelAll,p,SPLP,SPLS,SPLALPH,SPLTBL,errStat,errMsgn) +SUBROUTINE TBLTE_TNO(U,THETA,PHI,D,R,Cfall,d99all,EdgeVelAll,p,SPLP,SPLS) USE TNO, only: SPL_integrate REAL(ReKi), INTENT(IN ) :: U !< Unoise (m/s) REAL(ReKi), INTENT(IN ) :: THETA !< DIRECTIVITY ANGLE (deg) @@ -2267,23 +2139,18 @@ SUBROUTINE TBLTE_TNO(U,THETA,PHI,D,R,Cfall,d99all,EdgeVelAll,p,SPLP,SPLS,SPLALPH REAL(ReKi),DIMENSION(2), INTENT(IN ) :: d99all !< REAL(ReKi),DIMENSION(2), INTENT(IN ) :: EdgeVelAll !< TYPE(AA_ParameterType), INTENT(IN ) :: p !< Noise Module Parameters - REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT(IN ) :: SPLALPH !< SOUND PRESSURE LEVEL DUE TO ANGLE OF ATTACK CONTRIBUTION (db) +! REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT(IN ) :: SPLALPH !< SOUND PRESSURE LEVEL DUE TO ANGLE OF ATTACK CONTRIBUTION (db) REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLP !< SOUND PRESSURE LEVEL DUE TO PRESSURE SIDE OF AIRFOIL (db) REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLS !< SOUND PRESSURE LEVEL DUE TO SUCTION SIDE OF AIRFOIL (db) - REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLTBL !< TOTAL SOUND PRESSURE LEVEL DUE TO TBLTE MECHANISM (db) - INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation - character(*), INTENT( OUT) :: errMsgn !< Error message if ErrStat /= ErrID_None + ! Local variables - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'TBLTE_TNO' REAL(ReKi) :: answer REAL(ReKi) :: Spectrum REAL(ReKi) :: freq(size(p%FreqList)) REAL(ReKi) :: SPL_press,SPL_suction REAL(ReKi) :: band_width,band_ratio REAL(ReKi) :: DBARH - REAL(ReKi) :: P1,P2,P4 + !REAL(ReKi) :: P1,P2,P4 INTEGER (4) :: n_freq INTEGER (4) :: i_omega @@ -2295,8 +2162,10 @@ SUBROUTINE TBLTE_TNO(U,THETA,PHI,D,R,Cfall,d99all,EdgeVelAll,p,SPLP,SPLS,SPLALPH ! Init n_freq = size(p%FreqList) freq = p%FreqList - ErrStat = ErrID_None - ErrMsgn = "" + + SPLS = 0.0_ReKi ! initialize in case Cfall(1) <= 0 + SPLP = 0.0_ReKi ! initialize in case Cfall(2) <= 0 + ! Body of TNO band_ratio = 2.**(1./3.) @@ -2304,16 +2173,16 @@ SUBROUTINE TBLTE_TNO(U,THETA,PHI,D,R,Cfall,d99all,EdgeVelAll,p,SPLP,SPLS,SPLALPH Mach = U / p%SpdSound ! Directivity function - CALL DIRECTH_TE(REAL(Mach,ReKi),THETA,PHI,DBARH,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsgn, RoutineName ) + DBARH = DIRECTH_TE(REAL(Mach,ReKi),THETA,PHI) do i_omega = 1,n_freq - omega = 2.*pi*freq(i_omega) + omega = TwoPi*p%FreqList(i_omega) !integration limits int_limits(1) = 0.0e0 int_limits(2) = 10*omega/(Mach*p%SpdSound) ! Convert to third octave - band_width = freq(i_omega)*(sqrt(band_ratio)-1./sqrt(band_ratio)) * 4. * pi + band_width = 2. * omega * (sqrt(band_ratio)-1./sqrt(band_ratio)) + IF (Cfall(1) .GT. 0.) THEN answer = SPL_integrate(omega=omega,limits=int_limits,ISSUCTION=.true., & Mach=Mach,SpdSound=p%SpdSound,AirDens=p%AirDens,KinVisc=p%KinVisc, & @@ -2336,126 +2205,119 @@ SUBROUTINE TBLTE_TNO(U,THETA,PHI,D,R,Cfall,d99all,EdgeVelAll,p,SPLP,SPLS,SPLALPH IF (SPLP(i_omega) .LT. -100.) SPLP(i_omega) = -100. IF (SPLS(i_omega) .LT. -100.) SPLS(i_omega) = -100. - P1 = 10.**(SPLP(i_omega) / 10.) - P2 = 10.**(SPLS(i_omega) / 10.) - P4 = 10.**(SPLALPH(i_omega) / 10.) - SPLTBL(i_omega) = 10. * LOG10(P1 + P2 + P4) + !P1 = 10.**(SPLP(i_omega) / 10.) + !P2 = 10.**(SPLS(i_omega) / 10.) + !P4 = 10.**(SPLALPH(i_omega) / 10.) + ! + !SPLTBL(i_omega) = 10. * LOG10(P1 + P2 + P4) enddo END SUBROUTINE TBLTE_TNO !==================================================================================================== -SUBROUTINE BL_Param_Interp(p,m,U,AlphaNoise,C,whichairfoil, errStat, errMsg) - TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AA_MiscVarType), INTENT(INOUT) :: m !< misc/optimization data (not defined in submodules) - REAL(ReKi), INTENT(IN ) :: U !< METERS/SEC - REAL(ReKi), INTENT(IN ) :: AlphaNoise !< Angle of Attack DEG - REAL(ReKi), INTENT(IN ) :: C !< Chord METERS - integer(intKi), INTENT(IN ) :: whichairfoil !< whichairfoil - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - character(*), parameter :: RoutineName = 'BL_Param_Interp' - REAL(ReKi) :: redif1,redif2,aoadif1,aoadif2,xx1,xx2,RC - INTEGER(intKi) :: loop1,loop2 - logical :: re_flag - ErrStat = ErrID_None - ErrMsg = "" +SUBROUTINE BL_Param_Interp(p,m,U,AlphaNoise_Deg,C,whichAirfoil) + TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(AA_MiscVarType), INTENT(INOUT) :: m !< misc/optimization data (not defined in submodules) + REAL(ReKi), INTENT(IN ) :: U !< METERS/SEC + REAL(ReKi), INTENT(IN ) :: AlphaNoise_Deg !< Angle of Attack DEG + REAL(ReKi), INTENT(IN ) :: C !< Chord METERS + integer(intKi), INTENT(IN ) :: whichAirfoil !< whichairfoil + + character(*), parameter :: RoutineName = 'BL_Param_Interp' + REAL(ReKi) :: RC + INTEGER(intKi) :: i + + INTEGER, PARAMETER :: NumDimensions = 2 + INTEGER(IntKi) :: MaxIndx(NumDimensions) ! max sizes associated with each dimension of array + INTEGER(IntKi) :: Indx_Lo(NumDimensions) ! index associated with lower bound of dimension 1,2 where val(Indx_lo(i)) <= InCoord(i) <= val(Indx_hi(i)) + INTEGER(IntKi) :: Indx_Hi(NumDimensions) ! index associated with upper bound of dimension 1,2 where val(Indx_lo(i)) <= InCoord(i) <= val(Indx_hi(i)) + REAL(ReKi) :: Pos_Lo(NumDimensions) ! coordinate value with lower bound of dimension 1,2 + REAL(ReKi) :: Pos_Hi(NumDimensions) ! coordinate value with upper bound of dimension 1,2 + + REAL(ReKi) :: isopc(NumDimensions) ! isoparametric coordinates + REAL(ReKi) :: N(2**NumDimensions) ! size 2^n + REAL(ReKi) :: InCoord(NumDimensions) !< Arranged as (x, y) + !!!! this if is not used but if necessary two sets of tables can be populated for tripped and untripped cases - RC = U * C/p%KinVisc ! REYNOLDS NUMBER BASED ON CHORD - - re_flag = .FALSE. - DO loop1=1,size(p%ReListBL)-1 - IF ( (RC.le.p%ReListBL(loop1+1)) .and. (RC.gt.p%ReListBL(loop1)) ) then - re_flag = .TRUE. - redif1=abs(RC-p%ReListBL(loop1+1)) - redif2=abs(RC-p%ReListBL(loop1)) - DO loop2=1,size(p%AOAListBL)-1 - - if ( (AlphaNoise.le.p%AOAListBL(loop2+1)) .and. (AlphaNoise.gt.p%AOAListBL(loop2)) ) then - aoadif1=abs(AlphaNoise-p%AOAListBL(loop2+1)) - aoadif2=abs(AlphaNoise-p%AOAListBL(loop2)) - - xx1=( p%dstarall1(loop2,loop1+1,whichairfoil)*redif2+p%dstarall1(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - xx2=( p%dstarall1(loop2+1,loop1+1,whichairfoil)*redif2+p%dstarall1(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%dstarVar(1)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) - - xx1=( p%dstarall2(loop2,loop1+1,whichairfoil)*redif2+p%dstarall2(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - xx2=( p%dstarall2(loop2+1,loop1+1,whichairfoil)*redif2+p%dstarall2(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%dstarVar(2)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) - - xx1=( p%d99all1(loop2,loop1+1,whichairfoil)*redif2+p%d99all1(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - xx2=( p%d99all1(loop2+1,loop1+1,whichairfoil)*redif2+p%d99all1(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%d99Var(1)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) - - xx1=( p%d99all2(loop2,loop1+1,whichairfoil)*redif2+p%d99all2(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - xx2=( p%d99all2(loop2+1,loop1+1,whichairfoil)*redif2+p%d99all2(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%d99Var(2)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) - - xx1=( p%Cfall1(loop2,loop1+1,whichairfoil)*redif2+p%Cfall1(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - xx2=( p%Cfall1(loop2+1,loop1+1,whichairfoil)*redif2+p%Cfall1(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%CfVar(1)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) - - xx1=( p%Cfall2(loop2,loop1+1,whichairfoil)*redif2+p%Cfall2(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - xx2=( p%Cfall2(loop2+1,loop1+1,whichairfoil)*redif2+p%Cfall2(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%CfVar(2)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) - - xx1=( p%EdgeVelRat1(loop2,loop1+1,whichairfoil)*redif2+p%EdgeVelRat1(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - xx2=( p%EdgeVelRat1(loop2+1,loop1+1,whichairfoil)*redif2+p%EdgeVelRat1(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%EdgeVelVar(1)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) - - xx1=( p%EdgeVelRat2(loop2,loop1+1,whichairfoil)*redif2+p%EdgeVelRat2(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - xx2=( p%EdgeVelRat2(loop2+1,loop1+1,whichairfoil)*redif2+p%EdgeVelRat2(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%EdgeVelVar(2)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) - - return ! We exit the routine ! - endif - if (loop2 .eq. (size(p%AOAListBL)-1) ) then - - if (AlphaNoise .gt. p%AOAListBL(size(p%AOAListBL))) then - CALL WrScr( 'Warning AeroAcoustics Module - Angle of attack (AoA) range is not in the range provided by the user') - CALL WrScr( 'Station '// trim(num2lstr(whichairfoil)) ) - CALL WrScr( 'Airfoil AoA '//trim(num2lstr(AlphaNoise))//'; Using the closest AoA '//trim(num2lstr(p%AOAListBL(loop2+1)))) - m%dStarVar (1) = ( p%dstarall1 (loop2+1,loop1+1,whichairfoil)*redif2 + p%dstarall1 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) - m%dStarVar (2) = ( p%dstarall2 (loop2+1,loop1+1,whichairfoil)*redif2 + p%dstarall2 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) - m%d99Var (1) = ( p%d99all1 (loop2+1,loop1+1,whichairfoil)*redif2 + p%d99all1 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) - m%d99Var (2) = ( p%d99all2 (loop2+1,loop1+1,whichairfoil)*redif2 + p%d99all2 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) - m%CfVar (1) = ( p%Cfall1 (loop2+1,loop1+1,whichairfoil)*redif2 + p%Cfall1 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) - m%CfVar (2) = ( p%Cfall2 (loop2+1,loop1+1,whichairfoil)*redif2 + p%Cfall2 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) - m%EdgeVelVar(1) = ( p%EdgeVelRat1(loop2+1,loop1+1,whichairfoil)*redif2 + p%EdgeVelRat1(loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) - m%EdgeVelVar(2) = ( p%EdgeVelRat2(loop2+1,loop1+1,whichairfoil)*redif2 + p%EdgeVelRat2(loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) - elseif (AlphaNoise .lt. p%AOAListBL(1)) then - CALL WrScr( 'Warning AeroAcoustics Module - Angle of attack (AoA) range is not in the range provided by the user') - CALL WrScr( 'Station '// trim(num2lstr(whichairfoil)) ) - CALL WrScr( 'Airfoil AoA '//trim(num2lstr(AlphaNoise))//'; Using the closest AoA '//trim(num2lstr(p%AOAListBL(1))) ) - m%dStarVar(1) = ( p%dstarall1 (1,loop1+1,whichairfoil)*redif2 + p%dstarall1 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%dStarVar(2) = ( p%dstarall2 (1,loop1+1,whichairfoil)*redif2 + p%dstarall2 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%d99Var(1) = ( p%d99all1 (1,loop1+1,whichairfoil)*redif2 + p%d99all1 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%d99Var(2) = ( p%d99all2 (1,loop1+1,whichairfoil)*redif2 + p%d99all2 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%CfVar(1) = ( p%Cfall1 (1,loop1+1,whichairfoil)*redif2 + p%Cfall1 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%CfVar(2) = ( p%Cfall2 (1,loop1+1,whichairfoil)*redif2 + p%Cfall2 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%EdgeVelVar(1) = ( p%EdgeVelRat1(1,loop1+1,whichairfoil)*redif2 + p%EdgeVelRat1(1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%EdgeVelVar(2) = ( p%EdgeVelRat2(1,loop1+1,whichairfoil)*redif2 + p%EdgeVelRat2(1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - endif - endif - enddo - endif - enddo - if (.not. re_flag) then - call SetErrStat( ErrID_Fatal, 'Warning AeroAcoustics Module - the Reynolds number is not in the range provided by the user. Code stopping.', ErrStat, ErrMsg, RoutineName ) - stop - endif + RC = U * C/p%KinVisc ! REYNOLDS NUMBER BASED ON CHORD + + + ! find the indices into the arrays representing coordinates of each dimension: + ! (by using LocateStp, we do not require equally spaced arrays) + InCoord = (/ AlphaNoise_Deg, RC /) + + MaxIndx(1) = SIZE(p%AOAListBL) + MaxIndx(2) = SIZE(p%ReListBL) + + CALL LocateStp( InCoord(1), p%AOAListBL, m%LastIndex(1), MaxIndx(1) ) + CALL LocateStp( InCoord(2), p%ReListBL, m%LastIndex(2), MaxIndx(2) ) + + Indx_Lo = m%LastIndex ! at this point, 0 <= Indx_Lo(i) <= n(i) for all i + + ! RE (indx 2) + do i = 1,2 + IF (Indx_Lo(i) == 0) THEN + Indx_Lo(i) = 1 + ELSEIF (Indx_Lo(i) == MaxIndx(i) ) THEN + Indx_Lo(i) = max( MaxIndx(i) - 1, 1 ) ! make sure it's a valid index + END IF + Indx_Hi(i) = min( Indx_Lo(i) + 1 , MaxIndx(i) ) ! make sure it's a valid index + end do + + ! calculate the bounding box; the positions of all dimensions: + + pos_Lo(1) = p%AOAListBL( Indx_Lo(1) ) + pos_Hi(1) = p%AOAListBL( Indx_Hi(1) ) + + pos_Lo(2) = p%ReListBL( Indx_Lo(2) ) + pos_Hi(2) = p%ReListBL( Indx_Hi(2) ) + + + ! 2-D linear interpolation: + + CALL IsoparametricCoords( InCoord, pos_Lo, pos_Hi, isopc ) ! Calculate iospc + + N(1) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) ) + N(2) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) ) + N(3) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) ) + N(4) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) ) + N = N / REAL( SIZE(N), ReKi ) ! normalize + + m%dStarVar (1) = InterpData( p%dstarall1( :,:,whichAirfoil) ) + m%dStarVar (2) = InterpData( p%dstarall2( :,:,whichAirfoil) ) + m%d99Var (1) = InterpData( p%d99all1( :,:,whichAirfoil) ) + m%d99Var (2) = InterpData( p%d99all2( :,:,whichAirfoil) ) + m%CfVar (1) = InterpData( p%Cfall1( :,:,whichAirfoil) ) + m%CfVar (2) = InterpData( p%Cfall2( :,:,whichAirfoil) ) + m%EdgeVelVar(1) = InterpData( p%EdgeVelRat1(:,:,whichAirfoil) ) + m%EdgeVelVar(2) = InterpData( p%EdgeVelRat2(:,:,whichAirfoil) ) + +contains + real(ReKi) function InterpData(Dataset) + REAL(ReKi), INTENT(IN ) :: Dataset(:,:) !< Arranged as (x, y) + REAL(ReKi) :: u(2**NumDimensions) ! size 2^n + + u(1) = Dataset( Indx_Hi(1), Indx_Lo(2) ) + u(2) = Dataset( Indx_Hi(1), Indx_Hi(2) ) + u(3) = Dataset( Indx_Lo(1), Indx_Hi(2) ) + u(4) = Dataset( Indx_Lo(1), Indx_Lo(2) ) + + InterpData = SUM ( N * u ) + + end function END SUBROUTINE BL_Param_Interp + SUBROUTINE Aero_Tests() !--------Laminar Boundary Layer Vortex Shedding Noise----------------------------! - !CALL LBLVS(AlphaNoise,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & + !CALL LBLVS(AlphaNoise_Deg,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & ! elementspan,m%rTEtoObserve(K,J,I), & - ! p,m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLLBL,ErrStat2,errMsg2) + ! p,m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLLBL) !--------Turbulent Boundary Layer Trailing Edge Noise----------------------------! !CALL TBLTE(3.0d0,0.22860d0,63.920d0,90.0d0,90.0d0,0.5090d0,1.220d0, & - ! p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),p%StallStart(J,I),m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,ErrStat2,errMsg2 ) + ! p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),p%StallStart(J,I),m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL ) !m%SPLP=0.0_ReKi;m%SPLS=0.0_ReKi;m%SPLTBL=0.0_ReKi; !m%EdgeVelVar(1)=1.000d0;m%EdgeVelVar(2)=m%EdgeVelVar(1); !m%CfVar(1) = 0.0003785760d0;m%CfVar(2) = 0.001984380d0;m%d99var(1)= 0.01105860d0; m%d99var(2)= 0.007465830d0;m%EdgeVelVar(1)=1.000d0;m%EdgeVelVar(2)=m%EdgeVelVar(1); @@ -2463,15 +2325,15 @@ SUBROUTINE Aero_Tests() ! m%CfVar,m%d99var,m%EdgeVelVar, p, m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,ErrStat2 ,errMsg2) !--------Blunt Trailing Edge Noise----------------------------------------------! !CALL BLUNT(3.0d0,0.22860d0,63.920d0,90.0d0,90.0d0,0.5090d0,1.220d0,& - ! p%TEThick(J,I),p%TEAngle(J,I),p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLBLUNT,ErrStat2,errMsg2 ) + ! p%TEThick(J,I),p%TEAngle(J,I),p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLBLUNT ) !--------Tip Noise--------------------------------------------------------------! - !CALL TIPNOIS(AlphaNoise,p%ALpRAT,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & + !CALL TIPNOIS(AlphaNoise_Deg,p%ALpRAT,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & ! m%rTEtoObserve(K,J,I), p, m%SPLTIP,ErrStat2,errMsg2) !--------Inflow Turbulence Noise ------------------------------------------------! - !CALL InflowNoise(3.0d0,0.22860d0,63.920d0,90.0d0,90.0d0,0.5090d0,1.220d0, xd%TIVx(J,I),0.050d0,p,m%SPLti,ErrStat2,errMsg2 ) + !CALL InflowNoise(3.0d0,0.22860d0,63.920d0,90.0d0,90.0d0,0.5090d0,1.220d0, xd%TIVx(J,I),0.050d0,p,m%SPLti ) !CALL FullGuidati(3.0d0,63.920d0,0.22860d0,0.5090d0,1.220d0,90.0d0,90.0d0,xd%MeanVrel(J,I),xd%TIVrel(J,I), & ! p,p%BlAFID(J,I),m%SPLTIGui,ErrStat2 ) - !CALL Simple_Guidati(UNoise,0.22860d0,0.120d0,0.020d0,p,m%SPLTIGui,ErrStat2,errMsg2 ) + !CALL Simple_Guidati(UNoise,0.22860d0,0.120d0,0.020d0,p,m%SPLTIGui) END SUBROUTINE END MODULE AeroAcoustics diff --git a/modules/aerodyn/src/AeroAcoustics_Driver.f90 b/modules/aerodyn/src/AeroAcoustics_Driver.f90 new file mode 100644 index 0000000000..ea5bdbf6bd --- /dev/null +++ b/modules/aerodyn/src/AeroAcoustics_Driver.f90 @@ -0,0 +1,176 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2015-2016 National Renewable Energy Laboratory +! +! This file is part of AeroDyn. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +! + +!there will also be various control flags... this may be updated as needed: +!TBLflag = {'BPM','TNO'} +!bluntnessFlag = {'DTU','BPM'} +!BPMBLflag = {'true','false'} +!useOrigModelAtSepOnset = {'true','false'} + + + + + +!********************************************************************************************************************************** +program AeroAcoustics_Driver + use AeroAcoustics_Driver_Subs + use VersionInfo + implicit none + + ! Program variables + REAL(ReKi) :: PrevClockTime ! Clock time at start of simulation in seconds [(s)] + REAL(ReKi) :: UsrTime1 ! User CPU time for simulation initialization [(s)] + REAL(ReKi) :: UsrTime2 ! User CPU time for simulation (without initialization) [(s)] + INTEGER(IntKi) , DIMENSION(1:8) :: StrtTime ! Start time of simulation (including initialization) [-] + INTEGER(IntKi) , DIMENSION(1:8) :: SimStrtTime ! Start time of simulation (after initialization) [-] + REAL(DbKi) :: t_global ! global-loop time marker + REAL(DbKi) :: TiLstPrn ! The simulation time of the last print (to file) [(s)] + + TYPE(Dvr_Data) :: DriverData + + character(1024) :: InputFile + integer :: nt !< loop counter (for time step) + character(20) :: FlagArg ! flag argument from command line + integer(IntKi) :: ErrStat ! status of error message + character(ErrMsgLen) :: ErrMsg !local error message if ErrStat /= ErrID_None + + + CALL DATE_AND_TIME ( Values=StrtTime ) ! Let's time the whole simulation + CALL CPU_TIME ( UsrTime1 ) ! Initial time (this zeros the start time when used as a MATLAB function) + UsrTime1 = MAX( 0.0_ReKi, UsrTime1 ) ! CPU_TIME: If a meaningful time cannot be returned, a processor-dependent negative value is returned + UsrTime2 = UsrTime1 ! CPU_TIME: Initialize in case of error before getting real data + SimStrtTime = StrtTime ! CPU_TIME: Initialize in case of error before getting real data + nt = 0 + + ! --- Driver initialization + CALL NWTC_Init( ProgNameIN=version%Name ) + + InputFile = "" ! initialize to empty string to make sure it's input from the command line + CALL CheckArgs( InputFile, Flag=FlagArg ) + IF ( LEN( TRIM(FlagArg) ) > 0 ) CALL NormStop() + + ! Display the copyright notice and compile info: + CALL DispCopyrightLicense( version%Name ) + CALL DispCompileRuntimeInfo( version%Name ) + + + ! Initialize modules + call ReadDriverInputFile( InputFile, DriverData, ErrStat, ErrMsg ); call CheckError() + call Init_AFI(DriverData%Airfoil_FileName, DriverData%AFInfo, ErrStat, ErrMsg); call CheckError() + call Init_AAmodule(DriverData, ErrStat, ErrMsg); call CheckError() + + ! Init of time estimator + t_global=0.0_DbKi + call SimStatus_FirstTime( TiLstPrn, PrevClockTime, SimStrtTime, UsrTime2, t_global, DriverData%TMax ) + + ! Time loop + do nt = 1, DriverData%numSteps + ! Time update to screen + t_global=nt * DriverData%dt + + if (mod( nt + 1, 10 )==0) call SimStatus(TiLstPrn, PrevClockTime, t_global, DriverData%TMax) + + ! update states and calculate output + call SetInputsForAA(DriverData) + + call AA_CalcOutput(t_global, DriverData%u, DriverData%p, DriverData%xd, DriverData%OtherState, DriverData%y, DriverData%m, errStat, errMsg); call CheckError() + call Dvr_WriteOutputs(t_global, nt, DriverData) ! write to file at this step + + ! Get state variables at next step: INPUT at step nt - 1, OUTPUT at step nt + call AA_UpdateStates(t_global, nt, DriverData%m, DriverData%u, DriverData%p, DriverData%xd, DriverData%OtherState, errStat, errMsg); call CheckError() + + end do !nt=1,numSteps + + + call Dvr_End() +contains +!................................ + subroutine CheckError() + if (ErrStat /= ErrID_None) then + call WrScr(TRIM(errMsg)) + if (errStat >= AbortErrLev) then + call Dvr_End() + end if + ErrStat = ErrID_None + end if + end subroutine CheckError +!................................ + subroutine Dvr_End() + integer(IntKi) :: errStat2 ! local status of error message + character(ErrMsgLen) :: errMsg2 ! local error message if ErrStat /= ErrID_None + + call Dvr_EndOutput(DriverData, nt, errStat2, errMsg2) + if (ErrStat2 /= ErrID_None) call WrScr(TRIM(errMsg2)) + + call RunTimes(StrtTime, UsrTime1, SimStrtTime, UsrTime2, t_global) + + if (ErrStat >= AbortErrLev) then + call WrScr('') + CALL ProgAbort( 'AeroAcoustics Driver encountered simulation error level: '& + //TRIM(GetErrStr(ErrStat)), TrapErrors=.FALSE., TimeWait=3._ReKi ) ! wait 3 seconds (in case they double-clicked and got an error) + else + call NormStop() + end if + end subroutine Dvr_End +!................................ +end program AeroAcoustics_Driver + + + +!Inputs that will be supplied externally: +!driver%DT +! +!Need to set in InitInput: +! rho [InitInputType%airDens] +! c0 or co [InitInputType%SpdSound] +! L [InitInputType%BlSpn] +! chord [InitInputType%BlChord] +! [driver%DT = Interval] +! visc [InitInputType%KinVisc] +! [InitInputType%HubHeight] +! Airfoil info: +! BlAFID +! AFInfo +! +!Set in AA Input File: +! Lturb (already in AA input file) [InputFileData%Lturb] +! dStarS [m%dstarVar(1), dstarVar1, DSTRS -> interpolated from p%dstarall1 = InputFileData%Suct_DispThick using AoA and Re] meters +! dStarP [m%dstarVar(2), dstarVar2, DSTRP -> interpolated from p%dstarall2 = InputFileData%Pres_DispThick using AoA and Re] meters +! TI [InputFileData%TI] +! cfS [m%CfVar(1), Cfall(1) -> interpolated p%Cfall1=InputFileData%Suct_Cf with Re and AoA] +! cfP [m%CfVar(2), Cfall(2) -> interpolated p%Cfall2=InputFileData%Pres_Cf with Re and AoA] +! deltaS [m%d99Var(1) -> interpolated p%d99all1=InputFileData%Suct_BLThick with Re and AoA] +! deltaP [m%d99Var(2), d99Var2 -> interpolated p%d99all2=InputFileData%Pres_BLThick with Re and AoA ] PRESSURE SIDE BOUNDARY LAYER THICKNESS METERS +! uEdgeS [m%EdgeVelVar(1), EdgeVelAll(2) -> interpolated p%EdgeVelRat1=InputFileData%Suct_EdgeVelRat with Re and AoA] +! uEdgeP [m%EdgeVelVar(2), EdgeVelAll(2) -> interpolated p%EdgeVelRat2=InputFileData%Pres_EdgeVelRat with Re and AoA] +! +!Inputs caluculated in AeroDyn (now set in driver input file?): +! meanWindspeed [u%Inflow] +! AoA [u%AoANoise] +! [u%vRel] +! [AeroCent_G] = u%BladeMotion(j)%Position(:,i) + u%BladeMotion(j)%TranslationDisp(:,i) (global position of the blade node) -> fixed value??? +! [RotGtoL] -> set to identity +! +!Inputs calculated +! Ma [M or Mach] : calculated M = U / p%SpdSound ! MACH NUMBER +! Re [RC] : calculated RC = U * C/p%KinVisc ! Reynolds number; C = chord; U=UNoise=sign( max(abs(u%Vrel(J,I)),0.1), u%Vrel(J,I) ) +! +!fSep1p0_alpha (new to BPM) +!fSpe0p7_alpha (new to BPM) + \ No newline at end of file diff --git a/modules/aerodyn/src/AeroAcoustics_Driver_Subs.f90 b/modules/aerodyn/src/AeroAcoustics_Driver_Subs.f90 new file mode 100644 index 0000000000..15e2ef4205 --- /dev/null +++ b/modules/aerodyn/src/AeroAcoustics_Driver_Subs.f90 @@ -0,0 +1,523 @@ +module AeroAcoustics_Driver_Subs + + use NWTC_Library + use AirfoilInfo + use AirfoilInfo_Types + use AeroAcoustics + use AeroAcoustics_Types + + implicit none + + integer, parameter :: NumAFfiles = 1 + integer, parameter :: NumBlades = 1 + integer, parameter :: NumBlNds = 1 + logical, parameter :: UseCm = .false. + + integer(IntKi), parameter :: idFmt_Ascii = 1 + integer(IntKi), parameter :: idFmt_Binary = 2 + integer(IntKi), parameter :: idFmt_Both = 3 + integer(IntKi), parameter :: idFmt_Valid(3) = (/idFmt_Ascii, idFmt_Binary, idFmt_Both/) + real(ReKi), parameter :: myNaN = -9999.9 + character(1), parameter :: delim = TAB + + real(DbKi), parameter :: RotGtoL(3,3) = reshape( [1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0], SHAPE=[3,3] ) + TYPE(ProgDesc), PARAMETER :: version = ProgDesc( 'AeroAcoustics_driver', '', '' ) ! The version number of this program. + + + type Dvr_Data + ! Environmental Conditions + real(ReKi) :: KinVisc !< Kinematic viscosity of working fluid (m^2/s) + real(ReKi) :: AirDens !< AirDens | Air density (kg/m^3) + real(ReKi) :: SpdSound !< Speed of sound in working fluid (m/s) + + ! Output data + character(1024) :: OutRootName = '' !< output file rootname [-] + integer(IntKi) :: unOutFile = -1 !< unit number for writing text output file + character(256) :: OutFmt !< Format used for text tabular output, excluding the time channel. Resulting field should be 10 characters. (quoted string) + integer(IntKi) :: OutFileFmt = idFmt_Binary !< Format for tabular (time-marching) output file (switch) {1: text file [.out], 2: binary file [.outb], 3: both} + logical :: WrBinaryOutput=.false. + logical :: WrTextOutput=.false. + integer(IntKi) :: NumOuts= 0 !< number of output channels, including time + integer(IntKi) :: NumSteps= 0 !< number of steps in output + character(ChanLen) , dimension(:), allocatable :: WriteOutputHdr !< channel headers [-] + character(ChanLen) , dimension(:), allocatable :: WriteOutputUnt !< channel units [-] + real(ReKi) , dimension(:,:), allocatable :: storage !< nchannel x ntime [-] + real(ReKi) , dimension(:), allocatable :: outline !< output line to be written to disk [-] + integer(IntKi) :: FmtWidth + + ! AeroAcoustics Input data + REAL(DbKi) :: AeroCent_G(3) !< Global position of the blade node + REAL(ReKi) :: vRel !< Relative velocity (m/s) + REAL(ReKi) :: AoA !< Angle of attack (rad) + REAL(ReKi) :: WindSpeed !< Atmospheric undisturbed flow on blade [Inflow] (m/s) + REAL(ReKi) :: HubHeight !< hub height (m) + REAL(ReKi) :: BladeLength !< effectively the element span (m) since we are running this with only one element + + ! Time control + real(DbKi) :: DT !< Simulation time step [used only when AnalysisType/=3] (s) + real(DbKi) :: TMax !< Total run time [used only when AnalysisType/=3] (s) + + ! AFI data + character(1024) :: AirFoil_FileName + real(ReKi) :: Chord = 1.0 + type(AFI_ParameterType) :: AFInfo(NumAFfiles) +! integer, allocatable :: AFIndx(:,:) + + ! AeroAcoustics data + character(1024) :: AA_InputFileName !< name of the AA input file + type(AA_InitInputType) :: InitInp !< Input data for initialization routine + type(AA_InputType) :: u !< An initial guess for the input; input mesh must be defined + type(AA_ParameterType) :: p !< Parameters + !type(AA_ContinuousStateType) :: x !< Initial continuous states + type(AA_DiscreteStateType) :: xd !< Initial discrete states + !type(AA_ConstraintStateType) :: z !< Initial guess of the constraint states + type(AA_OtherStateType) :: OtherState !< Initial other states + type(AA_OutputType) :: y !< Initial system outputs (outputs are not calculated) + type(AA_MiscVarType) :: m !< Initial misc/optimization variables + end type Dvr_Data + +contains + +!-------------------------------------------------------------------------------------------------------------- +subroutine ReadDriverInputFile( FileName, DriverData, ErrStat, ErrMsg ) + character(1024), intent(in ) :: FileName + type(Dvr_Data), intent(inout) :: DriverData ! driver data + integer, intent( out) :: ErrStat ! returns a non-zero value when an error occurs + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Local variables + integer :: UnEcho ! The local unit number for this module's echo file + integer :: iLine, i + character(1024) :: EchoFile ! Name of driver's echo file + character(1024) :: PriPath ! the path to the primary input file + character(1024) :: Line ! the path to the primary input file + type(FileInfoType) :: FI !< The derived type for holding the file information. + integer(IntKi) :: errStat2 ! Status of error message + character(1024) :: errMsg2 ! Error message if ErrStat /= ErrID_None + character(*), parameter :: RoutineName = 'ReadDriverInputFile' + integer, parameter :: NumHeaderLines = 3 + logical :: Echo + + ! Initialize the echo file unit to -1 which is the default to prevent echoing, we will alter this based on user input + UnEcho = -1 + Echo = .false. + ErrStat = ErrID_None + ErrMsg = '' + + ! Read all input file lines into fileinfo + call WrScr(' Opening AeroAcoustics Driver input file: '//trim(FileName) ) + call ProcessComFile(FileName, FI, errStat2, errMsg2); if (Failed()) return + CALL GetPath( FileName, PriPath ) ! Input files will be relative to the path where the primary input file is located. + !call GetRoot(FileName, dvr%root) + + ! --- Header and echo + iLine = NumHeaderLines ! Skip the first NumHeaderLines lines as they are known to be header lines and separators + call ParseVar(FI, iLine, 'Echo', Echo, errStat2, errMsg2); if (Failed()) return; + if ( Echo ) then + EchoFile = trim(FileName)//'.ech' + call OpenEcho (UnEcho, EchoFile, errStat2, errMsg2 ); if(Failed()) return + do i = 1,iLine-1 + write(UnEcho, '(A)') trim(FI%Lines(i)) + enddo + end if + + call ParseVar(FI, iLine, 'TMax', DriverData%TMax , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'DT', DriverData%DT, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'AA_InputFile', DriverData%AA_InputFileName , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'AirFoil_FileName' , DriverData%AirFoil_FileName, errStat2, errMsg2, UnEcho); if(Failed()) return + + ! --- Environmental conditions section + call ParseCom(FI, iLine, Line , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'AirDens', DriverData%AirDens , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'KinVisc', DriverData%KinVisc , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'SpdSound', DriverData%SpdSound, errStat2, errMsg2, UnEcho); if(Failed()) return + + ! --- SIMULATION INPUTS section + call ParseCom(FI, iLine, Line , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'WindSpeed' , DriverData%WindSpeed , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'AoA' , DriverData%AoA , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'vRel' , DriverData%vRel , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseAry(FI, iLine, 'AeroCent_G' , DriverData%AeroCent_G , 3, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'HubHeight' , DriverData%HubHeight , errStat2, errMsg2, UnEcho); if(Failed()) return +! call ParseVar(FI, iLine, 'Chord' , DriverData%Chord , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'Span' , DriverData%BladeLength, errStat2, errMsg2, UnEcho); if(Failed()) return + + ! --- OUTPUT section + call ParseCom(FI, iLine, Line , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'OutFmt' , DriverData%OutFmt , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'OutFileFmt', DriverData%OutFileFmt, errStat2, errMsg2, UnEcho); if(Failed()) return + + ! convert units: + DriverData%AoA = DriverData%AoA * D2R + + + ! --- Get relative path names + call GetRoot(FileName, DriverData%OutRootName) ! OutRootName is inferred from current filename. + !if (PathIsRelative(DriverData%OutRootName)) DriverData%OutRootName = TRIM(PriPath)//TRIM(DriverData%OutRootName) + if (PathIsRelative(DriverData%AA_InputFileName)) DriverData%AA_InputFileName = TRIM(PriPath)//TRIM(DriverData%AA_InputFileName) + if (PathIsRelative(DriverData%AirFoil_FileName)) DriverData%AirFoil_FileName = TRIM(PriPath)//TRIM(DriverData%AirFoil_FileName ) + + ! --- Checks + if (DriverData%OutFileFmt == idFmt_Both) then + DriverData%WrBinaryOutput = .true. + DriverData%WrTextOutput = .true. + elseif (DriverData%OutFileFmt == idFmt_Ascii) then + DriverData%WrBinaryOutput = .false. + DriverData%WrTextOutput = .true. + elseif (DriverData%OutFileFmt == idFmt_Binary) then + DriverData%WrBinaryOutput = .true. + DriverData%WrTextOutput = .false. + else + DriverData%WrBinaryOutput = .false. + DriverData%WrTextOutput = .false. + end if + + if (DriverData%WrTextOutput) then + CALL ChkRealFmtStr( DriverData%OutFmt, 'OutFmt', DriverData%FmtWidth, ErrStat2, ErrMsg2 ) + IF ( DriverData%FmtWidth < 10 ) CALL SetErrStat( ErrID_Warn, 'OutFmt produces a column width of '// & + TRIM(Num2LStr(DriverData%FmtWidth))//'), which may be too small.', ErrStat, ErrMsg, RoutineName ) + end if + + call Cleanup() +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) call Cleanup() + end function Failed + + subroutine Cleanup() + ! Close this module's echo file + if ( Echo ) then + close(UnEcho) + end if + Call NWTC_Library_Destroyfileinfotype(FI, errStat2, errMsg2) + end subroutine Cleanup + + +end subroutine ReadDriverInputFile +!-------------------------------------------------------------------------------------------------------------- + +subroutine Dvr_EndOutput(DriverData, nt, errStat, errMsg) + type(Dvr_Data), intent(inout) :: DriverData ! driver data + integer(IntKi), intent(in ) :: nt ! number of time steps written + integer(IntKi) , intent(out) :: errStat ! Status of error message + character(*) , intent(out) :: errMsg ! Error message if errStat /= ErrID_None + + character(ErrMsgLen) :: errMsg2 ! temporary Error message if errStat /= ErrID_None + integer(IntKi) :: errStat2 ! temporary Error status of the operation + character(*), parameter :: RoutineName = 'Dvr_EndOutput' + + errStat = ErrID_None + errMsg = '' + + ! Close the output file + if (DriverData%WrTextOutput) then + if (DriverData%unOutFile > 0) close(DriverData%unOutFile) + DriverData%unOutFile = -1 + endif + if (DriverData%WrBinaryOutput .and. allocated(DriverData%storage)) then + call WrScr(' Writing output file: '//trim(DriverData%OutRootName)//'.outb') + call WrBinFAST(trim(DriverData%OutRootName)//'.outb', FileFmtID_ChanLen_In, version%Name, DriverData%WriteOutputHdr, DriverData%WriteOutputUnt, (/0.0_DbKi, DriverData%dt/), DriverData%storage(:,1:nt), errStat2, errMsg2) + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + endif +end subroutine Dvr_EndOutput + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Initialize outputs to file for driver +subroutine Dvr_InitializeOutputs(DriverData, AA_InitOut, errStat, errMsg) + TYPE(Dvr_Data) , intent(inout) :: DriverData + TYPE(AA_InitOutputTYpe), intent(in ) :: AA_InitOut + integer(IntKi) , intent( out) :: errStat ! Status of error message + character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None + ! locals + integer(IntKi) :: errStat2 ! Status of error message + character(ErrMsgLen) :: errMsg2 ! Error message + integer :: i, j + integer :: ActualChanLen + + errStat = ErrID_None + errMsg = '' + + DriverData%numSteps = ceiling(DriverData%TMax / DriverData%dt) + DriverData%numOuts = sum(DriverData%p%numOutsAll) + 1 ! includes time channel + if (DriverData%numOuts < 2) then + ErrStat2=ErrID_Fatal + ErrMsg2='AeroAcoustics module is not printing any outputs. Simulation will end.' + if (Failed()) return + end if + + ! --- Allocate driver-level outputs + call AllocAry(DriverData%WriteOutputHdr, DriverData%numOuts, 'WriteOutputHdr', errStat2, errMsg2); if(Failed()) return + call AllocAry(DriverData%WriteOutputUnt, DriverData%numOuts, 'WriteOutputUnt', errStat2, errMsg2); if(Failed()) return + + i=1 + DriverData%WriteOutputHdr(i) = 'Time' + DriverData%WriteOutputUnt(i) = '(s)' + + if (DriverData%numOuts > 0) then + do j=1,DriverData%p%numOutsAll(1) + i = i + 1 + DriverData%WriteOutputHdr(i) = AA_InitOut%WriteOutputHdr(j) + DriverData%WriteOutputUnt(i) = AA_InitOut%WriteOutputUnt(j) + end do + + do j=1,DriverData%p%numOutsAll(2) + i = i + 1 + DriverData%WriteOutputHdr(i) = AA_InitOut%WriteOutputHdrforPE(j) + DriverData%WriteOutputUnt(i) = AA_InitOut%WriteOutputUntforPE(j) + end do + + do j=1,DriverData%p%numOutsAll(3) + i = i + 1 + DriverData%WriteOutputHdr(i) = AA_InitOut%WriteOutputHdrSep(j) + DriverData%WriteOutputUnt(i) = AA_InitOut%WriteOutputUntSep(j) + end do + + do j=1,DriverData%p%numOutsAll(4) + i = i + 1 + DriverData%WriteOutputHdr(i) = AA_InitOut%WriteOutputHdrNodes(j) + DriverData%WriteOutputUnt(i) = AA_InitOut%WriteOutputUntNodes(j) + end do + end if + + if (DriverData%WrTextOutput .or. DriverData%WrBinaryOutput) then + call AllocAry(DriverData%outLine, DriverData%numOuts-1, 'outLine', errStat2, errMsg2); if(Failed()) return + DriverData%outLine=0.0_ReKi + end if + + if (DriverData%WrTextOutput) then + ActualChanLen = min(ChanLen, max(10, DriverData%FmtWidth)) + do i=1,DriverData%NumOuts + ActualChanLen = max( ActualChanLen, LEN_TRIM(DriverData%WriteOutputHdr(I)) ) + ActualChanLen = max( ActualChanLen, LEN_TRIM(DriverData%WriteOutputUnt(I)) ) + enddo ! I + + call GetNewUnit( DriverData%unOutFile, ErrStat2, ErrMsg2 ) + if (Failed()) return + + call OpenFOutFile ( DriverData%unOutFile, trim(DriverData%OutRootName)//'.out', ErrStat2, ErrMsg2 ) + if (Failed()) return + + write (DriverData%unOutFile,'(A)') '' + write (DriverData%unOutFile,'(A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using '//trim(GetNVD(version)) + write (DriverData%unOutFile,'(A)') '' + write (DriverData%unOutFile,'(A)') '' + write (DriverData%unOutFile,'(A)') 'Output from AeroAcoustics driver' + write (DriverData%unOutFile,'(A)') '' + + !...................................................... + ! Write the names of the output parameters on one line: line 7 + !...................................................... + call WrFileNR ( DriverData%unOutFile, DriverData%WriteOutputHdr(1)(1:min(15,ChanLen)) ) + do i=2,DriverData%NumOuts + call WrFileNR ( DriverData%unOutFile, delim//DriverData%WriteOutputHdr(i)(1:ActualChanLen) ) + end do ! i + write (DriverData%unOutFile,'()') + + !...................................................... + ! Write the units of the output parameters on one line: line 8 + !...................................................... + call WrFileNR ( DriverData%unOutFile, DriverData%WriteOutputUnt(1)(1:min(15,ChanLen)) ) + do i=2,DriverData%NumOuts + call WrFileNR ( DriverData%unOutFile, delim//DriverData%WriteOutputUnt(i)(1:ActualChanLen) ) + end do ! i + write (DriverData%unOutFile,'()') + + end if + + ! --- Binary + if (DriverData%WrBinaryOutput) then + ! we aren't storing time here + call AllocAry(DriverData%storage, DriverData%numOuts-1, DriverData%numSteps, 'storage', errStat2, errMsg2); if(Failed()) return + DriverData%storage= myNaN !0.0_ReKi ! Alternative: myNaN + endif + +contains + logical function Failed() + CALL SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Dvr_InitializeOutputs' ) + Failed = errStat >= AbortErrLev + end function Failed +end subroutine Dvr_InitializeOutputs +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine Dvr_WriteOutputs(t, nt, DriverData) + Integer(IntKi) , intent(in ) :: nt ! time step number + real(DbKi) , intent(in ) :: t ! simulation time (s) + type(Dvr_Data), intent(inout) :: DriverData ! driver data + + ! ! Local variables. + integer :: i, j + + if (DriverData%WrTextOutput .or. DriverData%WrBinaryOutput) then + i = 0 + + ! Driver outputs + if (DriverData%numOuts > 0) then + do j=1,DriverData%p%numOutsAll(1) + i = i + 1 + DriverData%outLine(i) = DriverData%y%WriteOutput(j) + end do + + do j=1,DriverData%p%numOutsAll(2) + i = i + 1 + DriverData%outLine(i) = DriverData%y%WriteOutputforPE(j) + end do + + do j=1,DriverData%p%numOutsAll(3) + i = i + 1 + DriverData%outLine(i) = DriverData%y%WriteOutputSep(j) + end do + + do j=1,DriverData%p%numOutsAll(4) + i = i + 1 + DriverData%outLine(i) = DriverData%y%WriteOutputNodes(j) + end do + end if + + if (DriverData%WrBinaryOutput) DriverData%storage(:,nt) = DriverData%outLine + if (DriverData%WrTextOutput) then + write(DriverData%unOutFile,'(F15.4,'//trim(num2lstr(DriverData%numOuts-1))//'("'//delim//'"'//trim(DriverData%outFmt)//'))') t, DriverData%outLine(:) + end if + + + end if + + +end subroutine Dvr_WriteOutputs +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine Init_AFI(afName, AFInfo, ErrStat, ErrMsg) + + CHARACTER(1024), intent(in ) :: afName + type(AFI_ParameterType), intent( out) :: AFInfo(NumAFfiles) + integer(IntKi), intent( out) :: ErrStat ! Error status. + character(*), intent( out) :: ErrMsg ! Error message. + + type(AFI_InitInputType) :: AFI_InitInputs + integer :: UnEc + + ErrStat = ErrID_None + ErrMsg = "" + + AFI_InitInputs%InCol_Alfa = 1 + AFI_InitInputs%InCol_Cl = 2 + AFI_InitInputs%InCol_Cd = 3 + AFI_InitInputs%InCol_Cm = 0 + AFI_InitInputs%InCol_Cpmin = 0 + AFI_InitInputs%AFTabMod = AFITable_1 ! 1D-interpolation (on AoA only) + AFI_InitInputs%UAMod = 3 ! We calculate some of the UA coefficients based on UA Model, but AA doesn't care which + AFI_InitInputs%FileName = afName !InitInp%AF_File(i) + + UnEc = 0 + + ! Read in and process the airfoil file. + ! This includes creating the spline coefficients to be used for interpolation. + + call AFI_Init ( AFI_InitInputs, AFInfo(1), errStat, errMsg, UnEc ) + if (ErrStat >= AbortErrLev) return + +end subroutine Init_AFI +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes the Airfoil Noise module from within AeroDyn. +SUBROUTINE Init_AAmodule( DriverData, ErrStat, ErrMsg ) +!.................................................................................................................................. + type(Dvr_Data), intent(inout) :: DriverData !< AeroDyn-level initialization inputs + + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + + ! Local variables + real(DbKi) :: Interval ! DT + type(AA_InitInputType) :: InitInp ! Input data for initialization routine + type(AA_InitOutputType) :: InitOut ! Output for initialization routine + integer(intKi) :: j ! node index + integer(intKi) :: k ! blade index + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Init_AAmodule' + + ErrStat = ErrID_None + ErrMsg = "" + + ! Transfer from parameters and input file to init input + InitInp%InputFile = DriverData%AA_InputFileName + InitInp%NumBlades = NumBlades + InitInp%NumBlNds = NumBlNds + InitInp%RootName = DriverData%OutRootName + +! read from input file or set default value + Interval = DriverData%DT + InitInp%airDens = DriverData%airDens !(rho) + InitInp%kinVisc = DriverData%kinVisc !(nu) + InitInp%SpdSound = DriverData%SpdSound !(co) + InitInp%HubHeight = DriverData%HubHeight + + ! --- Allocate and set AirfoilID, chord and Span for each blades + ! note here that each blade is required to have the same number of nodes + call AllocAry( InitInp%BlAFID, NumBlNds, NumBlades,'InitInp%BlAFID', errStat2, ErrMsg2 ); call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + call AllocAry( InitInp%BlChord, NumBlNds, NumBlades, 'BlChord', errStat2, ErrMsg2 ); call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + call AllocAry( InitInp%BlSpn, NumBlNds, NumBlades, 'BlSpn', errStat2, ErrMsg2 ); call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + if (ErrStat >= AbortErrLev) then + call cleanup() + return + end if + + do k = 1, NumBlades + do j=1, NumBlNds + InitInp%BlChord(j,k) = DriverData%Chord !RotInputFileData%BladeProps(k)%BlChord(j) + InitInp%BlSpn (j,k) = real(j,ReKi)/real(NumBlNds,ReKi) * DriverData%BladeLength + InitInp%BlAFID(j,k) = NumAFfiles !RotInputFileData%BladeProps(k)%BlAFID(j) + end do + end do + + ! --- AeroAcoustics initialization call + call AA_Init(InitInp, DriverData%u, DriverData%p, DriverData%xd, DriverData%OtherState,DriverData%y, DriverData%m, Interval, DriverData%AFInfo, InitOut, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + if (ErrStat < AbortErrLev) then + call Dvr_InitializeOutputs(DriverData, InitOut, errStat2, errMsg2) + call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + + call Cleanup() + +contains + + subroutine Cleanup() + call AA_DestroyInitInput ( InitInp, ErrStat2, ErrMsg2 ) + call AA_DestroyInitOutput ( InitOut, ErrStat2, ErrMsg2 ) + end subroutine Cleanup + +END SUBROUTINE Init_AAmodule +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine sets m%AA_u. +subroutine SetInputsForAA(DriverData) + type(Dvr_Data), intent(inout) :: DriverData !< AeroDyn-level initialization inputs + + ! local variables + integer(intKi) :: i ! loop counter for nodes + integer(intKi) :: j ! loop counter for blades + + do j=1,NumBlades + do i = 1,NumBlNds + ! Get local orientation matrix to transform from blade element coordinates to global coordinates + DriverData%u%RotGtoL(:,:,i,j) = RotGtoL ! default to identitiy orientation + + ! Get blade element aerodynamic center in global coordinates + DriverData%u%AeroCent_G(:,i,j) = DriverData%AeroCent_G !BJJ: does this need to change with time? probably + + ! Set the blade element relative velocity (including induction) + DriverData%u%Vrel(i,j) = DriverData%VRel + + ! Set the blade element angle of attack + DriverData%u%AoANoise(i,j) = DriverData%AoA + + ! Set the blade element undisturbed flow + DriverData%u%Inflow(:,i,j) = [DriverData%WindSpeed, 0.0_ReKi, 0.0_ReKi] + end do + end do +end subroutine SetInputsForAA +!---------------------------------------------------------------------------------------------------------------------------------- + +end module AeroAcoustics_Driver_Subs + diff --git a/modules/aerodyn/src/AeroAcoustics_IO.f90 b/modules/aerodyn/src/AeroAcoustics_IO.f90 index 7e6affa37e..24049bb023 100644 --- a/modules/aerodyn/src/AeroAcoustics_IO.f90 +++ b/modules/aerodyn/src/AeroAcoustics_IO.f90 @@ -10,10 +10,11 @@ MODULE AeroAcoustics_IO type(ProgDesc), parameter :: AA_Ver = ProgDesc( 'AeroAcoustics', '', '' ) character(*), parameter :: AA_Nickname = 'AA' + character(*), parameter :: delim = Tab + LOGICAL, parameter :: AA_OutputToSeparateFile = .true. - - INTEGER(IntKi), PARAMETER :: Time = 0 + integer(intKi), parameter :: nNoiseMechanism = 7 ! number of noise mechanisms INTEGER(IntKi), PARAMETER :: MaxBl = 3 ! Maximum number of blades allowed in simulation @@ -40,34 +41,34 @@ MODULE AeroAcoustics_IO integer(intKi), parameter :: X_BLMethod_BPM = 1 ! integer(intKi), parameter :: X_BLMethod_Tables = 2 ! - integer(intKi), parameter :: TICalc_Interp = 1 ! interpolate from pretabulated - integer(intKi), parameter :: TICalc_Every = 2 ! calculate ti automatically + integer(intKi), parameter :: TICalc_Interp = 1 ! interpolate from pretabulated (TICalcMethod) + integer(intKi), parameter :: TICalc_Every = 2 ! calculate ti automatically (TICalcMethod) integer(intKi), parameter :: ITURB_None = 0 ! TBLTE noise is not calculated integer(intKi), parameter :: ITURB_BPM = 1 ! TBLTE noise is calculated with BPM integer(intKi), parameter :: ITURB_TNO = 2 ! TBLTE noise is calculated with TNO - integer(intKi), parameter :: IInflow_None = 0 ! IInflow noise is not calculated - integer(intKi), parameter :: IInflow_BPM = 1 ! IInflow noise is calculated with BPM - integer(intKi), parameter :: IInflow_FullGuidati = 2 ! IInflow noise is calculated with FullGuidati + integer(intKi), parameter :: IInflow_None = 0 ! IInflow noise is not calculated + integer(intKi), parameter :: IInflow_BPM = 1 ! IInflow noise is calculated with BPM + integer(intKi), parameter :: IInflow_FullGuidati = 2 ! IInflow noise is calculated with FullGuidati integer(intKi), parameter :: IInflow_SimpleGuidati = 3 ! IInflow noise is calculated with SimpleGuidati contains !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ReadInputFiles( InputFileName, AFI, InputFileData, Default_DT, OutFileRoot, UnEcho, ErrStat, ErrMsg ) +SUBROUTINE ReadInputFiles( InputFileName, AFInfo, InputFileData, Default_DT, OutFileRoot, ErrStat, ErrMsg ) ! This subroutine reads the input file and stores all the data in the AA_InputFile structure. ! It does not perform data validation. !.................................................................................................................................. ! Passed variables REAL(DbKi), INTENT(IN) :: Default_DT ! The default DT (from glue code) CHARACTER(*), INTENT(IN) :: InputFileName ! Name of the aeroacoustics input file - TYPE(AFI_ParameterType), INTENT(IN) :: AFI(:) ! airfoil array: contains names of the BL input file + TYPE(AFI_ParameterType), INTENT(IN) :: AFInfo(:) ! airfoil array: contains names of the BL input file CHARACTER(*), INTENT(IN) :: OutFileRoot ! The rootname of all the output files written by this routine. TYPE(AA_InputFile), INTENT(OUT) :: InputFileData ! Data stored in the module's input file - INTEGER(IntKi), INTENT(OUT) :: UnEcho ! Unit number for the echo file INTEGER(IntKi), INTENT(OUT) :: ErrStat ! The error status code CHARACTER(*), INTENT(OUT) :: ErrMsg ! The error message, if an error occurred ! local variables + INTEGER(IntKi) :: UnEcho ! Unit number for the echo file INTEGER(IntKi) :: ErrStat2 ! The error status code CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred CHARACTER(*), PARAMETER :: RoutineName = 'ReadInputFiles' @@ -82,23 +83,28 @@ SUBROUTINE ReadInputFiles( InputFileName, AFI, InputFileData, Default_DT, OutFil if(Failed()) return ! get the blade input-file data - ALLOCATE( InputFileData%BladeProps( size(AFI) ), STAT = ErrStat2 ) + ALLOCATE( InputFileData%BladeProps( size(AFInfo) ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal,"Error allocating memory for BladeProps.", ErrStat, ErrMsg, RoutineName) + call cleanup() return END IF - if ((InputFileData%ITURB==2) .or. (InputFileData%X_BLMethod==X_BLMethod_Tables) .or. (InputFileData%IBLUNT==1)) then + if (InputFileData%ITURB==ITURB_TNO .or. InputFileData%X_BLMethod==X_BLMethod_Tables .or. InputFileData%IBLUNT==IBLUNT_BPM) then ! We need to read the BL tables - CALL ReadBLTables( InputFileName, AFI, InputFileData, ErrStat2, ErrMsg2 ) - if (Failed())return + CALL ReadBLTables( InputFileName, AFInfo, InputFileData, UnEcho, ErrStat2, ErrMsg2 ) + if (Failed()) return endif CONTAINS logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev + if (Failed) call cleanup() end function Failed + subroutine cleanup() + if (UnEcho > 0) close(UnEcho) + end subroutine END SUBROUTINE ReadInputFiles !---------------------------------------------------------------------------------------------------------------------------------- @@ -116,27 +122,27 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, Default_DT, OutFileRoot, U integer(IntKi) :: I ! loop counter integer(IntKi) :: UnIn,UnIn2 ! Unit number for reading file character(1024) :: ObserverFile ! name of the files containing obesever location - integer(IntKi) :: ErrStat2, IOS,cou ! Temporary Error status + integer(IntKi) :: ErrStat2, cou ! Temporary Error status logical :: Echo ! Determines if an echo file should be written character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message character(1024) :: PriPath ! Path name of the primary file + character(1024) :: OutPath ! Path name of the default output file character(200) :: Line ! Temporary storage of a line from the input file (to compare with "default") character(*), parameter :: RoutineName = 'ReadPrimaryFile' + real(ReKi) :: TmpArray(3) ! Initialize some variables: ErrStat = ErrID_None ErrMsg = "" UnEc = -1 + UnIn = -1 + UnIn2 = -1 Echo = .FALSE. CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. ! Open the Primary input file. - CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ); call check() - CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ); call check() - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF + CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ); if (Failed()) return; ! Read the lines up/including to the "Echo" simulation control variable ! If echo is FALSE, don't write these lines to the echo file. @@ -144,25 +150,19 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, Default_DT, OutFileRoot, U I = 1 !set the number of times we've read the file DO !----------- HEADER ------------------------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, UnEc ); call check() - CALL ReadStr( UnIn, InputFile, InputFileData%FTitle, 'FTitle', 'File Header: File Description (line 2)', ErrStat2, ErrMsg2, UnEc ); call check() - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF + CALL ReadCom( UnIn, InputFile, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; + CALL ReadStr( UnIn, InputFile, InputFileData%FTitle, 'FTitle', 'File Header: File Description (line 2)', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; !----------- GENERAL OPTIONS ---------------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: General Options', ErrStat2, ErrMsg2, UnEc ); call check() - ! Echo - Echo input to ".AD.ech". - CALL ReadVar( UnIn, InputFile, Echo, 'Echo', 'Echo flag', ErrStat2, ErrMsg2, UnEc); call check() + CALL ReadCom( UnIn, InputFile, 'Section Header: General Options', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; + ! Echo - Echo input to ".AD.AA.ech". + CALL ReadVar( UnIn, InputFile, Echo, 'Echo', 'Echo flag', ErrStat2, ErrMsg2, UnEc); if (Failed()) return; + IF (.NOT. Echo .OR. I > 1) EXIT !exit this loop ! Otherwise, open the echo file, then rewind the input file and echo everything we've read I = I + 1 ! make sure we do this only once (increment counter that says how many times we've read this file) - CALL OpenEcho ( UnEc, TRIM(OutFileRoot)//'.ech', ErrStat2, ErrMsg2, AA_Ver ); call check() - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF + CALL OpenEcho ( UnEc, TRIM(OutFileRoot)//'.ech', ErrStat2, ErrMsg2, AA_Ver ); if (Failed()) return; + IF ( UnEc > 0 ) WRITE (UnEc,'(/,A,/)') 'Data from '//TRIM(AA_Ver%Name)//' primary input file "'//TRIM( InputFile )//'":' REWIND( UnIn, IOSTAT=ErrStat2 ) IF (ErrStat2 /= 0_IntKi ) THEN @@ -178,143 +178,113 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, Default_DT, OutFileRoot, U END IF ! DT_AA - Time interval for aerodynamic calculations {or default} (s): - Line = "" - CALL ReadVar( UnIn, InputFile, Line, "DT_AA", "Time interval for aeroacoustics calculations {or default} (s)", ErrStat2, ErrMsg2, UnEc); call check() - CALL Conv2UC( Line ) - - IF ( INDEX(Line, "DEFAULT" ) /= 1 ) THEN ! If DT_AA is not "default", read it and make sure it is a multiple of DTAero from AeroDyn. Else, just use DTAero - READ( Line, *, IOSTAT=IOS) InputFileData%DT_AA - CALL CheckIOS ( IOS, InputFile, 'DT_AA', NumType, ErrStat2, ErrMsg2 ); call check() - - IF (abs(InputFileData%DT_AA / Default_DT - NINT(InputFileData%DT_AA / Default_DT)) .gt. 1E-10) THEN - CALL SetErrStat(ErrID_Fatal,"The Aeroacoustics input DT_AA must be a multiple of DTAero.", ErrStat, ErrMsg, RoutineName) - return - END IF - ELSE - InputFileData%DT_AA = Default_DT + CALL ReadVarWDefault( UnIn, InputFile, InputFileData%DT_AA, "DT_AA", "Time interval for aeroacoustics calculations {or default} (s)", Default_DT, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + IF (.NOT. EqualRealNos( InputFileData%DT_AA, NINT(InputFileData%DT_AA / Default_DT)*Default_DT ) ) THEN + CALL SetErrStat(ErrID_Fatal,"The Aeroacoustics input DT_AA must be a multiple of DTAero.", ErrStat, ErrMsg, RoutineName) + call Cleanup() + return END IF + - CALL ReadVar(UnIn,InputFile,InputFileData%AAStart ,"AAStart" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() - CALL ReadVar(UnIn,InputFile,InputFileData%AA_Bl_Prcntge,"BldPrcnt" ,"-",ErrStat2,ErrMsg2,UnEc); call check() - CALL ReadCom( UnIn, InputFile, 'Section Header: Aeroacoustic Models', ErrStat2, ErrMsg2, UnEc ); call check() - CALL ReadVar(UnIn,InputFile,InputFileData%IInflow ,"InflowMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() - CALL ReadVar(UnIn,InputFile,InputFileData%TICalcMeth ,"TICalcMeth" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() - CALL ReadVAr(UnIn,InputFile,InputFileData%TI ,"TI" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() - CALL ReadVAr(UnIn,InputFile,InputFileData%avgV ,"avgV" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() - CALL ReadVar(UnIn,InputFile,InputFileData%Lturb ,"Lturb" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() - CALL ReadVar(UnIn,InputFile,InputFileData%ITURB ,"TurbMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() ! ITURB - TBLTE NOISE - CALL ReadVar(UnIn,InputFile,InputFileData%X_BLMethod ,"BLMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() - CALL ReadVar(UnIn,InputFile,InputFileData%ITRIP ,"TripMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() - CALL ReadVar(UnIn,InputFile,InputFileData%ILAM ,"LamMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() - CALL ReadVar(UnIn,InputFile,InputFileData%ITIP ,"TipMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() - CALL ReadVar(UnIn,InputFile,InputFileData%ROUND ,"RoundTip" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() - CALL ReadVar(UnIn,InputFile,InputFileData%ALPRAT ,"ALPRAT" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() - CALL ReadVar(UnIn,InputFile,InputFileData%IBLUNT ,"BluntMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() - - ! Return on error at end of section - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF + CALL ReadVar(UnIn,InputFile,InputFileData%AAStart ,"AAStart" ,"" ,ErrStat2,ErrMsg2,UnEc); if (Failed()) return; + CALL ReadVar(UnIn,InputFile,InputFileData%AA_Bl_Prcntge,"BldPrcnt" ,"-",ErrStat2,ErrMsg2,UnEc); if (Failed()) return; + CALL ReadCom( UnIn, InputFile, 'Section Header: Aeroacoustic Models', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; + CALL ReadVar(UnIn,InputFile,InputFileData%IInflow ,"InflowMod" ,"" ,ErrStat2,ErrMsg2,UnEc); if (Failed()) return; + CALL ReadVar(UnIn,InputFile,InputFileData%TICalcMeth ,"TICalcMeth" ,"" ,ErrStat2,ErrMsg2,UnEc); if (Failed()) return; + CALL ReadVAr(UnIn,InputFile,InputFileData%TI ,"TI" ,"" ,ErrStat2,ErrMsg2,UnEc); if (Failed()) return; + CALL ReadVAr(UnIn,InputFile,InputFileData%avgV ,"avgV" ,"" ,ErrStat2,ErrMsg2,UnEc); if (Failed()) return; + CALL ReadVar(UnIn,InputFile,InputFileData%Lturb ,"Lturb" ,"" ,ErrStat2,ErrMsg2,UnEc); if (Failed()) return; + CALL ReadVar(UnIn,InputFile,InputFileData%ITURB ,"TurbMod" ,"" ,ErrStat2,ErrMsg2,UnEc); if (Failed()) return; ! ITURB - TBLTE NOISE + CALL ReadVar(UnIn,InputFile,InputFileData%X_BLMethod ,"BLMod" ,"" ,ErrStat2,ErrMsg2,UnEc); if (Failed()) return; + CALL ReadVar(UnIn,InputFile,InputFileData%ITRIP ,"TripMod" ,"" ,ErrStat2,ErrMsg2,UnEc); if (Failed()) return; + CALL ReadVar(UnIn,InputFile,InputFileData%ILAM ,"LamMod" ,"" ,ErrStat2,ErrMsg2,UnEc); if (Failed()) return; + CALL ReadVar(UnIn,InputFile,InputFileData%ITIP ,"TipMod" ,"" ,ErrStat2,ErrMsg2,UnEc); if (Failed()) return; + CALL ReadVar(UnIn,InputFile,InputFileData%ROUND ,"RoundTip" ,"" ,ErrStat2,ErrMsg2,UnEc); if (Failed()) return; + CALL ReadVar(UnIn,InputFile,InputFileData%ALPRAT ,"ALPRAT" ,"" ,ErrStat2,ErrMsg2,UnEc); if (Failed()) return; + CALL ReadVar(UnIn,InputFile,InputFileData%IBLUNT ,"BluntMod" ,"" ,ErrStat2,ErrMsg2,UnEc); if (Failed()) return; !----------- OBSERVER INPUT ------------------------------ - CALL ReadCom( UnIn, InputFile, 'Section Header: Observer Input ', ErrStat2, ErrMsg2, UnEc ); call check() + CALL ReadCom( UnIn, InputFile, 'Section Header: Observer Input ', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; !----- read from observer file - CALL ReadVar ( UnIn, InputFile, ObserverFile, ObserverFile, 'Name of file observer locations', ErrStat2, ErrMsg2, UnEc ); call check() + CALL ReadVar ( UnIn, InputFile, ObserverFile, ObserverFile, 'Name of file observer locations', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; IF ( PathIsRelative( ObserverFile ) ) ObserverFile = TRIM(PriPath)//TRIM(ObserverFile) - CALL GetNewUnit( UnIn2, ErrStat2, ErrMsg2 ); call check() - - CALL OpenFInpFile ( UnIn2, ObserverFile, ErrStat2, ErrMsg2 ); call check() - IF ( ErrStat >= AbortErrLev ) RETURN + CALL GetNewUnit( UnIn2, ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL OpenFInpFile ( UnIn2, ObserverFile, ErrStat2, ErrMsg2 ); if (Failed()) return; ! NrObsLoc - Nr of Observers (-): - CALL ReadVar( UnIn2, ObserverFile, InputFileData%NrObsLoc, "NrObsLoc", "Nr of Observers (-)", ErrStat2, ErrMsg2, UnEc); call check() + CALL ReadVar( UnIn2, ObserverFile, InputFileData%NrObsLoc, "NrObsLoc", "Nr of Observers (-)", ErrStat2, ErrMsg2, UnEc); if (Failed()) return; + if (InputFileData%NrObsLoc < 1) then + call SetErrStat(ErrID_Fatal,"NrObsLoc must be a positive number", ErrStat, ErrMsg, RoutineName) + call Cleanup() + return + end if + + CALL ReadCom( UnIn2, ObserverFile, ' Header', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; ! Observer location in tower-base coordinate (m): - CALL AllocAry( InputFileData%ObsX,InputFileData%NrObsLoc, 'ObsX', ErrStat2, ErrMsg2); call check() - CALL AllocAry( InputFileData%ObsY,InputFileData%NrObsLoc, 'ObsY', ErrStat2, ErrMsg2); call check() - CALL AllocAry( InputFileData%ObsZ,InputFileData%NrObsLoc, 'ObsZ', ErrStat2, ErrMsg2); call check() - - CALL ReadCom( UnIn2, InputFile, ' Header', ErrStat2, ErrMsg2, UnEc ); call check() - + CALL AllocAry( InputFileData%ObsXYZ,3,InputFileData%NrObsLoc, 'ObsX', ErrStat2, ErrMsg2); if (Failed()) return; DO cou=1,InputFileData%NrObsLoc - READ( UnIn2, *, IOStat=IOS ) InputFileData%ObsX(cou), InputFileData%ObsY(cou), InputFileData%ObsZ(cou) - CALL CheckIOS( IOS, ObserverFile, 'Obeserver Locations '//TRIM(Num2LStr(cou)), NumType, ErrStat2, ErrMsg2 ); call check() - ! Return on error if we couldn't read this line - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF + CALL ReadAry( UnIn2, ObserverFile, InputFileData%ObsXYZ(:,cou), SIZE(TmpArray), 'Observer Locations Line '//trim(Num2LStr(cou)), 'Observer Locations', ErrStat2, ErrMsg2, UnEc); if (Failed()) return; ENDDO CLOSE ( UnIn2 ) + UnIn2 = -1 !----- end read from observer file !----------- OUTPUTS ----------------------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Outputs', ErrStat2, ErrMsg2, UnEc); call check() - CALL ReadVar( UnIn,InputFile,InputFileData%aweightflag ,"AWeighting" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() - CALL ReadVar( UnIn, InputFile, InputFileData%NrOutFile, "NrOutFile", "Nr of Output Files (-)", ErrStat2, ErrMsg2, UnEc); call check() - CALL AllocAry( InputFileData%AAOutFile,InputFileData%NrOutFile, 'AAOutFile', ErrStat2, ErrMsg2); call check() - CALL ReadVar ( UnIn, InputFile, InputFileData%AAOutFile(1), 'AAOutFile', 'Name of output file ', ErrStat2, ErrMsg2, UnEc ); call check() + CALL ReadCom( UnIn, InputFile, 'Section Header: Outputs', ErrStat2, ErrMsg2, UnEc); if (Failed()) return; + CALL ReadVar( UnIn,InputFile,InputFileData%aweightflag ,"AWeighting" ,"" ,ErrStat2,ErrMsg2,UnEc); if (Failed()) return; + CALL ReadVar( UnIn, InputFile, InputFileData%NrOutFile, "NrOutFile", "Nr of Output Files (-)", ErrStat2, ErrMsg2, UnEc); if (Failed()) return; + if (InputFileData%NrOutFile < 1 .OR. InputFileData%NrOutFile > 4) then + call SetErrStat(ErrID_Fatal, "NrOutFile must be a value between 1 and 4.", ErrStat, ErrMsg, RoutineName) + CALL Cleanup( ) + return + end if + + CALL ReadVar ( UnIn, InputFile, InputFileData%AAOutFile(1), 'AAOutFile', 'Name of output file ', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; + Line = InputFileData%AAOutFile(1) + call Conv2UC(Line) + IF ( INDEX(Line, "DEFAULT" ) /= 1 ) THEN + IF ( PathIsRelative( InputFileData%AAOutFile(1) ) ) then + CALL GetPath( OutFileRoot, OutPath ) ! Output files will be relative to the path where the primary output file is located. + InputFileData%AAOutFile(1) = TRIM(OutPath)//TRIM(InputFileData%AAOutFile(1)) + END IF + ELSE ! use default program root + InputFileData%AAOutFile(1) = TRIM(OutFileRoot) + ENDIF + DO I=InputFileData%NrOutFile,1,-1 - ! one file name is given by the user and the XXFile1.out XXFile2.out XXFile3.out is generated - IF ( PathIsRelative( InputFileData%AAOutFile(I) ) ) InputFileData%AAOutFile(I) = TRIM(PriPath)//TRIM(InputFileData%AAOutFile(1))//TRIM(Num2Lstr(I))//".out" + ! one file name is given by the user and the XXFile1.out XXFile2.out XXFile3.out is generated + InputFileData%AAOutFile(I) = TRIM(InputFileData%AAOutFile(1))//TRIM(Num2Lstr(I))//".out" ENDDO - ! Return on error at end of section - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF !---------------------- END OF FILE ----------------------------------------- CALL Cleanup( ) CONTAINS - SUBROUTINE Check() - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Check - + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call cleanup() + end function Failed !............................................................................................................................... SUBROUTINE Cleanup() IF (UnIn > 0) CLOSE ( UnIn ) + IF (UnIn2 > 0) CLOSE ( UnIn2 ) END SUBROUTINE Cleanup !............................................................................................................................... END SUBROUTINE ReadPrimaryFile !---------------------------------------------------------------------------------------------------------------------------------- ! ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- - -subroutine ReadRealMatrix(fid, FileName, Mat, VarName, nLines,nRows, iStat, Msg, iLine ) - integer, intent(in) :: fid - real(DbKi), dimension(:,:), allocatable :: Mat - character(len=*), intent(in) :: FileName - character(len=*), intent(in) :: VarName - integer, intent(in) :: nLines - integer, intent(in) :: nRows - integer, intent(out) :: iStat - integer, intent(inout) :: iLine - character(len=*), intent(inout) :: Msg - ! local variables - integer :: i - if (allocated(Mat)) deallocate(Mat) - call allocAry( Mat, nLines, nRows, VarName, iStat, Msg); - if (iStat /= 0) return - !Read Stiffness - DO I =1,nLines - iLine=iLine+1 - ! TODO use ReadCAryFromStr when available in the NWTCIO, it performs more checks - CALL ReadAry( fid, FileName, Mat(I,:), nRows, trim(VarName)//' Line '//Num2LStr(iLine), VarName, iStat, Msg) ! From NWTC_Library - if (iStat /= 0) return - ENDDO -end subroutine - - - -SUBROUTINE ReadBLTables( InputFile, AFI, InputFileData, ErrStat, ErrMsg ) +SUBROUTINE ReadBLTables( InputFile, AFInfo, InputFileData, UnEc, ErrStat, ErrMsg ) ! Passed variables character(*), intent(in) :: InputFile ! Name of the file containing the primary input data - TYPE(AFI_ParameterType), INTENT(IN) :: AFI(:) ! airfoil array: contains names of the BL input file + TYPE(AFI_ParameterType), INTENT(IN) :: AFInfo(:) ! airfoil array: contains names of the BL input file type(AA_InputFile), intent(inout) :: InputFileData ! All the data in the Noise input file + integer(IntKi), intent(in) :: UnEc ! I/O unit for echo file. If > 0, file is open for writing. integer(IntKi), intent(out) :: ErrStat ! Error status character(*), intent(out) :: ErrMsg ! Error message @@ -327,85 +297,129 @@ SUBROUTINE ReadBLTables( InputFile, AFI, InputFileData, ErrStat, ErrMsg ) character(*), parameter :: RoutineName = 'ReadBLTables' integer(IntKi) :: nRe, nAoA, nAirfoils ! Number of Reynolds number, angle of attack, and number of airfoils listed integer(IntKi) :: iAF , iRe, iAoA ! loop counters - real(DbKi), ALLOCATABLE :: Buffer(:,:) - integer :: iLine + real(ReKi) :: Buffer(9) + real(ReKi) :: TempRe ! Initialize some variables: ErrStat = ErrID_None ErrMsg = "" + UnIn = -1 CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - nAirfoils = size(AFI) + nAirfoils = size(AFInfo) do iAF=1,nAirfoils - FileName = trim(AFI(iAF)%BL_file) + FileName = trim(AFInfo(iAF)%BL_file) call WrScr('AeroAcoustics_IO: reading BL table:'//trim(Filename)) CALL GetNewUnit(UnIn, ErrStat2, ErrMsg2); if(Failed()) return CALL OpenFInpFile(UnIn, FileName, ErrStat2, ErrMsg2); if(Failed()) return - CALL ReadCom(UnIn, FileName, "! Boundary layer", ErrStat2, ErrMsg2); if(Failed()) return - CALL ReadCom(UnIn, FileName, "! Legend: aoa", ErrStat2, ErrMsg2); if(Failed()) return + CALL ReadCom(UnIn, FileName, "! Boundary layer", ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + CALL ReadCom(UnIn, FileName, "! Legend: aoa", ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - CALL ReadVar(UnIn, FileName, nRe, "ReListBL", "", ErrStat2, ErrMsg2); if(Failed()) return - CALL ReadVar(UnIn, FileName, nAoA, "aoaListBL", "", ErrStat2, ErrMsg2); if(Failed()) return + CALL ReadVar(UnIn, FileName, nRe, "ReListBL", "", ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + CALL ReadVar(UnIn, FileName, nAoA, "aoaListBL", "", ErrStat2, ErrMsg2, UnEc ); if(Failed()) return if (iAF==1) then - CALL AllocAry(InputFileData%Pres_DispThick ,nAoA,nRe,nAirfoils,'InputFileData%Pres_DispThick' ,ErrStat2,ErrMsg2); if (Failed())return - CALL AllocAry(InputFileData%Suct_DispThick ,nAoA,nRe,nAirfoils,'InputFileData%Suct_DispThick' ,ErrStat2,ErrMsg2); if (Failed())return - CALL AllocAry(InputFileData%Pres_BLThick ,nAoA,nRe,nAirfoils,'InputFileData%Pres_BLThick' ,ErrStat2,ErrMsg2); if (Failed())return - CALL AllocAry(InputFileData%Suct_BLThick ,nAoA,nRe,nAirfoils,'InputFileData%Suct_BLThick' ,ErrStat2,ErrMsg2); if (Failed())return - CALL AllocAry(InputFileData%Pres_Cf ,nAoA,nRe,nAirfoils,'InputFileData%Pres_Cf' ,ErrStat2,ErrMsg2); if (Failed())return - CALL AllocAry(InputFileData%Suct_Cf ,nAoA,nRe,nAirfoils,'InputFileData%Suct_Cf' ,ErrStat2,ErrMsg2); if (Failed())return - CALL AllocAry(InputFileData%Pres_EdgeVelRat,nAoA,nRe,nAirfoils,'InputFileData%Pres_EdgeVelRat',ErrStat2,ErrMsg2); if (Failed())return - CALL AllocAry(InputFileData%Suct_EdgeVelRat,nAoA,nRe,nAirfoils,'InputFileData%Suct_EdgeVelRat',ErrStat2,ErrMsg2); if (Failed())return - - CALL AllocAry(InputFileData%ReListBL,nRe,'InputFileData%ReListBL',ErrStat2,ErrMsg2); if (Failed())return - - - CALL AllocAry(Buffer,nAoA,9, 'Buffer', ErrStat2, ErrMsg2); if(Failed()) return - endif - iLine=8 + if (nAoA < 1 .OR. nRe < 1 ) call SetErrStat(ErrID_Fatal,"ReListBL and aoaListBL must be positive numbers.", ErrStat, ErrMsg, RoutineName) + + CALL AllocAry(InputFileData%Pres_DispThick ,nAoA,nRe,nAirfoils,'Pres_DispThick' ,ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(InputFileData%Suct_DispThick ,nAoA,nRe,nAirfoils,'Suct_DispThick' ,ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(InputFileData%Pres_BLThick ,nAoA,nRe,nAirfoils,'Pres_BLThick' ,ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(InputFileData%Suct_BLThick ,nAoA,nRe,nAirfoils,'Suct_BLThick' ,ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(InputFileData%Pres_Cf ,nAoA,nRe,nAirfoils,'Pres_Cf' ,ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(InputFileData%Suct_Cf ,nAoA,nRe,nAirfoils,'Suct_Cf' ,ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(InputFileData%Pres_EdgeVelRat,nAoA,nRe,nAirfoils,'Pres_EdgeVelRat',ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(InputFileData%Suct_EdgeVelRat,nAoA,nRe,nAirfoils,'Suct_EdgeVelRat',ErrStat2,ErrMsg2); if (Failed())return + + CALL AllocAry(InputFileData%AoAListBL, nAoA, 'AoAListBL', ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(InputFileData%ReListBL, nRe, 'ReListBL', ErrStat2,ErrMsg2); if (Failed())return + else + if (nAoA /= SIZE(InputFileData%Pres_DispThick,1) .OR. & + nRe /= SIZE(InputFileData%Pres_DispThick,2) ) then + call SetErrStat(ErrID_Fatal,'All aeroacoustics airfoils must have the same number of angles of attack and reynolds numbers', ErrStat, ErrMsg, RoutineName) + call cleanup() + return + end if + endif + do iRe=1,nRe - CALL ReadVar(UnIn, FileName, InputFileData%ReListBL(iRe), 'InputFileData%ReListBL','ReListBL', ErrStat2, ErrMsg2); if(Failed()) return - InputFileData%ReListBL(iRe) = InputFileData%ReListBL(iRe) * 1.e+006 - CALL ReadCom(UnIn, FileName, "aoa Ue_Vinf_SS Ue_Vinf_PS Dstar_SS Dstar_PS Theta_SS Theta_PS Cf_SS Cf_PS", ErrStat2, ErrMsg2); if(Failed()) return - CALL ReadCom(UnIn, FileName, "(deg) (-) (-) (-) (-) (-) (-) (-) (-)", ErrStat2, ErrMsg2); if(Failed()) return + CALL ReadVar(UnIn, FileName, TempRe, 'InputFileData%ReListBL','ReListBL', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + if (iAF == 1) then + InputFileData%ReListBL(iRe) = TempRe * 1.e+006 + + if (iRe > 1) then + if (InputFileData%ReListBL(iRe) <= InputFileData%ReListBL(iRe-1) ) then + call SetErrStat(ErrID_Fatal,'All aeroacoustics BL tables must have Reynolds Numbers entered in increasing order.',ErrStat, ErrMsg, RoutineName) + call cleanup() + return + end if + end if + + else + if ( nRe > 1 .AND. .NOT. EqualRealNos(InputFileData%ReListBL(iRe), TempRe * 1.e+006 ) ) then + call SetErrStat(ErrID_Fatal,'All aeroacoustics BL tables must have the same Reynolds Numbers.',ErrStat, ErrMsg, RoutineName) + call cleanup() + return + end if + end if - call ReadRealMatrix(UnIn, FileName, Buffer, 'BL Matrix', nAoA, 9, ErrStat2, ErrMsg2, iLine) + CALL ReadCom(UnIn, FileName, "aoa Ue_Vinf_SS Ue_Vinf_PS Dstar_SS Dstar_PS Theta_SS Theta_PS Cf_SS Cf_PS", ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + CALL ReadCom(UnIn, FileName, "(deg) (-) (-) (-) (-) (-) (-) (-) (-)", ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - if(Failed()) return do iAoA=1,nAoA - InputFileData%Suct_EdgeVelRat(iAoA,iRe,iAF)= Buffer(iAoA, 2) ! EdgeVelRat1 Suction - InputFileData%Pres_EdgeVelRat(iAoA,iRe,iAF)= Buffer(iAoA, 3) ! EdgeVelRat2 Pressure - InputFileData%Suct_DispThick (iAoA,iRe,iAF)= Buffer(iAoA, 4) ! dStarAll1 Suction - InputFileData%Pres_DispThick (iAoA,iRe,iAF)= Buffer(iAoA, 5) ! dStarAll2 Pressure - InputFileData%Suct_BLThick (iAoA,iRe,iAF)= Buffer(iAoA, 6) ! d99All1 Suction - InputFileData%Pres_BLThick (iAoA,iRe,iAF)= Buffer(iAoA, 7) ! d99All2 Pressure - InputFileData%Suct_Cf (iAoA,iRe,iAF)= Buffer(iAoA, 8) ! CfAll1 Suction - InputFileData%Pres_Cf (iAoA,iRe,iAF)= Buffer(iAoA, 9) ! CfAll2 Pressure + CALL ReadAry( UnIn, FileName, Buffer, SIZE(Buffer), 'BL Table Line '//Num2LStr(iAoA+8), 'BL Table for suction and pressure', ErrStat2, ErrMsg2, UnEc) ! From NWTC_Library + if(Failed()) return + + Buffer(1) = Buffer(1)*D2R ! convert to radians + call MPi2Pi( Buffer(1) ) ! convert to radians between -pi and pi + Buffer(1) = Buffer(1)*R2D ! convert back to degrees + + if (iAF == 1 .AND. iRe == 1) then + InputFileData%AoAListBL(iAoA) = Buffer( 1) ! AoA in degrees + + if (iAoA > 1) then + + if (InputFileData%AoAListBL(iAoA) <= InputFileData%AoAListBL(iAoA-1) ) then + call SetErrStat(ErrID_Fatal,'All aeroacoustics BL tables angles of attack must be entered in increasing order.',ErrStat, ErrMsg, RoutineName) + call cleanup() + return + end if + end if + + else + if ( .NOT. EqualRealNos(InputFileData%AoAListBL(iAoA), Buffer( 1) ) ) then + call SetErrStat(ErrID_Fatal,'All aeroacoustics BL tables must have the same angles of attack.',ErrStat, ErrMsg, RoutineName) + call cleanup() + return + end if + end if + + InputFileData%Suct_EdgeVelRat(iAoA,iRe,iAF)= Buffer(2) ! EdgeVelRat1 Suction + InputFileData%Pres_EdgeVelRat(iAoA,iRe,iAF)= Buffer(3) ! EdgeVelRat2 Pressure + InputFileData%Suct_DispThick (iAoA,iRe,iAF)= Buffer(4) ! dStarAll1 Suction + InputFileData%Pres_DispThick (iAoA,iRe,iAF)= Buffer(5) ! dStarAll2 Pressure + InputFileData%Suct_BLThick (iAoA,iRe,iAF)= Buffer(6) ! d99All1 Suction + InputFileData%Pres_BLThick (iAoA,iRe,iAF)= Buffer(7) ! d99All2 Pressure + InputFileData%Suct_Cf (iAoA,iRe,iAF)= Buffer(8) ! CfAll1 Suction + InputFileData%Pres_Cf (iAoA,iRe,iAF)= Buffer(9) ! CfAll2 Pressure enddo enddo - if (iAF == 1) then - CALL AllocAry(InputFileData%AoAListBL,nAoA, 'InputFileData%AoAListBL', ErrStat2, ErrMsg2); if(Failed()) return - do iAoA=1,nAoA - InputFileData%AoAListBL(iAoA)= Buffer(iAoA, 1) ! AoA - enddo - endif - - if (InputFileData%IBLUNT==1) then - call ReadCom(UnIn, FileName, 'Comment' , ErrStat2, ErrMsg2) - call ReadCom(UnIn, FileName, 'Comment' , ErrStat2, ErrMsg2) - call ReadVar(UnIn, FileName, InputFileData%BladeProps(iAF)%TEAngle, 'TEAngle', 'TE Angle',ErrStat2, ErrMsg2); if(Failed()) return - call ReadVar(UnIn, FileName, InputFileData%BladeProps(iAF)%TEThick, 'TEThick', 'TE Thick',ErrStat2, ErrMsg2); if(Failed()) return + + if (InputFileData%IBLUNT==IBLUNT_BPM) then + call ReadCom(UnIn, FileName, 'Comment' , ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + call ReadCom(UnIn, FileName, 'Comment' , ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + call ReadVar(UnIn, FileName, InputFileData%BladeProps(iAF)%TEAngle, 'TEAngle', 'TE Angle',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + call ReadVar(UnIn, FileName, InputFileData%BladeProps(iAF)%TEThick, 'TEThick', 'TE Thick',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return else InputFileData%BladeProps(iAF)%TEAngle = 0._ReKi InputFileData%BladeProps(iAF)%TEThick = 0._ReKi endif - if (UnIn > 0) CLOSE(UnIn) + call Cleanup() enddo CALL Cleanup( ) @@ -428,48 +442,58 @@ SUBROUTINE ValidateInputData( InputFileData, NumBl, ErrStat, ErrMsg ) character(*), intent(out) :: ErrMsg !< Error message ! local variables character(*), parameter :: RoutineName = 'ValidateInputData' + ErrStat = ErrID_None ErrMsg = "" + if (NumBl > MaxBl .or. NumBl < 1) call SetErrStat( ErrID_Fatal, 'Number of blades must be between 1 and '//trim(num2lstr(MaxBl))//'.', ErrSTat, ErrMsg, RoutineName ) + if (InputFileData%DT_AA <= 0.0) call SetErrStat ( ErrID_Fatal, 'DT_AA must be greater than zero.', ErrStat, ErrMsg, RoutineName ) + if (InputFileData%IBLUNT /= IBLUNT_None .and. InputFileData%IBLUNT /= IBLUNT_BPM) then call SetErrStat ( ErrID_Fatal, & 'IBLUNT must '//trim(num2lstr(IBLUNT_None))//' (none) or '//trim(num2lstr(IBLUNT_BPM))//' (Bluntness noise calculated).', ErrStat, ErrMsg, RoutineName ) endif if (InputFileData%ILAM /= ILAM_None .and. InputFileData%ilam /= ILAM_BPM) then - call SetErrStat ( ErrID_Fatal, 'ILAM must be '//trim(num2lstr(ILAM_None))//' No calculation '//& + call SetErrStat ( ErrID_Fatal, 'ILAM must be '//trim(num2lstr(ILAM_None))//' No calculation '//& trim(num2lstr(ILAM_BPM))//' (ILAM Calculated).', ErrStat, ErrMsg, RoutineName ) end if if (InputFileData%ITIP /= ITIP_None .and. InputFileData%ITIP /= ITIP_ON) then - call SetErrStat ( ErrID_Fatal, 'ITIP must be '//trim(num2lstr(ITIP_None))//' (Off) or '//& + call SetErrStat ( ErrID_Fatal, 'ITIP must be '//trim(num2lstr(ITIP_None))//' (Off) or '//& trim(num2lstr(ITIP_On))//' (ITIP On).', ErrStat, ErrMsg, RoutineName ) end if if (InputFileData%ITRIP /= ITRIP_None .and. InputFileData%ITRIP /= ITRIP_Heavy .and. InputFileData%ITRIP /= ITRIP_Light) then - call SetErrStat ( ErrID_Fatal,'ITRIP must be '//trim(num2lstr(ITRIP_None))//' (none) or '//trim(num2lstr(ITRIP_Heavy))//& + call SetErrStat ( ErrID_Fatal,'ITRIP must be '//trim(num2lstr(ITRIP_None))//' (none) or '//trim(num2lstr(ITRIP_Heavy))//& ' (heavily tripped BL Calculation) or '//trim(num2lstr(ITRIP_Light))//' (lightly tripped BL)' ,ErrStat, ErrMsg, RoutineName ) end if if (InputFileData%ITURB /= ITURB_None .and. InputFileData%ITURB /= ITURB_BPM .and. InputFileData%ITURB /= ITURB_TNO) then - call SetErrStat ( ErrID_Fatal, 'ITURB must be 0 (off) or 1 (BPM) or 2 (TNO) .', ErrStat, ErrMsg, RoutineName ) + call SetErrStat ( ErrID_Fatal, 'ITURB must be 0 (off) or 1 (BPM) or 2 (TNO) .', ErrStat, ErrMsg, RoutineName ) end if if (InputFileData%IInflow /= IInflow_None .and. InputFileData%IInflow /= IInflow_BPM & .and. InputFileData%IInflow /= IInflow_FullGuidati .and. InputFileData%IInflow /= IInflow_SimpleGuidati ) then - call SetErrStat ( ErrID_Fatal, 'IInflow must be 0 (off) or 1 (only Amiet) or 2 (Full Guidati)'//& + call SetErrStat ( ErrID_Fatal, 'IInflow must be 0 (off) or 1 (only Amiet) or 2 (Full Guidati)'//& 'or 3 (Simple Guidati).', ErrStat, ErrMsg, RoutineName ) end if if (InputFileData%TICalcMeth /= TICalc_Every .and. InputFileData%TICalcMeth /= TICalc_Interp ) then - call SetErrStat ( ErrID_Fatal, 'TICalcMeth must be '//trim(num2lstr(TICalc_Every))//' TICalc automatic or '//& + call SetErrStat ( ErrID_Fatal, 'TICalcMeth must be '//trim(num2lstr(TICalc_Every))//' (TICalc automatic) or '//& trim(num2lstr(TICalc_Interp))//' (TICalcMeth interp).', ErrStat, ErrMsg, RoutineName ) end if if (InputFileData%X_BLMethod /= X_BLMethod_BPM .and. InputFileData%X_BLMethod /= X_BLMethod_Tables) then - call SetErrStat ( ErrID_Fatal, 'X_BLMethod must be '//trim(num2lstr(X_BLMethod_BPM))//' X_BLMethod_ with BPM or '//& + call SetErrStat ( ErrID_Fatal, 'X_BLMethod must be '//trim(num2lstr(X_BLMethod_BPM))//' X_BLMethod_ with BPM or '//& trim(num2lstr(X_BLMethod_Tables))//' (X_BLMethod with BL tables).', ErrStat, ErrMsg, RoutineName ) end if + if (InputFileData%NrObsLoc <= 0.0) call SetErrStat ( ErrID_Fatal, 'Number of Observer Locations should be greater than zero', ErrStat, ErrMsg, RoutineName ) - if (InputFileData%NrOutFile /= 1 .and. InputFileData%NrOutFile /= 2 .and. InputFileData%NrOutFile /= 3 & - .and. InputFileData%NrOutFile /= 4) then - call SetErrStat ( ErrID_Fatal, ' NrOutFile must be 1 or 2 or 3 or 4', ErrStat, ErrMsg, RoutineName ) + + if (InputFileData%NrOutFile /= 1 .and. InputFileData%NrOutFile /= 2 .and. InputFileData%NrOutFile /= 3 .and. InputFileData%NrOutFile /= 4) then + call SetErrStat ( ErrID_Fatal, ' NrOutFile must be 1 or 2 or 3 or 4', ErrStat, ErrMsg, RoutineName ) + end if + + if (InputFileData%AA_Bl_Prcntge > 100.0 .or. InputFileData%AA_Bl_Prcntge < 0.0) then + call SetErrStat ( ErrID_Fatal, ' AA_Bl_Prcntge must be between 0 and 100%', ErrStat, ErrMsg, RoutineName ) end if + END SUBROUTINE ValidateInputData !---------------------------------------------------------------------------------------------------------------------------------- @@ -485,69 +509,92 @@ subroutine AA_SetInitOut(p, InitOut, errStat, errMsg) character(ErrMsgLen) :: ErrMsg2 ! temporary Error message character(*), parameter :: RoutineName = 'AA_SetInitOut' integer(IntKi) :: i, j, k,oi + CHARACTER(16) :: ChanBNPrefix ! Name prefix (AeroB#_Z######y_) + CHARACTER(6) :: TmpChar ! Temporary char array to hold the node digits (2 places only!!!!) + ! Initialize variables for this routine + errStat = ErrID_None errMsg = "" - InitOut%AirDens = p%AirDens + ! FIRST FILE HEADER,UNIT - call AllocAry(InitOut%WriteOutputHdr, p%numOuts, 'WriteOutputHdr', errStat2, errMsg2); if(Failed()) return - call AllocAry(InitOut%WriteOutputUnt, p%numOuts, 'WriteOutputUnt', errStat2, errMsg2); if(Failed()) return + call AllocAry(InitOut%WriteOutputHdr, p%numOutsAll(1), 'WriteOutputHdr', errStat2, errMsg2); if(Failed()) return + call AllocAry(InitOut%WriteOutputUnt, p%numOutsAll(1), 'WriteOutputUnt', errStat2, errMsg2); if(Failed()) return do j=1,p%NrObsLoc InitOut%WriteOutputHdr(j)="Obs"//trim(num2lstr(j)) InitOut%WriteOutputUnt(j) = "OASPL" enddo ! SECOND FILE HEADER,UNIT - call AllocAry(InitOut%WriteOutputHdrforPE, p%numOutsforPE, 'WriteOutputHdrforPE', errStat2, errMsg2); if(Failed()) return - call AllocAry(InitOut%WriteOutputUntforPE, p%numOutsforPE, 'WriteOutputUntforPE', errStat2, errMsg2); if(Failed()) return - i=0 - do j=1,p%NrObsLoc - do k=1,size(p%FreqList) - i=i+1 - InitOut%WriteOutputHdrforPE(i) = "Obs"//trim(num2lstr(j))//"_Freq"//trim(num2lstr(p%FreqList(k))) - if(p%aweightflag .eqv. .TRUE.) then - InitOut%WriteOutputUntforPE(i) = "SPL_A" - else - InitOut%WriteOutputUntforPE(i) = "SPL" - endif - end do - enddo - ! THIRD FILE HEADER,UNIT - call AllocAry(InitOut%WriteOutputHdrSep, p%NumOutsForSep, 'WriteOutputHdrSep', errStat2, errMsg2); if(Failed()) return - call AllocAry(InitOut%WriteOutputUntSep, p%NumOutsForSep, 'WriteOutputUntSep', errStat2, errMsg2); if(Failed()) return - i=0 - do j=1,p%NrObsLoc - do k=1,size(p%FreqList) - do oi=1,7 - i=i+1 - InitOut%WriteOutputHdrSep(i) = "Obs"//trim(num2lstr(j))//"_Freq"//trim(num2lstr(p%FreqList(k)))//"_Type"//trim(num2lstr(oi)) - InitOut%WriteOutputHdrSep(i)=trim(InitOut%WriteOutputHdrSep(i)) - if(p%aweightflag .eqv. .TRUE.) then - InitOut%WriteOutputUntSep(i) = "SPL_A" - else - InitOut%WriteOutputUntSep(i) = "SPL" - endif - enddo - enddo - enddo + if (p%NrOutFile>1) then + i=0 + call AllocAry(InitOut%WriteOutputHdrforPE, p%numOutsAll(2), 'WriteOutputHdrPE', errStat2, errMsg2); if(Failed()) return + call AllocAry(InitOut%WriteOutputUntforPE, p%numOutsAll(2), 'WriteOutputUntPE', errStat2, errMsg2); if(Failed()) return + do j=1,p%NrObsLoc + do k=1,size(p%FreqList) + i=i+1 + InitOut%WriteOutputHdrforPE(i) = "Obs"//trim(num2lstr(j))//"_Freq"//trim(num2lstr(p%FreqList(k))) + end do + enddo + if(p%aweightflag) then ! whole array + InitOut%WriteOutputUntforPE = "SPL_A" + else + InitOut%WriteOutputUntforPE = "SPL" + endif + + + if (p%NrOutFile>2) then + ! THIRD FILE HEADER,UNIT + call AllocAry(InitOut%WriteOutputHdrSep, p%numOutsAll(3), 'WriteOutputHdrSep', errStat2, errMsg2); if(Failed()) return + call AllocAry(InitOut%WriteOutputUntSep, p%numOutsAll(3), 'WriteOutputUntSep', errStat2, errMsg2); if(Failed()) return + i=0 + do j=1,p%NrObsLoc + do k=1,size(p%FreqList) + do oi=1,nNoiseMechanism + i=i+1 + InitOut%WriteOutputHdrSep(i) = "Obs"//trim(num2lstr(j))//"_Freq"//trim(num2lstr(p%FreqList(k)))//"_Type"//trim(num2lstr(oi)) + InitOut%WriteOutputHdrSep(i)=trim(InitOut%WriteOutputHdrSep(i)) + enddo + enddo + enddo + if(p%aweightflag) then ! whole array + InitOut%WriteOutputUntSep = "SPL_A" + else + InitOut%WriteOutputUntSep = "SPL" + endif + + if (p%NrOutFile>3) then + ! FOURTH FILE HEADER,UNIT + call AllocAry(InitOut%WriteOutputHdrNodes,p%numOutsAll(4), 'InitOut%WriteOutputHdrNodes', errStat2, errMsg2); if(Failed()) return + call AllocAry(InitOut%WriteOutputUntNodes,p%numOutsAll(4), 'InitOut%WriteOutputUntNodes', errStat2, errMsg2); if(Failed()) return + i=0 + do oi = 1,p%numBlades + do k = 1,p%NumBlNds + do j = 1,p%NrObsLoc + i=i+1 + ChanBNPrefix = setChannelBldNdPrefix(oi,k) + InitOut%WriteOutputHdrNodes(i) = trim(ChanBNPrefix)//"Obs"//trim(num2lstr(j)) + enddo + enddo + enddo + InitOut%WriteOutputUntNodes = "SPL" + + end if ! file 4 + end if ! file 3 + end if ! file 2 + +contains - ! FOURTH FILE HEADER,UNIT - call AllocAry(InitOut%WriteOutputHdrNodes,p%numBlades*p%NumBlNds*p%NrObsLoc, 'InitOut%WriteOutputHdrNodes', errStat2, errMsg2); if(Failed()) return - call AllocAry(InitOut%WriteOutputUntNodes,p%numBlades*p%NumBlNds*p%NrObsLoc, 'InitOut%WriteOutputUntNodes', errStat2, errMsg2); if(Failed()) return - i=0 - do oi = 1,p%numBlades - do k = 1,p%NumBlNds - do j = 1,p%NrObsLoc - i=i+1 - InitOut%WriteOutputHdrNodes(i) = "Bld"//trim(num2lstr(oi))//"Node"//trim(num2lstr(k))//"Obs"//trim(num2lstr(j)) - InitOut%WriteOutputUntNodes(i) = "SPL" - enddo - enddo - enddo - InitOut%Ver = AA_Ver - InitOut%delim = Tab + function setChannelBldNdPrefix(IdxBlade,IdxNode) result(ChanPrefix) + INTEGER(IntKi), intent(in) :: IdxBlade ! Counter to which blade we are on + INTEGER(IntKi), intent(in) :: IdxNode ! Counter to the blade node we ae on + CHARACTER(16) :: ChanPrefix ! Name prefix (AeroB#_Z######y_) + + ! Create the name prefix: + WRITE (TmpChar,'(I3.3)') IdxNode ! 3 digit number + ChanPrefix = 'AB' // TRIM(Num2LStr(IdxBlade)) // 'N' // TRIM(TmpChar) + end function -contains logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev @@ -560,146 +607,97 @@ subroutine AA_InitializeOutputFile(p, InputFileData,InitOut,errStat, errMsg) type(AA_InitOutputType), intent(in ) :: InitOut !< output data integer(IntKi) , intent(inout) :: errStat !< Status of error message character(*) , intent(inout) :: errMsg !< Error message if ErrStat /= ErrID_None - ! locals + + ! Local variables integer(IntKi) :: i - integer(IntKi) :: numOuts + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'AA_InitializeOutputFile' + + + p%unOutFile = -1 + ErrStat = ErrID_None + ErrMsg = "" + ErrStat2 = ErrID_None + ErrMsg2 = "" + + ! FIRST FILE - IF (InputFileData%NrOutFile .gt.0) THEN - call GetNewUnit( p%unOutFile, ErrStat, ErrMsg ) - if ( ErrStat >= AbortErrLev ) then - p%unOutFile = -1 - return - end if - - call OpenFOutFile ( p%unOutFile, trim(InputFileData%AAOutFile(1)), ErrStat, ErrMsg ) - if ( ErrStat >= AbortErrLev ) return - - write (p%unOutFile,'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using AA '//trim(GetNVD(InitOut%ver)) - write (p%unOutFile,'(A)') '' - write( p%unOutFile,'(A,I5)' ) 'Number of observers :', p%NrObsLoc - write (p%unOutFile,'(A)') 'Description from AA input file, line2: '//trim(InputFileData%FTitle) - write (p%unOutFile,'(A)') '' - numOuts = size(InitOut%WriteOutputHdr) - !...................................................... - ! Write the names of the output parameters on one line: line 7 - !...................................................... - call WrFileNR ( p%unOutFile, ' Time ' ) - do i=1,NumOuts - call WrFileNR ( p%unOutFile, InitOut%delim//InitOut%WriteOutputHdr(i) ) - end do ! i - write (p%unOutFile,'()') - !...................................................... - ! Write the units of the output parameters on one line: line 8 - !...................................................... - call WrFileNR ( p%unOutFile, ' (s) ' ) - do i=1,NumOuts - call WrFileNR ( p%unOutFile, InitOut%delim//InitOut%WriteOutputUnt(i) ) - end do ! i - write (p%unOutFile,'()') - ENDIF + call WriteHeader(1,InitOut%WriteOutputHdr,InitOut%WriteOutputUnt,'Number of observers :'//TRIM(num2lstr(p%NrObsLoc)) ) + if (Failed()) return + ! SECOND FILE - IF (InputFileData%NrOutFile .gt. 1) THEN - call GetNewUnit( p%unOutFile2, ErrStat, ErrMsg ) - if ( ErrStat >= AbortErrLev ) then - p%unOutFile = -1 - return - end if - call OpenFOutFile ( p%unOutFile2, trim(InputFileData%AAOutFile(2)), ErrStat, ErrMsg ) - if ( ErrStat >= AbortErrLev ) return - write (p%unOutFile2,'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using AA '//trim(GetNVD(InitOut%Ver)) - write (p%unOutFile2,'(A)') '' - write( p%unOutFile2,'(A,I5,A,I5)' ) 'Number of observers :', p%NrObsLoc,'; Number of frequencies :', size(p%FreqList) - write (p%unOutFile2,'(A)') 'Description from AA input file, line2: '//trim(InputFileData%FTitle) - write (p%unOutFile2,'(A)') '' - numOuts = size(InitOut%WriteOutputHdrforPE) - !...................................................... - ! Write the names of the output parameters on one line: line 7 - !...................................................... - call WrFileNR ( p%unOutFile2, ' Time ' ) - do i=1,NumOuts - call WrFileNR ( p%unOutFile2, InitOut%delim//InitOut%WriteOutputHdrforPE(i) ) - end do ! i - write (p%unOutFile2,'()') - !...................................................... - ! Write the units of the output parameters on one line: line 8 - !...................................................... - call WrFileNR ( p%unOutFile2, ' (s) ' ) - do i=1,NumOuts - call WrFileNR ( p%unOutFile2, InitOut%delim//InitOut%WriteOutputUntforPE(i) ) - end do ! i - write (p%unOutFile2,'()') - !frmt = '"'//p%delim//'"'//trim(p%outFmt) ! format for array elements from individual modules - !call WrNumAryFileNR ( p%unOutFile2, p%FreqList, frmt, errStat, errMsg ) - !if ( errStat >= AbortErrLev ) return - !write (p%unOutFile2,'()') + IF (InputFileData%NrOutFile > 1) THEN + call WriteHeader(2,InitOut%WriteOutputHdrforPE,InitOut%WriteOutputUntforPE,'Number of observers :'//TRIM(num2lstr(p%NrObsLoc))//'; Number of frequencies :'//TRIM(num2lstr(size(p%FreqList))) ) + if (Failed()) return + + ! THIRD FILE + IF (InputFileData%NrOutFile > 2) THEN + call WriteHeader(3,InitOut%WriteOutputHdrSep,InitOut%WriteOutputUntSep,'Number of observers :'//TRIM(num2lstr(p%NrObsLoc))//'; Number of frequencies :'//TRIM(num2lstr(size(p%FreqList)))//"; 1-LBL 2-TBLPres 3-TBLSuc 4-Sep 5-BLUNT 6-TIP 7-Inflow" ) + if (Failed()) return + + ! FOURTH FILE + IF (InputFileData%NrOutFile > 3) THEN + call WriteHeader(4,InitOut%WriteOutputHdrNodes,InitOut%WriteOutputUntNodes,'Number of observers :'//TRIM(num2lstr(p%NrObsLoc))//'; Number of blades :'//TRIM(num2lstr(p%numBlades))//'; Number of nodes per blade:'//TRIM(num2lstr(p%NumBlNds)) ) + if (Failed()) return + ENDIF + + ENDIF ENDIF - ! THIRD FILE - IF (InputFileData%NrOutFile .gt. 2) THEN - call GetNewUnit( p%unOutFile3, ErrStat, ErrMsg ) - if ( ErrStat >= AbortErrLev ) then - p%unOutFile = -1 - return - end if - call OpenFOutFile ( p%unOutFile3, trim(InputFileData%AAOutFile(3)), ErrStat, ErrMsg ) - if ( ErrStat >= AbortErrLev ) return - write (p%unOutFile3,'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using AA '//trim(GetNVD(InitOut%Ver)) - write (p%unOutFile3,'(A)') '' - write( p%unOutFile3,'(A,I5,A,I5)' ) 'Number of observers :', p%NrObsLoc,'; Number of frequencies :', size(p%FreqList) - write (p%unOutFile3,'(A)') 'Description from AA input file, line2: '//trim(InputFileData%FTitle) - numOuts = size(InitOut%WriteOutputHdrSep) - !...................................................... - ! Write the names of the output parameters on one line: line 7 - !...................................................... - call WrFileNR ( p%unOutFile3, "1-LBL 2-TBLPres 3-TBLSuc 4-Sep 5-BLUNT 6-TIP 7-Inflow") - write (p%unOutFile3,'()') - call WrFileNR ( p%unOutFile3, ' Time ' ) - do i=1,NumOuts - call WrFileNR ( p%unOutFile3, InitOut%delim//InitOut%WriteOutputHdrSep(i) ) - end do ! i - write (p%unOutFile3,'()') - !...................................................... - ! Write the units of the output parameters on one line: line 8 - !...................................................... - call WrFileNR ( p%unOutFile3, ' (s) ' ) - do i=1,NumOuts - call WrFileNR ( p%unOutFile3, InitOut%delim//InitOut%WriteOutputUntSep(i) ) - end do ! i - write (p%unOutFile3,'()') - ENDIF - ! FOURTH FILE - IF (InputFileData%NrOutFile .gt. 3) THEN - call GetNewUnit( p%unOutFile4, ErrStat, ErrMsg ) - if ( ErrStat >= AbortErrLev ) then - p%unOutFile = -1 - return - end if - call OpenFOutFile ( p%unOutFile4, trim(InputFileData%AAOutFile(4)), ErrStat, ErrMsg ) - if ( ErrStat >= AbortErrLev ) return - write (p%unOutFile4,'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using AA '//trim(GetNVD(InitOut%Ver)) - write (p%unOutFile4,'()') - write( p%unOutFile4,'(A,I5)' ) 'Number of observers :', p%NrObsLoc, '; Number of blades :', p%numBlades,' Number of nodes per blade:', p%NumBlNds - write (p%unOutFile4,'(A)') 'Description from AA input file, line2: '//trim(InputFileData%FTitle) - numOuts = size(InitOut%WriteOutputHdrNodes) + +contains + !------------------------------------------------------------------------------------------------- + subroutine WriteHeader(iFile,WrOutHdr,WrOutUnt,LineTxt) + integer(IntKi), intent(in) :: iFile + CHARACTER(*), intent(in) :: WrOutHdr(:) + CHARACTER(*), intent(in) :: WrOutUnt(:) + character(*), intent(in) :: LineTxt ! text description to write to line 3 of the file + + call GetNewUnit( p%unOutFile(iFile), ErrStat2, ErrMsg2 ) + if (Failed()) return + + call OpenFOutFile ( p%unOutFile(iFile), trim(InputFileData%AAOutFile(iFile)), ErrStat2, ErrMsg2 ) + if (Failed()) return + + write (p%unOutFile(iFile),'(A)') '' + write (p%unOutFile(iFile),'(A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using AA '//trim(GetNVD(AA_ver)) + write (p%unOutFile(iFile),'(A)') '' + write( p%unOutFile(iFile),'(A)') TRIM(LineTxt) + write (p%unOutFile(iFile),'(A)') 'Description from AA input file, line2: '//trim(InputFileData%FTitle) + write (p%unOutFile(iFile),'(A)') '' + !...................................................... ! Write the names of the output parameters on one line: line 7 !...................................................... - write (p%unOutFile4,'()') - call WrFileNR ( p%unOutFile4, ' Time ' ) - do i=1,NumOuts - call WrFileNR ( p%unOutFile4, InitOut%delim//InitOut%WriteOutputHdrNodes(i) ) + call WrFileNR ( p%unOutFile(iFile), ' Time ' ) + do i=1,p%NumOutsAll(iFile) + call WrFileNR ( p%unOutFile(iFile), delim//WrOutHdr(i) ) end do ! i - write (p%unOutFile4,'()') + write (p%unOutFile(iFile),'()') + !...................................................... ! Write the units of the output parameters on one line: line 8 !...................................................... - call WrFileNR ( p%unOutFile4, ' (s) ' ) - do i=1,NumOuts - call WrFileNR ( p%unOutFile4, InitOut%delim//InitOut%WriteOutputUntNodes(i) ) + call WrFileNR ( p%unOutFile(iFile), ' (s) ' ) + do i=1,p%NumOutsAll(iFile) + call WrFileNR ( p%unOutFile(iFile), delim//WrOutUnt(i) ) end do ! i - write (p%unOutFile4,'()') - ENDIF + write (p%unOutFile(iFile),'()') + + end subroutine + !------------------------------------------------------------------------------------------------- + subroutine cleanup() + + end subroutine + !------------------------------------------------------------------------------------------------- + LOGICAL function Failed() + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call cleanup() + end function + !------------------------------------------------------------------------------------------------- end subroutine AA_InitializeOutputFile !---------------------------------------------------------------------------------------------------------------------------------- subroutine AA_WriteOutputLine(y, t, p, errStat, errMsg) @@ -711,63 +709,56 @@ subroutine AA_WriteOutputLine(y, t, p, errStat, errMsg) ! Local variables. character(200) :: frmt ! A string to hold a format specifier character(15) :: tmpStr ! temporary string to print the time output as text - integer :: numOuts + errStat = ErrID_None errMsg = '' + + frmt = '"'//delim//'"'//trim(p%outFmt) ! format for array elements from individual modules + write( tmpStr, '(F15.4)' ) t + ! FIRST FILE IF (p%NrOutFile .gt. 0) THEN - numOuts = size(y%WriteOutput) - frmt = '"'//p%delim//'"'//trim(p%outFmt) ! format for array elements from individual modules ! time - write( tmpStr, '(F15.4)' ) t - call WrFileNR( p%unOutFile, tmpStr ) - call WrNumAryFileNR ( p%unOutFile, y%WriteOutput, frmt, errStat, errMsg ) + call WrFileNR( p%unOutFile(1), tmpStr ) + call WrNumAryFileNR ( p%unOutFile(1), y%WriteOutput, frmt, errStat, errMsg ) if ( errStat >= AbortErrLev ) return ! write a new line (advance to the next line) - write (p%unOutFile,'()') + write (p%unOutFile(1),'()') ENDIF !! SECOND FILE IF (p%NrOutFile .gt. 1) THEN - numOuts = size(y%WriteOutputforPE) - frmt = '"'//p%delim//'"'//trim(p%outFmt) ! format for array elements from individual modules ! time - write( tmpStr, '(F15.4)' ) t - call WrFileNR( p%unOutFile2, tmpStr ) - call WrNumAryFileNR ( p%unOutFile2, y%WriteOutputforPE, frmt, errStat, errMsg ) + call WrFileNR( p%unOutFile(2), tmpStr ) + call WrNumAryFileNR ( p%unOutFile(2), y%WriteOutputforPE, frmt, errStat, errMsg ) if ( errStat >= AbortErrLev ) return ! write a new line (advance to the next line) - write (p%unOutFile2,'()') + write (p%unOutFile(2),'()') ENDIF + ! THIRD FILE IF (p%NrOutFile .gt. 2) THEN - numOuts = size(y%WriteOutputSep) - frmt = '"'//p%delim//'"'//trim(p%outFmt) ! format for array elements from individual modules ! time - write( tmpStr, '(F15.4)' ) t - call WrFileNR( p%unOutFile3, tmpStr ) - call WrNumAryFileNR ( p%unOutFile3, y%WriteOutputSep, frmt, errStat, errMsg ) + call WrFileNR( p%unOutFile(3), tmpStr ) + call WrNumAryFileNR ( p%unOutFile(3), y%WriteOutputSep, frmt, errStat, errMsg ) if ( errStat >= AbortErrLev ) return ! write a new line (advance to the next line) - write (p%unOutFile3,'()') + write (p%unOutFile(3),'()') ENDIF + ! Fourth FILE IF (p%NrOutFile .gt. 3) THEN - numOuts = size(y%WriteOutputNode) - frmt = '"'//p%delim//'"'//trim(p%outFmt) ! format for array elements from individual modules ! time - write( tmpStr, '(F15.4)' ) t - call WrFileNR( p%unOutFile4, tmpStr ) - call WrNumAryFileNR ( p%unOutFile4, y%WriteOutputNode, frmt, errStat, errMsg ) + call WrFileNR( p%unOutFile(4), tmpStr ) + call WrNumAryFileNR ( p%unOutFile(4), y%WriteOutputNodes, frmt, errStat, errMsg ) if ( errStat >= AbortErrLev ) return ! write a new line (advance to the next line) - write (p%unOutFile4,'()') + write (p%unOutFile(4),'()') ENDIF end subroutine AA_WriteOutputLine !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Calc_WriteOutput( p, u, m, y, ErrStat, ErrMsg ) +SUBROUTINE Calc_WriteOutput( p, m, y, ErrStat, ErrMsg ) TYPE(AA_ParameterType), INTENT(IN ) :: p ! The module parameters - TYPE(AA_InputType), INTENT(IN ) :: u ! inputs TYPE(AA_MiscVarType), INTENT(INOUT) :: m ! misc variables TYPE(AA_OutputType), INTENT(INOUT) :: y ! outputs INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code @@ -783,45 +774,46 @@ SUBROUTINE Calc_WriteOutput( p, u, m, y, ErrStat, ErrMsg ) ! FOR THE FIRST OUTPUT FILE IF (p%NrOutFile .gt. 0) THEN - y%WriteOutput(1:p%NrObsLoc)=y%DirectiviOutput - endif + y%WriteOutput(1:p%NrObsLoc)=m%DirectiviOutput - ! FOR THE SECOND OUTPUT FILE - IF (p%NrOutFile .gt. 1) THEN - counter=0 - DO K = 1,p%NrObsLoc - DO III = 1,size(p%FreqList) - counter=counter+1 - y%WriteOutputforPE(counter) = y%PtotalFreq(K,III) + ! FOR THE SECOND OUTPUT FILE + IF (p%NrOutFile .gt. 1) THEN + counter=0 + DO K = 1,p%NrObsLoc + DO III = 1,size(p%FreqList) + counter=counter+1 + y%WriteOutputforPE(counter) = m%PtotalFreq(III,K) + END DO ! END DO ! - END DO ! - ENDIF - ! FOR THE THIRD OUTPUT FILE - IF (p%NrOutFile .gt. 2) THEN - counter=0 - do K = 1,p%NrObsLoc - do III = 1,size(p%FreqList) - do oi=1,size(y%OASPL_Mech,1) - counter=counter+1 - y%WriteOutputSep(counter) = y%SumSpecNoiseSep(oi,K,III) + ! FOR THE THIRD OUTPUT FILE + IF (p%NrOutFile .gt. 2) THEN + counter=0 + do K = 1,p%NrObsLoc + do III = 1,size(p%FreqList) + do oi=1,nNoiseMechanism + counter=counter+1 + y%WriteOutputSep(counter) = m%SumSpecNoiseSep(oi,III,K) + enddo + enddo enddo - enddo - enddo - ENDIF - ! FOR THE FOURTH OUTPUT FILE - IF (p%NrOutFile .gt. 3) THEN - counter=0 - DO I = 1,p%numBlades - DO J = 1,p%NumBlNds - DO K = 1,p%NrObsLoc - counter=counter+1 - y%WriteOutputNode(counter) = y%OASPL(K,J,I) - END DO ! - END DO ! - ENDDO - ENDIF + ! FOR THE FOURTH OUTPUT FILE + IF (p%NrOutFile .gt. 3) THEN + counter=0 + DO I = 1,p%numBlades + DO J = 1,p%NumBlNds + DO K = 1,p%NrObsLoc + counter=counter+1 + y%WriteOutputNodes(counter) = m%OASPL(K,J,I) + END DO ! + END DO ! + ENDDO + ENDIF + ENDIF + ENDIF + ENDIF + END SUBROUTINE Calc_WriteOutput !---------------------------------------------------------------------------------------------------------------------------------- END MODULE AeroAcoustics_IO diff --git a/modules/aerodyn/src/AeroAcoustics_Registry.txt b/modules/aerodyn/src/AeroAcoustics_Registry.txt index b01f3061dc..e858c0e1de 100644 --- a/modules/aerodyn/src/AeroAcoustics_Registry.txt +++ b/modules/aerodyn/src/AeroAcoustics_Registry.txt @@ -29,14 +29,13 @@ typedef AeroAcoustics/AA InitInputType CHARACTER(1024) InputFi typedef ^ InitInputType IntKi NumBlades - - - "Number of blades on the turbine" typedef ^ InitInputType IntKi NumBlNds - - - "Number of blade nodes" typedef ^ InitInputType CHARACTER(1024) RootName - - - "RootName for writing output files" - -typedef ^ InitInputType ReKi BlSpn {:}{:} - - "Span at blade node" m -typedef ^ InitInputType ReKi BlChord {:}{:} - - "Chord at blade node" m +typedef ^ InitInputType ReKi BlSpn {:}{:} - - "Span at blade node" m +typedef ^ InitInputType ReKi BlChord {:}{:} - - "Chord at blade node" m typedef ^ InitInputType ReKi AirDens - - - "Air density" kg/m^3 typedef ^ InitInputType ReKi KinVisc - - - "Kinematic air viscosity" m^2/s typedef ^ InitInputType ReKi SpdSound - - - "Speed of sound" m/s -typedef ^ InitInputType ReKi HubHeight - - - "Hub Height" m +typedef ^ InitInputType ReKi HubHeight - - - "Hub Height" m typedef ^ InitInputType IntKi BlAFID {:}{:} - - "Index of airfoil data file for blade node location [array of numBladeNodes by numBlades]" - -typedef ^ InitInputType AFI_ParameterType AFInfo {:} - - "Airfoil information structure containing the aerodynamic center and airfoil shape coordinates" # # Define outputs from the initialization routine here: typedef ^ InitOutputType CHARACTER(20) WriteOutputHdr {:} - - "Names of the output-to-file channels" - @@ -45,74 +44,60 @@ typedef ^ InitOutputType CHARACTER(20) WriteOutputH typedef ^ InitOutputType CHARACTER(20) WriteOutputUntforPE {:} - - "Units of the output-to-file channels" - typedef ^ InitOutputType CHARACTER(25) WriteOutputHdrSep {:} - - "Names of the output-to-file channels" - typedef ^ InitOutputType CHARACTER(25) WriteOutputUntSep {:} - - "Units of the output-to-file channels" - -typedef ^ InitOutputType CHARACTER(25) WriteOutputHdrNodes {:} - - "Names of the output-to-file channels" - -typedef ^ InitOutputType CHARACTER(25) WriteOutputUntNodes {:} - - "Units of the output-to-file channels" - -typedef ^ InitOutputType character(1) delim - - - "column delimiter" "-" -typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - -typedef ^ InitOutputType ReKi AirDens - - - "Air density" kg/m^3 +typedef ^ InitOutputType CHARACTER(25) WriteOutputHdrNodes {:} - - "Names of the output-to-file channels" - +typedef ^ InitOutputType CHARACTER(25) WriteOutputUntNodes {:} - - "Units of the output-to-file channels" - # # ..... Primary Input file data ................................................................................................... -typedef ^ AA_InputFile DbKi DT_AA - - - "Time interval for aerodynamic calculations {or \"default\"}" s -typedef ^ AA_InputFile IntKi IBLUNT - - - "FLAG TO COMPUTE BLUNTNESS NOISE" - -typedef ^ AA_InputFile IntKi ILAM - - - "FLAG TO COMPUTE LBL NOISE {1=steady model, 2=Beddoes-Leishman unsteady model}" - -typedef ^ AA_InputFile IntKi ITIP - - - "FLAG TO COMPUTE TIP NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - -typedef ^ AA_InputFile IntKi ITRIP - - - "FLAG TO TRIP BOUNDARY LAYER {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - -typedef ^ AA_InputFile IntKi ITURB - - - "FLAG TO COMPUTE TBLTE NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - -typedef ^ AA_InputFile IntKi IInflow - - - "FLAG TO COMPUTE Turbulent Inflow NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - -typedef ^ AA_InputFile IntKi X_BLMethod - - - "Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated" - -typedef ^ AA_InputFile IntKi TICalcMeth - - - "TICalcMeth" - -typedef ^ AA_InputFile IntKi NReListBL - - - "Number of values of ReListBL" - -typedef ^ AA_InputFile Logical aweightflag - - - "Integer a weighting call" - -typedef ^ AA_InputFile Logical ROUND - - - "LOGICAL INDICATING ROUNDED TIP" - -typedef ^ AA_InputFile ReKi ALPRAT - - - "TIP LIFT CURVE SLOPE" - -typedef ^ AA_InputFile IntKi AA_Bl_Prcntge - - - "see the AeroAcoustics input file for description " - -typedef ^ AA_InputFile IntKi NrObsLoc - - - "Number of observer locations " - -typedef ^ AA_InputFile ReKi ObsX {:} - - "Observer location in tower-base coordinate X horizontal" m -typedef ^ AA_InputFile ReKi ObsY {:} - - "Observer location in tower-base coordinate Y lateral" m -typedef ^ AA_InputFile ReKi ObsZ {:} - - "Observer location in tower-base coordinate Z vertical" m -typedef ^ AA_InputFile AA_BladePropsType BladeProps {:} - - "blade property information from blade input files" - -typedef ^ AA_InputFile IntKi NrOutFile - - - "Nr of output files" - -typedef ^ AA_InputFile CHARACTER(1024) AAoutfile {:} - - "AAoutfile for writing output files" - -typedef ^ AA_InputFile CHARACTER(1024) FTitle - - - "File Title: the 2nd line of the input file, which contains a description of its contents" - -typedef ^ AA_InputFile DBKi AAStart - - - "Time after which to calculate AA" s -typedef ^ AA_InputFile ReKi TI - - - "Average rotor incident turbulence intensity" - -typedef ^ AA_InputFile ReKi avgV - - - "Average wind speed" - -typedef ^ AA_InputFile ReKi Lturb - - - "Turbulent lengthscale in Amiet model" - -typedef ^ AA_InputFile ReKi ReListBL {:} - - "" -typedef ^ AA_InputFile ReKi AoAListBL {:} - - "" deg -typedef ^ AA_InputFile ReKi Pres_DispThick {:}{:}{:} - - "" -typedef ^ AA_InputFile ReKi Suct_DispThick {:}{:}{:} - - "" -typedef ^ AA_InputFile ReKi Pres_BLThick {:}{:}{:} - - "" -typedef ^ AA_InputFile ReKi Suct_BLThick {:}{:}{:} - - "" -typedef ^ AA_InputFile ReKi Pres_Cf {:}{:}{:} - - "" -typedef ^ AA_InputFile ReKi Suct_Cf {:}{:}{:} - - "" -typedef ^ AA_InputFile ReKi Pres_EdgeVelRat {:}{:}{:} - - "" -typedef ^ AA_InputFile ReKi Suct_EdgeVelRat {:}{:}{:} - - "" +typedef ^ AA_InputFile DbKi DT_AA - - - "Time interval for aerodynamic calculations {or \"default\"}" s +typedef ^ AA_InputFile IntKi IBLUNT - - - "FLAG TO COMPUTE BLUNTNESS NOISE" - +typedef ^ AA_InputFile IntKi ILAM - - - "FLAG TO COMPUTE LBL NOISE {0=off, 1=BPM calculation}" - +typedef ^ AA_InputFile IntKi ITIP - - - "FLAG TO COMPUTE TIP NOISE {0=off, 1=on}" - +typedef ^ AA_InputFile IntKi ITRIP - - - "FLAG TO TRIP BOUNDARY LAYER {0=none, 1 (heavily tripped BL Calculation), 2 (lightly tripped BL)}" - +typedef ^ AA_InputFile IntKi ITURB - - - "FLAG TO COMPUTE TBLTE NOISE {0=none, 1 (BPM), 2 (TNO)}" - +typedef ^ AA_InputFile IntKi IInflow - - - "FLAG TO COMPUTE Turbulent Inflow NOISE {0=none, 1 (only Amiet), 2 (Full Guidati), 3 (Simplified Guidati)}" - +typedef ^ AA_InputFile IntKi X_BLMethod - - - "Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated" - +typedef ^ AA_InputFile IntKi TICalcMeth - - - "TICalcMeth" - +typedef ^ AA_InputFile IntKi NReListBL - - - "Number of values of ReListBL" - +typedef ^ AA_InputFile Logical aweightflag - - - "Integer a weighting call" - +typedef ^ AA_InputFile Logical ROUND - - - "LOGICAL INDICATING ROUNDED TIP" - +typedef ^ AA_InputFile ReKi ALPRAT - - - "TIP LIFT CURVE SLOPE" - +typedef ^ AA_InputFile IntKi AA_Bl_Prcntge - - - "see the AeroAcoustics input file for description " - +typedef ^ AA_InputFile IntKi NrObsLoc - - - "Number of observer locations " - +typedef ^ AA_InputFile ReKi ObsXYZ {:}{:} - - "Observer location in tower-base coordinate (X-Y-Z)" m +typedef ^ AA_InputFile AA_BladePropsType BladeProps {:} - - "blade property information from blade input files" - +typedef ^ AA_InputFile IntKi NrOutFile - - - "Nr of output files" - +typedef ^ AA_InputFile CHARACTER(1024) AAoutfile {4} - - "AAoutfile for writing output files" - +typedef ^ AA_InputFile CHARACTER(1024) FTitle - - - "File Title: the 2nd line of the input file, which contains a description of its contents" - +typedef ^ AA_InputFile DBKi AAStart - - - "Time after which to calculate AA" s +typedef ^ AA_InputFile ReKi TI - - - "Average rotor incident turbulence intensity" - +typedef ^ AA_InputFile ReKi avgV - - - "Average wind speed" - +typedef ^ AA_InputFile ReKi Lturb - - - "Turbulent lengthscale in Amiet model" - +typedef ^ AA_InputFile ReKi ReListBL {:} - - "" - +typedef ^ AA_InputFile ReKi AoAListBL {:} - - "" deg +typedef ^ AA_InputFile ReKi Pres_DispThick {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi Suct_DispThick {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi Pres_BLThick {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi Suct_BLThick {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi Pres_Cf {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi Suct_Cf {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi Pres_EdgeVelRat {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi Suct_EdgeVelRat {:}{:}{:} - - "" # ..... States .................................................................................................................... # Define continuous (differentiable) states here: # -typedef ^ ContinuousStateType SiKi DummyContState - - - "Remove this variable if you have continuous states" - +#typedef ^ ContinuousStateType SiKi DummyContState - - - "Remove this variable if you have continuous states" - # # Define discrete (nondifferentiable) states here: -typedef ^ DiscreteStateType ReKi MeanVrel {:}{:} - - "Vrel Cumu. Mean" - -typedef ^ DiscreteStateType ReKi VrelSq {:}{:} - - "Vrel Squared Store" - -typedef ^ DiscreteStateType ReKi TIVrel {:}{:} - - "Vrel St. deviat" - -typedef ^ DiscreteStateType ReKi VrelStore {:}{:}{:} - - "Vrel Store for fft - dissipation" - -typedef ^ DiscreteStateType ReKi TIVx {:}{:} - - "Vx St. deviat" - -typedef ^ DiscreteStateType ReKi MeanVxVyVz {:}{:} - - "Vrel Cumu. Mean" - -typedef ^ DiscreteStateType ReKi VxSq {:}{:} - - "Vxl Squared Store" - -typedef ^ DiscreteStateType ReKi allregcounter {:}{:} - - "" - -typedef ^ DiscreteStateType ReKi VxSqRegion {:}{:} - - "" - -typedef ^ DiscreteStateType ReKi RegVxStor {:}{:}{:} - - "VxVyVz Store for fft or TI - dissipation" - -typedef ^ DiscreteStateType ReKi RegionTIDelete {:}{:} - - "" - +typedef ^ DiscreteStateType ReKi TIVx {:}{:} - - "Vx St. deviat" - +typedef ^ DiscreteStateType ReKi RegVxStor {:}{:}{:} - - "VxVyVz Store for fft or TI - dissipation" - # # Define constraint states here: -typedef ^ ConstraintStateType SiKi DummyConstrState - - - "Remove this variable if you have states" - +#typedef ^ ConstraintStateType SiKi DummyConstrState - - - "Remove this variable if you have states" - # # Define "other" states here: -typedef ^ OtherStateType SiKi DummyOtherState - - - "Remove this variable if you have states" - +typedef ^ OtherStateType IntKi allregcounter {:}{:} - - "" - # # Define misc/optimization variables (any data that are not considered actual states) here: ##typedef ^ MiscVarType ReKi DisturbedInflow {:}{:}{:} - - "InflowOnBlade values modified by tower influence" m/s @@ -123,23 +108,28 @@ typedef ^ MiscVarType ReKi ChordAn typedef ^ MiscVarType ReKi SpanAngleLE {:}{:}{:} - - "C" - typedef ^ MiscVarType ReKi rTEtoObserve {:}{:}{:} - - "C" - typedef ^ MiscVarType ReKi rLEtoObserve {:}{:}{:} - - "C" - -typedef ^ MiscVarType ReKi LE_Location {:}{:}{:} - - "Height of Leading Edge for calculation of TI and Scales if needed" - +typedef ^ MiscVarType ReKi LE_Location {:}{:}{:} - - "Height of Leading Edge for calculation of TI and Scales if needed" - typedef ^ MiscVarType ReKi RotSpeedAoA - - - "C" - typedef ^ MiscVarType ReKi SPLLBL {:} - - "C" - typedef ^ MiscVarType ReKi SPLP {:} - - "C" - typedef ^ MiscVarType ReKi SPLS {:} - - "C" - typedef ^ MiscVarType ReKi SPLALPH {:} - - "C" - -typedef ^ MiscVarType ReKi SPLTBL {:} - - "C" - typedef ^ MiscVarType ReKi SPLTIP {:} - - "C" - typedef ^ MiscVarType ReKi SPLTI {:} - - "C" - typedef ^ MiscVarType ReKi SPLTIGui {:} - - "C" - typedef ^ MiscVarType ReKi SPLBLUNT {:} - - "C" - -typedef ^ MiscVarType ReKi CfVar {:} - - "Output Skin friction coef Pressure Side" - -typedef ^ MiscVarType ReKi d99Var {:} - - "BL Output " - -typedef ^ MiscVarType ReKi dStarVar {:} - - "BL Output " - -typedef ^ MiscVarType ReKi EdgeVelVar {:} - - "BL Output " - -typedef ^ MiscVarType IntKi speccou - - - "Secptrum counter every XX seconds new spectrum" - -typedef ^ MiscVarType IntKi filesopen - - - "check if file is open" - +typedef ^ MiscVarType ReKi CfVar {2} - - "Output Skin friction coef Pressure Side" - +typedef ^ MiscVarType ReKi d99Var {2} - - "BL Output " - +typedef ^ MiscVarType ReKi dStarVar {2} - - "BL Output " - +typedef ^ MiscVarType ReKi EdgeVelVar {2} - - "BL Output " - +typedef ^ MiscVarType IntKi LastIndex {2} - - "index for BL param interpolation" - +# arrays for calculating WriteOutput values +typedef ^ MiscVarType ReKi SumSpecNoiseSep {:}{:}{:} - - "Spectra of summed noise level of all blades and blade nodes for each receiver and frequency" SPL +typedef ^ MiscVarType ReKi OASPL {:}{:}{:} - - "summed noise level for each blade and blade nodes and receiver " SPL +typedef ^ MiscVarType ReKi DirectiviOutput {:} - - " " SPL +typedef ^ MiscVarType ReKi PtotalFreq {:}{:} - - "SPL for each observer and frequency" + + # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: @@ -159,88 +149,65 @@ typedef ^ ParameterType IntKi NumBlNd typedef ^ ParameterType ReKi AirDens - - - "Air density" kg/m^3 typedef ^ ParameterType ReKi KinVisc - - - "Kinematic air viscosity" m^2/s typedef ^ ParameterType ReKi SpdSound - - - "Speed of sound" m/s -typedef ^ ParameterType ReKi HubHeight - - - "Hub height" m -typedef ^ ParameterType ReKi toptip - - - "Top Tip Height = Hub height plus radius" m -typedef ^ ParameterType ReKi bottip - - - "Bottom Tip Height = Hub height minus radius" m -typedef ^ ParameterType ReKi rotorregionlimitsVert {:} - - "" -typedef ^ ParameterType ReKi rotorregionlimitsHorz {:} - - "" -typedef ^ ParameterType ReKi rotorregionlimitsalph {:} - - "" -typedef ^ ParameterType ReKi rotorregionlimitsrad {:} - - "" +typedef ^ ParameterType ReKi HubHeight - - - "Hub height" m +typedef ^ ParameterType IntKi RotorRegion_k_minus1 {:}{:} - - "index array for RotorRegion blade span location" - +typedef ^ ParameterType IntKi NumRotorRegionLimitsAlph - - - "size of RotorRegionLimitsAlph array" - +typedef ^ ParameterType IntKi NumRotorRegionLimitsRad - - - "size of RotorRegionLimitsRad array" - typedef ^ ParameterType IntKi NrObsLoc - - - "Number of observer locations " - typedef ^ ParameterType Logical aweightflag - - - " " - typedef ^ ParameterType Logical TxtFileOutput - - - " " - -typedef ^ ParameterType DBKi AAStart - - - "Time after which to calculate AA" s -typedef ^ ParameterType ReKi ObsX {:} - - "Observer location in tower-base coordinate X horizontal" m -typedef ^ ParameterType ReKi ObsY {:} - - "Observer location in tower-base coordinate Y lateral" m -typedef ^ ParameterType ReKi ObsZ {:} - - "Observer location in tower-base coordinate Z vertical" m +typedef ^ ParameterType DBKi AAStart - - - "Time after which to calculate AA" s +typedef ^ ParameterType ReKi ObsXYZ {:}{:} - - "Observer location in tower-base coordinate (X-Y-Z)" m typedef ^ ParameterType ReKi FreqList {:} - - "List of Acoustic Frequencies to Calculate" Hz -typedef ^ ParameterType ReKi Aweight {:} - - "List of Acoustic Frequencies a weighting" dB -typedef ^ ParameterType ReKi Fsample - - - "Sampling Frequency 1/delta(t) - 1/(simulation time step)" Hz -typedef ^ ParameterType IntKi total_sample - - - "Total FFT Sample amount for dissipation calculation" - -typedef ^ ParameterType IntKi total_sampleTI - - - "Total FFT Sample amount for dissipation calculation" - -typedef ^ ParameterType IntKi AA_Bl_Prcntge - - - "The Percentage of the Blade which the noise is calculated" % +typedef ^ ParameterType ReKi Aweight {:} - - "List of Acoustic Frequencies a weighting" dB +typedef ^ ParameterType IntKi Num_total_sampleTI - - - "Total FFT Sample amount for dissipation calculation" - typedef ^ ParameterType IntKi startnode - - - "Corersponding node to the noise calculation percentage of the blade" - -typedef ^ ParameterType ReKi Lturb - - - "Turbulent lengthscale in Amiet model" m -typedef ^ ParameterType ReKi avgV - - - "Average wind speed to compute incident turbulence intensity" m -typedef ^ ParameterType ReKi TI - - - "Rotor incident turbulent intensity" -typedef ^ ParameterType CHARACTER(1024) FTitle - - - "File Title: the 2nd line of the input file, which contains a description of its contents" - +typedef ^ ParameterType ReKi Lturb - - - "Turbulent lengthscale in Amiet model" m +typedef ^ ParameterType ReKi avgV - - - "Average wind speed to compute incident turbulence intensity" m +typedef ^ ParameterType ReKi TI - - - "Rotor incident turbulent intensity" +typedef ^ ParameterType CHARACTER(1024) FTitle - - - "File Title: the 2nd line of the input file, which contains a description of its contents" - # parameters for output -typedef ^ ParameterType character(20) outFmt - - - "Format specifier" "-" -typedef ^ ParameterType IntKi NrOutFile - - - "Nr of output files" - -typedef ^ ParameterType character(1) delim - - - "column delimiter" "-" -typedef ^ ParameterType IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - -typedef ^ ParameterType IntKi NumOutsForPE - - - "Number of parameters in the output list (number of outputs requested)" - -typedef ^ ParameterType IntKi NumOutsForSep - - - "Number of parameters in the output list (number of outputs requested)" - -typedef ^ ParameterType IntKi NumOutsForNodes - - - "Number of parameters in the output list (number of outputs requested)" - -typedef ^ ParameterType IntKi unOutFile - - - "unit number for writing output file" "-" -typedef ^ ParameterType IntKi unOutFile2 - - - "unit number for writing output file" "-" -typedef ^ ParameterType IntKi unOutFile3 - - - "unit number for writing output file" "-" -typedef ^ ParameterType IntKi unOutFile4 - - - "unit number for writing output file" "-" -typedef ^ ParameterType CHARACTER(1024) RootName - - - "RootName for writing output files" - -typedef ^ ParameterType OutParmType OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - -typedef ^ ParameterType ReKi StallStart {:}{:} - - "ation" - -typedef ^ ParameterType ReKi TEThick {:}{:} - - "ation" - -typedef ^ ParameterType ReKi TEAngle {:}{:} - - "ation" - -typedef ^ ParameterType ReKi AerCent {:}{:}{:} - - "ation" - -typedef ^ ParameterType IntKi BlAFID {:}{:} - - "Index of airfoil data file for blade node location [array of numBladeNodes by numBlades]" - -typedef ^ ParameterType AFI_ParameterType AFInfo {:} - - "Airfoil information structure containing the aerodynamic center and airfoil shape coordinates" -typedef ^ ParameterType ReKi AFLECo {:}{:}{:} - - "Dimensionalized " -typedef ^ ParameterType ReKi AFTECo {:}{:}{:} - - -typedef ^ ParameterType ReKi BlSpn {:}{:} - - "Span at blade node" m -typedef ^ ParameterType ReKi BlChord {:}{:} - - "Chord at blade node" m -typedef ^ ParameterType ReKi ReListBL {:} - - "BL list of Reynolds" - -typedef ^ ParameterType ReKi AOAListBL {:} - - "BL list of Angle Of Attack " deg -typedef ^ ParameterType ReKi dStarAll1 {:}{:}{:} - - "Output Disp Thickness Suction Side" m -typedef ^ ParameterType ReKi dStarAll2 {:}{:}{:} - - "Output Disp Thickness Pressure Side" m -typedef ^ ParameterType ReKi d99All1 {:}{:}{:} - - "Output B.L. Thickness Suction Side" m -typedef ^ ParameterType ReKi d99All2 {:}{:}{:} - - "Output B.L. Thickness Pressure Side" m -typedef ^ ParameterType ReKi CfAll1 {:}{:}{:} - - "Output Skin friction coef Suction Side" - -typedef ^ ParameterType ReKi CfAll2 {:}{:}{:} - - "Output Skin friction coef Pressure Side" - -typedef ^ ParameterType ReKi EdgeVelRat1 {:}{:}{:} - - "Output Edge Velocity Ratio Suction" - -typedef ^ ParameterType ReKi EdgeVelRat2 {:}{:}{:} - - "Output Edge Velocity Ratio Pressure Side" - -typedef ^ ParameterType ReKi AFThickGuida {:}{:} - - "1 and 10 percent thickness t/c used for Simplified Guidati" +typedef ^ ParameterType character(20) outFmt - - - "Format specifier" "-" +typedef ^ ParameterType IntKi NrOutFile - - - "Nr of output files" - +typedef ^ ParameterType IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - +typedef ^ ParameterType IntKi NumOutsAll {4} - - "Number of parameters in the output list (number of outputs requested)" - +typedef ^ ParameterType IntKi unOutFile {4} - - "unit number for writing output file" "-" +typedef ^ ParameterType CHARACTER(1024) RootName - - - "RootName for writing output files" - +typedef ^ ParameterType ReKi StallStart {:}{:} - - "ation" - +typedef ^ ParameterType ReKi TEThick {:}{:} - - "ation" - +typedef ^ ParameterType ReKi TEAngle {:}{:} - - "ation" - +typedef ^ ParameterType ReKi AerCent {:}{:}{:} - - "ation" - +typedef ^ ParameterType IntKi BlAFID {:}{:} - - "Index of airfoil data file for blade node location [array of numBladeNodes by numBlades]" - +typedef ^ ParameterType ReKi AFLECo {:}{:}{:} - - "Dimensionalized " +typedef ^ ParameterType ReKi AFTECo {:}{:}{:} - - +typedef ^ ParameterType ReKi BlSpn {:}{:} - - "Span at blade node" m +typedef ^ ParameterType ReKi BlElemSpn {:}{:} - - "Element span at blade node" m +typedef ^ ParameterType ReKi BlChord {:}{:} - - "Chord at blade node" m +typedef ^ ParameterType ReKi ReListBL {:} - - "BL list of Reynolds" - +typedef ^ ParameterType ReKi AOAListBL {:} - - "BL list of Angle Of Attack " deg +typedef ^ ParameterType ReKi dStarAll1 {:}{:}{:} - - "Output Disp Thickness Suction Side" m +typedef ^ ParameterType ReKi dStarAll2 {:}{:}{:} - - "Output Disp Thickness Pressure Side" m +typedef ^ ParameterType ReKi d99All1 {:}{:}{:} - - "Output B.L. Thickness Suction Side" m +typedef ^ ParameterType ReKi d99All2 {:}{:}{:} - - "Output B.L. Thickness Pressure Side" m +typedef ^ ParameterType ReKi CfAll1 {:}{:}{:} - - "Output Skin friction coef Suction Side" - +typedef ^ ParameterType ReKi CfAll2 {:}{:}{:} - - "Output Skin friction coef Pressure Side" - +typedef ^ ParameterType ReKi EdgeVelRat1 {:}{:}{:} - - "Output Edge Velocity Ratio Suction" - +typedef ^ ParameterType ReKi EdgeVelRat2 {:}{:}{:} - - "Output Edge Velocity Ratio Pressure Side" - +typedef ^ ParameterType ReKi AFThickGuida {:}{:} - - "1 and 10 percent thickness t/c used for Simplified Guidati" # ..... Inputs .................................................................................................................... # Define inputs that are contained on the mesh here: -typedef ^ InputType ReKi RotGtoL {:}{:}{:}{:} - - "3x3 rotation matrix transform a vector from the local airfoil coordinate system to the global inertial coordinate system" - -typedef ^ InputType ReKi AeroCent_G {:}{:}{:} - - "location in global coordinates of the blade element aerodynamic center. 1st index = vector components, 2nd index = blade node, 3rd index = blade" - -typedef ^ InputType ReKi Vrel {:}{:} - - "Vrel" - -typedef ^ InputType ReKi AoANoise {:}{:} - - "Angle of attack" - -typedef ^ InputType ReKi Inflow {:}{:}{:} - - "atmospheric undisturbed flow on blade" +typedef ^ InputType ReKi RotGtoL {:}{:}{:}{:} - - "3x3 rotation matrix transform a vector from the local airfoil coordinate system to the global inertial coordinate system" - +typedef ^ InputType ReKi AeroCent_G {:}{:}{:} - - "location in global coordinates of the blade element aerodynamic center. 1st index = vector components, 2nd index = blade node, 3rd index = blade" - +typedef ^ InputType ReKi Vrel {:}{:} - - "Vrel" - +typedef ^ InputType ReKi AoANoise {:}{:} - - "Angle of attack" rad +typedef ^ InputType ReKi Inflow {:}{:}{:} - - "atmospheric undisturbed flow on blade" # ..... Outputs ................................................................................................................... # Define outputs that are contained on the mesh here: -typedef ^ OutputType ReKi SumSpecNoise {:}{:}{:} - - "Spectra of summed noise level of each blade and blade nodes for each receiver and frequency" SPL -typedef ^ OutputType ReKi SumSpecNoiseSep {:}{:}{:} - - "Spectra of summed noise level of all blades and blade nodes for each receiver and frequency" SPL -typedef ^ OutputType ReKi OASPL {:}{:}{:} - - "summed noise level for each blade and blade nodes and receiver " SPL -typedef ^ OutputType ReKi OASPL_Mech {:}{:}{:}{:} - - "5 different mechanism noise level for each blade and blade nodes and receiver " SPL -typedef ^ OutputType ReKi DirectiviOutput {:} - - " " SPL -typedef ^ OutputType ReKi OutLECoords {:}{:}{:}{:} - - " " m -typedef ^ OutputType ReKi PtotalFreq {:}{:} - - "SPL for each observer and frequency" - # Define outputs that are not on this mesh here: -typedef ^ OutputType ReKi WriteOutputForPE {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" -typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" -typedef ^ OutputType ReKi WriteOutputSep {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" -typedef ^ OutputType ReKi WriteOutputNode {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" +typedef ^ OutputType ReKi WriteOutputForPE {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" +typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" +typedef ^ OutputType ReKi WriteOutputSep {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" +typedef ^ OutputType ReKi WriteOutputNodes {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" diff --git a/modules/aerodyn/src/AeroAcoustics_TNO.f90 b/modules/aerodyn/src/AeroAcoustics_TNO.f90 index 761f45ad1e..00053096fb 100644 --- a/modules/aerodyn/src/AeroAcoustics_TNO.f90 +++ b/modules/aerodyn/src/AeroAcoustics_TNO.f90 @@ -5,6 +5,7 @@ MODULE TNO use NWTC_SLATEC ! slatec_qk61 -- which is all that is in that library right now. implicit none + PRIVATE PUBLIC :: SPL_integrate INTEGER, PARAMETER :: TNOKi = ReKi @@ -63,12 +64,15 @@ function SPL_integrate(Omega,limits,ISSUCTION, & ! Set module values from input ISSUCTION_TNO = ISSUCTION Omega_TNO = real(Omega,TNOKi) + ! Mach number of segment Mach_TNO = real(Mach,TNOKi) + ! Atmospheric values co = real(SpdSound, TNOKi) rho = real(AirDens, TNOKi) nu = real(KinVisc, TNOKi) + ! Blade node values Cf = real(Cfall, TNOKi) d99 = real(d99all, TNOKi) @@ -158,10 +162,10 @@ FUNCTION f_int1(x2) END FUNCTION f_int1 -FUNCTION f_int2(k1) ! changed name from 'int2' to avoid conflicts with intrinsic of same name - REAL (TNOKi), intent(in) :: k1 +FUNCTION f_int2(k1_in) ! changed name from 'int2' to avoid conflicts with intrinsic of same name + REAL (TNOKi), intent(in) :: k1_in REAL (TNOKi) :: f_int2 - f_int2 = Omega_TNO/co/k1*Pressure(k1) + f_int2 = Omega_TNO/co/k1_in*Pressure(k1_in) RETURN END FUNCTION f_int2 diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index 19b850b12c..c7bec5de2b 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -53,7 +53,6 @@ MODULE AeroAcoustics_Types REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound [m/s] REAL(ReKi) :: HubHeight = 0.0_ReKi !< Hub Height [m] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: BlAFID !< Index of airfoil data file for blade node location [array of numBladeNodes by numBlades] [-] - TYPE(AFI_ParameterType) , DIMENSION(:), ALLOCATABLE :: AFInfo !< Airfoil information structure containing the aerodynamic center and airfoil shape coordinates [-] END TYPE AA_InitInputType ! ======================= ! ========= AA_InitOutputType ======= @@ -66,20 +65,17 @@ MODULE AeroAcoustics_Types CHARACTER(25) , DIMENSION(:), ALLOCATABLE :: WriteOutputUntSep !< Units of the output-to-file channels [-] CHARACTER(25) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdrNodes !< Names of the output-to-file channels [-] CHARACTER(25) , DIMENSION(:), ALLOCATABLE :: WriteOutputUntNodes !< Units of the output-to-file channels [-] - character(1) :: delim !< column delimiter [-] - TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] END TYPE AA_InitOutputType ! ======================= ! ========= AA_InputFile ======= TYPE, PUBLIC :: AA_InputFile REAL(DbKi) :: DT_AA = 0.0_R8Ki !< Time interval for aerodynamic calculations {or "default"} [s] INTEGER(IntKi) :: IBLUNT = 0_IntKi !< FLAG TO COMPUTE BLUNTNESS NOISE [-] - INTEGER(IntKi) :: ILAM = 0_IntKi !< FLAG TO COMPUTE LBL NOISE {1=steady model, 2=Beddoes-Leishman unsteady model} [-] - INTEGER(IntKi) :: ITIP = 0_IntKi !< FLAG TO COMPUTE TIP NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - INTEGER(IntKi) :: ITRIP = 0_IntKi !< FLAG TO TRIP BOUNDARY LAYER {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - INTEGER(IntKi) :: ITURB = 0_IntKi !< FLAG TO COMPUTE TBLTE NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - INTEGER(IntKi) :: IInflow = 0_IntKi !< FLAG TO COMPUTE Turbulent Inflow NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] + INTEGER(IntKi) :: ILAM = 0_IntKi !< FLAG TO COMPUTE LBL NOISE {0=off, 1=BPM calculation} [-] + INTEGER(IntKi) :: ITIP = 0_IntKi !< FLAG TO COMPUTE TIP NOISE {0=off, 1=on} [-] + INTEGER(IntKi) :: ITRIP = 0_IntKi !< FLAG TO TRIP BOUNDARY LAYER {0=none, 1 (heavily tripped BL Calculation), 2 (lightly tripped BL)} [-] + INTEGER(IntKi) :: ITURB = 0_IntKi !< FLAG TO COMPUTE TBLTE NOISE {0=none, 1 (BPM), 2 (TNO)} [-] + INTEGER(IntKi) :: IInflow = 0_IntKi !< FLAG TO COMPUTE Turbulent Inflow NOISE {0=none, 1 (only Amiet), 2 (Full Guidati), 3 (Simplified Guidati)} [-] INTEGER(IntKi) :: X_BLMethod = 0_IntKi !< Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated [-] INTEGER(IntKi) :: TICalcMeth = 0_IntKi !< TICalcMeth [-] INTEGER(IntKi) :: NReListBL = 0_IntKi !< Number of values of ReListBL [-] @@ -88,12 +84,10 @@ MODULE AeroAcoustics_Types REAL(ReKi) :: ALPRAT = 0.0_ReKi !< TIP LIFT CURVE SLOPE [-] INTEGER(IntKi) :: AA_Bl_Prcntge = 0_IntKi !< see the AeroAcoustics input file for description [-] INTEGER(IntKi) :: NrObsLoc = 0_IntKi !< Number of observer locations [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsX !< Observer location in tower-base coordinate X horizontal [m] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsY !< Observer location in tower-base coordinate Y lateral [m] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsZ !< Observer location in tower-base coordinate Z vertical [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ObsXYZ !< Observer location in tower-base coordinate (X-Y-Z) [m] TYPE(AA_BladePropsType) , DIMENSION(:), ALLOCATABLE :: BladeProps !< blade property information from blade input files [-] INTEGER(IntKi) :: NrOutFile = 0_IntKi !< Nr of output files [-] - CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: AAoutfile !< AAoutfile for writing output files [-] + CHARACTER(1024) , DIMENSION(1:4) :: AAoutfile !< AAoutfile for writing output files [-] CHARACTER(1024) :: FTitle !< File Title: the 2nd line of the input file, which contains a description of its contents [-] REAL(DbKi) :: AAStart = 0.0_R8Ki !< Time after which to calculate AA [s] REAL(ReKi) :: TI = 0.0_ReKi !< Average rotor incident turbulence intensity [-] @@ -111,34 +105,15 @@ MODULE AeroAcoustics_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Suct_EdgeVelRat !< [-] END TYPE AA_InputFile ! ======================= -! ========= AA_ContinuousStateType ======= - TYPE, PUBLIC :: AA_ContinuousStateType - REAL(SiKi) :: DummyContState = 0.0_R4Ki !< Remove this variable if you have continuous states [-] - END TYPE AA_ContinuousStateType -! ======================= ! ========= AA_DiscreteStateType ======= TYPE, PUBLIC :: AA_DiscreteStateType - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MeanVrel !< Vrel Cumu. Mean [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: VrelSq !< Vrel Squared Store [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TIVrel !< Vrel St. deviat [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: VrelStore !< Vrel Store for fft - dissipation [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TIVx !< Vx St. deviat [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MeanVxVyVz !< Vrel Cumu. Mean [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: VxSq !< Vxl Squared Store [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: allregcounter !< [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: VxSqRegion !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: RegVxStor !< VxVyVz Store for fft or TI - dissipation [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: RegionTIDelete !< [-] END TYPE AA_DiscreteStateType ! ======================= -! ========= AA_ConstraintStateType ======= - TYPE, PUBLIC :: AA_ConstraintStateType - REAL(SiKi) :: DummyConstrState = 0.0_R4Ki !< Remove this variable if you have states [-] - END TYPE AA_ConstraintStateType -! ======================= ! ========= AA_OtherStateType ======= TYPE, PUBLIC :: AA_OtherStateType - REAL(SiKi) :: DummyOtherState = 0.0_R4Ki !< Remove this variable if you have states [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: allregcounter !< [-] END TYPE AA_OtherStateType ! ======================= ! ========= AA_MiscVarType ======= @@ -156,17 +131,19 @@ MODULE AeroAcoustics_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLP !< C [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLS !< C [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLALPH !< C [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLTBL !< C [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLTIP !< C [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLTI !< C [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLTIGui !< C [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLBLUNT !< C [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CfVar !< Output Skin friction coef Pressure Side [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: d99Var !< BL Output [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dStarVar !< BL Output [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: EdgeVelVar !< BL Output [-] - INTEGER(IntKi) :: speccou = 0_IntKi !< Secptrum counter every XX seconds new spectrum [-] - INTEGER(IntKi) :: filesopen = 0_IntKi !< check if file is open [-] + REAL(ReKi) , DIMENSION(1:2) :: CfVar = 0.0_ReKi !< Output Skin friction coef Pressure Side [-] + REAL(ReKi) , DIMENSION(1:2) :: d99Var = 0.0_ReKi !< BL Output [-] + REAL(ReKi) , DIMENSION(1:2) :: dStarVar = 0.0_ReKi !< BL Output [-] + REAL(ReKi) , DIMENSION(1:2) :: EdgeVelVar = 0.0_ReKi !< BL Output [-] + INTEGER(IntKi) , DIMENSION(1:2) :: LastIndex = 0_IntKi !< index for BL param interpolation [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SumSpecNoiseSep !< Spectra of summed noise level of all blades and blade nodes for each receiver and frequency [SPL] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: OASPL !< summed noise level for each blade and blade nodes and receiver [SPL] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DirectiviOutput !< [SPL] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PtotalFreq !< SPL for each observer and frequency [-] END TYPE AA_MiscVarType ! ======================= ! ========= AA_ParameterType ======= @@ -188,25 +165,17 @@ MODULE AeroAcoustics_Types REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound [m/s] REAL(ReKi) :: HubHeight = 0.0_ReKi !< Hub height [m] - REAL(ReKi) :: toptip = 0.0_ReKi !< Top Tip Height = Hub height plus radius [m] - REAL(ReKi) :: bottip = 0.0_ReKi !< Bottom Tip Height = Hub height minus radius [m] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsVert !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsHorz !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsalph !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsrad !< [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: RotorRegion_k_minus1 !< index array for RotorRegion blade span location [-] + INTEGER(IntKi) :: NumRotorRegionLimitsAlph = 0_IntKi !< size of RotorRegionLimitsAlph array [-] + INTEGER(IntKi) :: NumRotorRegionLimitsRad = 0_IntKi !< size of RotorRegionLimitsRad array [-] INTEGER(IntKi) :: NrObsLoc = 0_IntKi !< Number of observer locations [-] LOGICAL :: aweightflag = .false. !< [-] LOGICAL :: TxtFileOutput = .false. !< [-] REAL(DbKi) :: AAStart = 0.0_R8Ki !< Time after which to calculate AA [s] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsX !< Observer location in tower-base coordinate X horizontal [m] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsY !< Observer location in tower-base coordinate Y lateral [m] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsZ !< Observer location in tower-base coordinate Z vertical [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ObsXYZ !< Observer location in tower-base coordinate (X-Y-Z) [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FreqList !< List of Acoustic Frequencies to Calculate [Hz] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Aweight !< List of Acoustic Frequencies a weighting [dB] - REAL(ReKi) :: Fsample = 0.0_ReKi !< Sampling Frequency 1/delta(t) - 1/(simulation time step) [Hz] - INTEGER(IntKi) :: total_sample = 0_IntKi !< Total FFT Sample amount for dissipation calculation [-] - INTEGER(IntKi) :: total_sampleTI = 0_IntKi !< Total FFT Sample amount for dissipation calculation [-] - INTEGER(IntKi) :: AA_Bl_Prcntge = 0_IntKi !< The Percentage of the Blade which the noise is calculated [%] + INTEGER(IntKi) :: Num_total_sampleTI = 0_IntKi !< Total FFT Sample amount for dissipation calculation [-] INTEGER(IntKi) :: startnode = 0_IntKi !< Corersponding node to the noise calculation percentage of the blade [-] REAL(ReKi) :: Lturb = 0.0_ReKi !< Turbulent lengthscale in Amiet model [m] REAL(ReKi) :: avgV = 0.0_ReKi !< Average wind speed to compute incident turbulence intensity [m] @@ -214,26 +183,19 @@ MODULE AeroAcoustics_Types CHARACTER(1024) :: FTitle !< File Title: the 2nd line of the input file, which contains a description of its contents [-] character(20) :: outFmt !< Format specifier [-] INTEGER(IntKi) :: NrOutFile = 0_IntKi !< Nr of output files [-] - character(1) :: delim !< column delimiter [-] INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] - INTEGER(IntKi) :: NumOutsForPE = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] - INTEGER(IntKi) :: NumOutsForSep = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] - INTEGER(IntKi) :: NumOutsForNodes = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] - INTEGER(IntKi) :: unOutFile = 0_IntKi !< unit number for writing output file [-] - INTEGER(IntKi) :: unOutFile2 = 0_IntKi !< unit number for writing output file [-] - INTEGER(IntKi) :: unOutFile3 = 0_IntKi !< unit number for writing output file [-] - INTEGER(IntKi) :: unOutFile4 = 0_IntKi !< unit number for writing output file [-] + INTEGER(IntKi) , DIMENSION(1:4) :: NumOutsAll = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) , DIMENSION(1:4) :: unOutFile = 0_IntKi !< unit number for writing output file [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] - TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: StallStart !< ation [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TEThick !< ation [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TEAngle !< ation [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AerCent !< ation [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: BlAFID !< Index of airfoil data file for blade node location [array of numBladeNodes by numBlades] [-] - TYPE(AFI_ParameterType) , DIMENSION(:), ALLOCATABLE :: AFInfo !< Airfoil information structure containing the aerodynamic center and airfoil shape coordinates [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AFLECo !< Dimensionalized [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AFTECo REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlSpn !< Span at blade node [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlElemSpn !< Element span at blade node [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlChord !< Chord at blade node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ReListBL !< BL list of Reynolds [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AOAListBL !< BL list of Angle Of Attack [deg] @@ -253,23 +215,16 @@ MODULE AeroAcoustics_Types REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: RotGtoL !< 3x3 rotation matrix transform a vector from the local airfoil coordinate system to the global inertial coordinate system [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AeroCent_G !< location in global coordinates of the blade element aerodynamic center. 1st index = vector components, 2nd index = blade node, 3rd index = blade [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vrel !< Vrel [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AoANoise !< Angle of attack [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AoANoise !< Angle of attack [rad] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Inflow !< atmospheric undisturbed flow on blade [-] END TYPE AA_InputType ! ======================= ! ========= AA_OutputType ======= TYPE, PUBLIC :: AA_OutputType - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SumSpecNoise !< Spectra of summed noise level of each blade and blade nodes for each receiver and frequency [SPL] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SumSpecNoiseSep !< Spectra of summed noise level of all blades and blade nodes for each receiver and frequency [SPL] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: OASPL !< summed noise level for each blade and blade nodes and receiver [SPL] - REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: OASPL_Mech !< 5 different mechanism noise level for each blade and blade nodes and receiver [SPL] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DirectiviOutput !< [SPL] - REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: OutLECoords !< [m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PtotalFreq !< SPL for each observer and frequency [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutputForPE !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutputSep !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutputNode !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutputNodes !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] END TYPE AA_OutputType ! ======================= CONTAINS @@ -321,10 +276,8 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2 integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_CopyInitInput' ErrStat = ErrID_None ErrMsg = '' @@ -372,32 +325,12 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta end if DstInitInputData%BlAFID = SrcInitInputData%BlAFID end if - if (allocated(SrcInitInputData%AFInfo)) then - LB(1:1) = lbound(SrcInitInputData%AFInfo) - UB(1:1) = ubound(SrcInitInputData%AFInfo) - if (.not. allocated(DstInitInputData%AFInfo)) then - allocate(DstInitInputData%AFInfo(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AFInfo.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call AFI_CopyParam(SrcInitInputData%AFInfo(i1), DstInitInputData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if end subroutine subroutine AA_DestroyInitInput(InitInputData, ErrStat, ErrMsg) type(AA_InitInputType), intent(inout) :: InitInputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' @@ -410,23 +343,12 @@ subroutine AA_DestroyInitInput(InitInputData, ErrStat, ErrMsg) if (allocated(InitInputData%BlAFID)) then deallocate(InitInputData%BlAFID) end if - if (allocated(InitInputData%AFInfo)) then - LB(1:1) = lbound(InitInputData%AFInfo) - UB(1:1) = ubound(InitInputData%AFInfo) - do i1 = LB(1), UB(1) - call AFI_DestroyParam(InitInputData%AFInfo(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(InitInputData%AFInfo) - end if end subroutine subroutine AA_PackInitInput(RF, Indata) type(RegFile), intent(inout) :: RF type(AA_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackInitInput' - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%InputFile) call RegPack(RF, InData%NumBlades) @@ -439,15 +361,6 @@ subroutine AA_PackInitInput(RF, Indata) call RegPack(RF, InData%SpdSound) call RegPack(RF, InData%HubHeight) call RegPackAlloc(RF, InData%BlAFID) - call RegPack(RF, allocated(InData%AFInfo)) - if (allocated(InData%AFInfo)) then - call RegPackBounds(RF, 1, lbound(InData%AFInfo), ubound(InData%AFInfo)) - LB(1:1) = lbound(InData%AFInfo) - UB(1:1) = ubound(InData%AFInfo) - do i1 = LB(1), UB(1) - call AFI_PackParam(RF, InData%AFInfo(i1)) - end do - end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -455,7 +368,6 @@ subroutine AA_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackInitInput' - integer(B4Ki) :: i1, i2 integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc @@ -471,19 +383,6 @@ subroutine AA_UnPackInitInput(RF, OutData) call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%HubHeight); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%BlAFID); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%AFInfo)) deallocate(OutData%AFInfo) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%AFInfo(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call AFI_UnpackParam(RF, OutData%AFInfo(i1)) ! AFInfo - end do - end if end subroutine subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -494,7 +393,6 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err character(*), intent( out) :: ErrMsg integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' @@ -594,19 +492,12 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if DstInitOutputData%WriteOutputUntNodes = SrcInitOutputData%WriteOutputUntNodes end if - DstInitOutputData%delim = SrcInitOutputData%delim - call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - DstInitOutputData%AirDens = SrcInitOutputData%AirDens end subroutine subroutine AA_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) type(AA_InitOutputType), intent(inout) :: InitOutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' @@ -634,8 +525,6 @@ subroutine AA_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WriteOutputUntNodes)) then deallocate(InitOutputData%WriteOutputUntNodes) end if - call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AA_PackInitOutput(RF, Indata) @@ -651,9 +540,6 @@ subroutine AA_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%WriteOutputUntSep) call RegPackAlloc(RF, InData%WriteOutputHdrNodes) call RegPackAlloc(RF, InData%WriteOutputUntNodes) - call RegPack(RF, InData%delim) - call NWTC_Library_PackProgDesc(RF, InData%Ver) - call RegPack(RF, InData%AirDens) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -673,9 +559,6 @@ subroutine AA_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WriteOutputUntSep); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputHdrNodes); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUntNodes); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%delim); if (RegCheckErr(RF, RoutineName)) return - call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver - call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) @@ -706,41 +589,17 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%ALPRAT = SrcInputFileData%ALPRAT DstInputFileData%AA_Bl_Prcntge = SrcInputFileData%AA_Bl_Prcntge DstInputFileData%NrObsLoc = SrcInputFileData%NrObsLoc - if (allocated(SrcInputFileData%ObsX)) then - LB(1:1) = lbound(SrcInputFileData%ObsX) - UB(1:1) = ubound(SrcInputFileData%ObsX) - if (.not. allocated(DstInputFileData%ObsX)) then - allocate(DstInputFileData%ObsX(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsX.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInputFileData%ObsX = SrcInputFileData%ObsX - end if - if (allocated(SrcInputFileData%ObsY)) then - LB(1:1) = lbound(SrcInputFileData%ObsY) - UB(1:1) = ubound(SrcInputFileData%ObsY) - if (.not. allocated(DstInputFileData%ObsY)) then - allocate(DstInputFileData%ObsY(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsY.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInputFileData%ObsY = SrcInputFileData%ObsY - end if - if (allocated(SrcInputFileData%ObsZ)) then - LB(1:1) = lbound(SrcInputFileData%ObsZ) - UB(1:1) = ubound(SrcInputFileData%ObsZ) - if (.not. allocated(DstInputFileData%ObsZ)) then - allocate(DstInputFileData%ObsZ(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInputFileData%ObsXYZ)) then + LB(1:2) = lbound(SrcInputFileData%ObsXYZ) + UB(1:2) = ubound(SrcInputFileData%ObsXYZ) + if (.not. allocated(DstInputFileData%ObsXYZ)) then + allocate(DstInputFileData%ObsXYZ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsZ.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsXYZ.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputFileData%ObsZ = SrcInputFileData%ObsZ + DstInputFileData%ObsXYZ = SrcInputFileData%ObsXYZ end if if (allocated(SrcInputFileData%BladeProps)) then LB(1:1) = lbound(SrcInputFileData%BladeProps) @@ -759,18 +618,7 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end do end if DstInputFileData%NrOutFile = SrcInputFileData%NrOutFile - if (allocated(SrcInputFileData%AAoutfile)) then - LB(1:1) = lbound(SrcInputFileData%AAoutfile) - UB(1:1) = ubound(SrcInputFileData%AAoutfile) - if (.not. allocated(DstInputFileData%AAoutfile)) then - allocate(DstInputFileData%AAoutfile(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AAoutfile.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInputFileData%AAoutfile = SrcInputFileData%AAoutfile - end if + DstInputFileData%AAoutfile = SrcInputFileData%AAoutfile DstInputFileData%FTitle = SrcInputFileData%FTitle DstInputFileData%AAStart = SrcInputFileData%AAStart DstInputFileData%TI = SrcInputFileData%TI @@ -909,14 +757,8 @@ subroutine AA_DestroyInputFile(InputFileData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AA_DestroyInputFile' ErrStat = ErrID_None ErrMsg = '' - if (allocated(InputFileData%ObsX)) then - deallocate(InputFileData%ObsX) - end if - if (allocated(InputFileData%ObsY)) then - deallocate(InputFileData%ObsY) - end if - if (allocated(InputFileData%ObsZ)) then - deallocate(InputFileData%ObsZ) + if (allocated(InputFileData%ObsXYZ)) then + deallocate(InputFileData%ObsXYZ) end if if (allocated(InputFileData%BladeProps)) then LB(1:1) = lbound(InputFileData%BladeProps) @@ -927,9 +769,6 @@ subroutine AA_DestroyInputFile(InputFileData, ErrStat, ErrMsg) end do deallocate(InputFileData%BladeProps) end if - if (allocated(InputFileData%AAoutfile)) then - deallocate(InputFileData%AAoutfile) - end if if (allocated(InputFileData%ReListBL)) then deallocate(InputFileData%ReListBL) end if @@ -984,9 +823,7 @@ subroutine AA_PackInputFile(RF, Indata) call RegPack(RF, InData%ALPRAT) call RegPack(RF, InData%AA_Bl_Prcntge) call RegPack(RF, InData%NrObsLoc) - call RegPackAlloc(RF, InData%ObsX) - call RegPackAlloc(RF, InData%ObsY) - call RegPackAlloc(RF, InData%ObsZ) + call RegPackAlloc(RF, InData%ObsXYZ) call RegPack(RF, allocated(InData%BladeProps)) if (allocated(InData%BladeProps)) then call RegPackBounds(RF, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) @@ -997,7 +834,7 @@ subroutine AA_PackInputFile(RF, Indata) end do end if call RegPack(RF, InData%NrOutFile) - call RegPackAlloc(RF, InData%AAoutfile) + call RegPack(RF, InData%AAoutfile) call RegPack(RF, InData%FTitle) call RegPack(RF, InData%AAStart) call RegPack(RF, InData%TI) @@ -1040,9 +877,7 @@ subroutine AA_UnPackInputFile(RF, OutData) call RegUnpack(RF, OutData%ALPRAT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%AA_Bl_Prcntge); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NrObsLoc); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ObsX); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ObsY); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ObsZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ObsXYZ); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%BladeProps)) deallocate(OutData%BladeProps) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -1057,7 +892,7 @@ subroutine AA_UnPackInputFile(RF, OutData) end do end if call RegUnpack(RF, OutData%NrOutFile); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%AAoutfile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AAoutfile); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%FTitle); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%AAStart); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%TI); if (RegCheckErr(RF, RoutineName)) return @@ -1075,44 +910,6 @@ subroutine AA_UnPackInputFile(RF, OutData) call RegUnpackAlloc(RF, OutData%Suct_EdgeVelRat); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AA_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) - type(AA_ContinuousStateType), intent(in) :: SrcContStateData - type(AA_ContinuousStateType), intent(inout) :: DstContStateData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'AA_CopyContState' - ErrStat = ErrID_None - ErrMsg = '' - DstContStateData%DummyContState = SrcContStateData%DummyContState -end subroutine - -subroutine AA_DestroyContState(ContStateData, ErrStat, ErrMsg) - type(AA_ContinuousStateType), intent(inout) :: ContStateData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'AA_DestroyContState' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine AA_PackContState(RF, Indata) - type(RegFile), intent(inout) :: RF - type(AA_ContinuousStateType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AA_PackContState' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%DummyContState) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AA_UnPackContState(RF, OutData) - type(RegFile), intent(inout) :: RF - type(AA_ContinuousStateType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AA_UnPackContState' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%DummyContState); if (RegCheckErr(RF, RoutineName)) return -end subroutine - subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) type(AA_DiscreteStateType), intent(in) :: SrcDiscStateData type(AA_DiscreteStateType), intent(inout) :: DstDiscStateData @@ -1124,54 +921,6 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta character(*), parameter :: RoutineName = 'AA_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcDiscStateData%MeanVrel)) then - LB(1:2) = lbound(SrcDiscStateData%MeanVrel) - UB(1:2) = ubound(SrcDiscStateData%MeanVrel) - if (.not. allocated(DstDiscStateData%MeanVrel)) then - allocate(DstDiscStateData%MeanVrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%MeanVrel.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstDiscStateData%MeanVrel = SrcDiscStateData%MeanVrel - end if - if (allocated(SrcDiscStateData%VrelSq)) then - LB(1:2) = lbound(SrcDiscStateData%VrelSq) - UB(1:2) = ubound(SrcDiscStateData%VrelSq) - if (.not. allocated(DstDiscStateData%VrelSq)) then - allocate(DstDiscStateData%VrelSq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VrelSq.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstDiscStateData%VrelSq = SrcDiscStateData%VrelSq - end if - if (allocated(SrcDiscStateData%TIVrel)) then - LB(1:2) = lbound(SrcDiscStateData%TIVrel) - UB(1:2) = ubound(SrcDiscStateData%TIVrel) - if (.not. allocated(DstDiscStateData%TIVrel)) then - allocate(DstDiscStateData%TIVrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TIVrel.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstDiscStateData%TIVrel = SrcDiscStateData%TIVrel - end if - if (allocated(SrcDiscStateData%VrelStore)) then - LB(1:3) = lbound(SrcDiscStateData%VrelStore) - UB(1:3) = ubound(SrcDiscStateData%VrelStore) - if (.not. allocated(DstDiscStateData%VrelStore)) then - allocate(DstDiscStateData%VrelStore(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VrelStore.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstDiscStateData%VrelStore = SrcDiscStateData%VrelStore - end if if (allocated(SrcDiscStateData%TIVx)) then LB(1:2) = lbound(SrcDiscStateData%TIVx) UB(1:2) = ubound(SrcDiscStateData%TIVx) @@ -1184,54 +933,6 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if DstDiscStateData%TIVx = SrcDiscStateData%TIVx end if - if (allocated(SrcDiscStateData%MeanVxVyVz)) then - LB(1:2) = lbound(SrcDiscStateData%MeanVxVyVz) - UB(1:2) = ubound(SrcDiscStateData%MeanVxVyVz) - if (.not. allocated(DstDiscStateData%MeanVxVyVz)) then - allocate(DstDiscStateData%MeanVxVyVz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%MeanVxVyVz.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstDiscStateData%MeanVxVyVz = SrcDiscStateData%MeanVxVyVz - end if - if (allocated(SrcDiscStateData%VxSq)) then - LB(1:2) = lbound(SrcDiscStateData%VxSq) - UB(1:2) = ubound(SrcDiscStateData%VxSq) - if (.not. allocated(DstDiscStateData%VxSq)) then - allocate(DstDiscStateData%VxSq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VxSq.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstDiscStateData%VxSq = SrcDiscStateData%VxSq - end if - if (allocated(SrcDiscStateData%allregcounter)) then - LB(1:2) = lbound(SrcDiscStateData%allregcounter) - UB(1:2) = ubound(SrcDiscStateData%allregcounter) - if (.not. allocated(DstDiscStateData%allregcounter)) then - allocate(DstDiscStateData%allregcounter(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%allregcounter.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstDiscStateData%allregcounter = SrcDiscStateData%allregcounter - end if - if (allocated(SrcDiscStateData%VxSqRegion)) then - LB(1:2) = lbound(SrcDiscStateData%VxSqRegion) - UB(1:2) = ubound(SrcDiscStateData%VxSqRegion) - if (.not. allocated(DstDiscStateData%VxSqRegion)) then - allocate(DstDiscStateData%VxSqRegion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VxSqRegion.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstDiscStateData%VxSqRegion = SrcDiscStateData%VxSqRegion - end if if (allocated(SrcDiscStateData%RegVxStor)) then LB(1:3) = lbound(SrcDiscStateData%RegVxStor) UB(1:3) = ubound(SrcDiscStateData%RegVxStor) @@ -1244,18 +945,6 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if DstDiscStateData%RegVxStor = SrcDiscStateData%RegVxStor end if - if (allocated(SrcDiscStateData%RegionTIDelete)) then - LB(1:2) = lbound(SrcDiscStateData%RegionTIDelete) - UB(1:2) = ubound(SrcDiscStateData%RegionTIDelete) - if (.not. allocated(DstDiscStateData%RegionTIDelete)) then - allocate(DstDiscStateData%RegionTIDelete(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%RegionTIDelete.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstDiscStateData%RegionTIDelete = SrcDiscStateData%RegionTIDelete - end if end subroutine subroutine AA_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) @@ -1265,39 +954,12 @@ subroutine AA_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AA_DestroyDiscState' ErrStat = ErrID_None ErrMsg = '' - if (allocated(DiscStateData%MeanVrel)) then - deallocate(DiscStateData%MeanVrel) - end if - if (allocated(DiscStateData%VrelSq)) then - deallocate(DiscStateData%VrelSq) - end if - if (allocated(DiscStateData%TIVrel)) then - deallocate(DiscStateData%TIVrel) - end if - if (allocated(DiscStateData%VrelStore)) then - deallocate(DiscStateData%VrelStore) - end if if (allocated(DiscStateData%TIVx)) then deallocate(DiscStateData%TIVx) end if - if (allocated(DiscStateData%MeanVxVyVz)) then - deallocate(DiscStateData%MeanVxVyVz) - end if - if (allocated(DiscStateData%VxSq)) then - deallocate(DiscStateData%VxSq) - end if - if (allocated(DiscStateData%allregcounter)) then - deallocate(DiscStateData%allregcounter) - end if - if (allocated(DiscStateData%VxSqRegion)) then - deallocate(DiscStateData%VxSqRegion) - end if if (allocated(DiscStateData%RegVxStor)) then deallocate(DiscStateData%RegVxStor) end if - if (allocated(DiscStateData%RegionTIDelete)) then - deallocate(DiscStateData%RegionTIDelete) - end if end subroutine subroutine AA_PackDiscState(RF, Indata) @@ -1305,17 +967,8 @@ subroutine AA_PackDiscState(RF, Indata) type(AA_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackDiscState' if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%MeanVrel) - call RegPackAlloc(RF, InData%VrelSq) - call RegPackAlloc(RF, InData%TIVrel) - call RegPackAlloc(RF, InData%VrelStore) call RegPackAlloc(RF, InData%TIVx) - call RegPackAlloc(RF, InData%MeanVxVyVz) - call RegPackAlloc(RF, InData%VxSq) - call RegPackAlloc(RF, InData%allregcounter) - call RegPackAlloc(RF, InData%VxSqRegion) call RegPackAlloc(RF, InData%RegVxStor) - call RegPackAlloc(RF, InData%RegionTIDelete) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1327,55 +980,8 @@ subroutine AA_UnPackDiscState(RF, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%MeanVrel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%VrelSq); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TIVrel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%VrelStore); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%TIVx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%MeanVxVyVz); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%VxSq); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%allregcounter); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%VxSqRegion); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%RegVxStor); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%RegionTIDelete); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AA_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) - type(AA_ConstraintStateType), intent(in) :: SrcConstrStateData - type(AA_ConstraintStateType), intent(inout) :: DstConstrStateData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'AA_CopyConstrState' - ErrStat = ErrID_None - ErrMsg = '' - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState -end subroutine - -subroutine AA_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) - type(AA_ConstraintStateType), intent(inout) :: ConstrStateData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'AA_DestroyConstrState' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine AA_PackConstrState(RF, Indata) - type(RegFile), intent(inout) :: RF - type(AA_ConstraintStateType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AA_PackConstrState' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%DummyConstrState) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AA_UnPackConstrState(RF, OutData) - type(RegFile), intent(inout) :: RF - type(AA_ConstraintStateType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AA_UnPackConstrState' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -1384,10 +990,23 @@ subroutine AA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AA_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState + if (allocated(SrcOtherStateData%allregcounter)) then + LB(1:2) = lbound(SrcOtherStateData%allregcounter) + UB(1:2) = ubound(SrcOtherStateData%allregcounter) + if (.not. allocated(DstOtherStateData%allregcounter)) then + allocate(DstOtherStateData%allregcounter(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%allregcounter.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%allregcounter = SrcOtherStateData%allregcounter + end if end subroutine subroutine AA_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) @@ -1397,6 +1016,9 @@ subroutine AA_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AA_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' + if (allocated(OtherStateData%allregcounter)) then + deallocate(OtherStateData%allregcounter) + end if end subroutine subroutine AA_PackOtherState(RF, Indata) @@ -1404,7 +1026,7 @@ subroutine AA_PackOtherState(RF, Indata) type(AA_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackOtherState' if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%DummyOtherState) + call RegPackAlloc(RF, InData%allregcounter) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1412,8 +1034,11 @@ subroutine AA_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackOtherState' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%DummyOtherState); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%allregcounter); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -1572,18 +1197,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%SPLALPH = SrcMiscData%SPLALPH end if - if (allocated(SrcMiscData%SPLTBL)) then - LB(1:1) = lbound(SrcMiscData%SPLTBL) - UB(1:1) = ubound(SrcMiscData%SPLTBL) - if (.not. allocated(DstMiscData%SPLTBL)) then - allocate(DstMiscData%SPLTBL(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTBL.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%SPLTBL = SrcMiscData%SPLTBL - end if if (allocated(SrcMiscData%SPLTIP)) then LB(1:1) = lbound(SrcMiscData%SPLTIP) UB(1:1) = ubound(SrcMiscData%SPLTIP) @@ -1632,56 +1245,59 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%SPLBLUNT = SrcMiscData%SPLBLUNT end if - if (allocated(SrcMiscData%CfVar)) then - LB(1:1) = lbound(SrcMiscData%CfVar) - UB(1:1) = ubound(SrcMiscData%CfVar) - if (.not. allocated(DstMiscData%CfVar)) then - allocate(DstMiscData%CfVar(LB(1):UB(1)), stat=ErrStat2) + DstMiscData%CfVar = SrcMiscData%CfVar + DstMiscData%d99Var = SrcMiscData%d99Var + DstMiscData%dStarVar = SrcMiscData%dStarVar + DstMiscData%EdgeVelVar = SrcMiscData%EdgeVelVar + DstMiscData%LastIndex = SrcMiscData%LastIndex + if (allocated(SrcMiscData%SumSpecNoiseSep)) then + LB(1:3) = lbound(SrcMiscData%SumSpecNoiseSep) + UB(1:3) = ubound(SrcMiscData%SumSpecNoiseSep) + if (.not. allocated(DstMiscData%SumSpecNoiseSep)) then + allocate(DstMiscData%SumSpecNoiseSep(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CfVar.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SumSpecNoiseSep.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%CfVar = SrcMiscData%CfVar + DstMiscData%SumSpecNoiseSep = SrcMiscData%SumSpecNoiseSep end if - if (allocated(SrcMiscData%d99Var)) then - LB(1:1) = lbound(SrcMiscData%d99Var) - UB(1:1) = ubound(SrcMiscData%d99Var) - if (.not. allocated(DstMiscData%d99Var)) then - allocate(DstMiscData%d99Var(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%OASPL)) then + LB(1:3) = lbound(SrcMiscData%OASPL) + UB(1:3) = ubound(SrcMiscData%OASPL) + if (.not. allocated(DstMiscData%OASPL)) then + allocate(DstMiscData%OASPL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%d99Var.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%OASPL.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%d99Var = SrcMiscData%d99Var + DstMiscData%OASPL = SrcMiscData%OASPL end if - if (allocated(SrcMiscData%dStarVar)) then - LB(1:1) = lbound(SrcMiscData%dStarVar) - UB(1:1) = ubound(SrcMiscData%dStarVar) - if (.not. allocated(DstMiscData%dStarVar)) then - allocate(DstMiscData%dStarVar(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%DirectiviOutput)) then + LB(1:1) = lbound(SrcMiscData%DirectiviOutput) + UB(1:1) = ubound(SrcMiscData%DirectiviOutput) + if (.not. allocated(DstMiscData%DirectiviOutput)) then + allocate(DstMiscData%DirectiviOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dStarVar.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DirectiviOutput.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%dStarVar = SrcMiscData%dStarVar + DstMiscData%DirectiviOutput = SrcMiscData%DirectiviOutput end if - if (allocated(SrcMiscData%EdgeVelVar)) then - LB(1:1) = lbound(SrcMiscData%EdgeVelVar) - UB(1:1) = ubound(SrcMiscData%EdgeVelVar) - if (.not. allocated(DstMiscData%EdgeVelVar)) then - allocate(DstMiscData%EdgeVelVar(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMiscData%PtotalFreq)) then + LB(1:2) = lbound(SrcMiscData%PtotalFreq) + UB(1:2) = ubound(SrcMiscData%PtotalFreq) + if (.not. allocated(DstMiscData%PtotalFreq)) then + allocate(DstMiscData%PtotalFreq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%EdgeVelVar.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PtotalFreq.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%EdgeVelVar = SrcMiscData%EdgeVelVar + DstMiscData%PtotalFreq = SrcMiscData%PtotalFreq end if - DstMiscData%speccou = SrcMiscData%speccou - DstMiscData%filesopen = SrcMiscData%filesopen end subroutine subroutine AA_DestroyMisc(MiscData, ErrStat, ErrMsg) @@ -1727,9 +1343,6 @@ subroutine AA_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%SPLALPH)) then deallocate(MiscData%SPLALPH) end if - if (allocated(MiscData%SPLTBL)) then - deallocate(MiscData%SPLTBL) - end if if (allocated(MiscData%SPLTIP)) then deallocate(MiscData%SPLTIP) end if @@ -1742,17 +1355,17 @@ subroutine AA_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%SPLBLUNT)) then deallocate(MiscData%SPLBLUNT) end if - if (allocated(MiscData%CfVar)) then - deallocate(MiscData%CfVar) + if (allocated(MiscData%SumSpecNoiseSep)) then + deallocate(MiscData%SumSpecNoiseSep) end if - if (allocated(MiscData%d99Var)) then - deallocate(MiscData%d99Var) + if (allocated(MiscData%OASPL)) then + deallocate(MiscData%OASPL) end if - if (allocated(MiscData%dStarVar)) then - deallocate(MiscData%dStarVar) + if (allocated(MiscData%DirectiviOutput)) then + deallocate(MiscData%DirectiviOutput) end if - if (allocated(MiscData%EdgeVelVar)) then - deallocate(MiscData%EdgeVelVar) + if (allocated(MiscData%PtotalFreq)) then + deallocate(MiscData%PtotalFreq) end if end subroutine @@ -1774,17 +1387,19 @@ subroutine AA_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%SPLP) call RegPackAlloc(RF, InData%SPLS) call RegPackAlloc(RF, InData%SPLALPH) - call RegPackAlloc(RF, InData%SPLTBL) call RegPackAlloc(RF, InData%SPLTIP) call RegPackAlloc(RF, InData%SPLTI) call RegPackAlloc(RF, InData%SPLTIGui) call RegPackAlloc(RF, InData%SPLBLUNT) - call RegPackAlloc(RF, InData%CfVar) - call RegPackAlloc(RF, InData%d99Var) - call RegPackAlloc(RF, InData%dStarVar) - call RegPackAlloc(RF, InData%EdgeVelVar) - call RegPack(RF, InData%speccou) - call RegPack(RF, InData%filesopen) + call RegPack(RF, InData%CfVar) + call RegPack(RF, InData%d99Var) + call RegPack(RF, InData%dStarVar) + call RegPack(RF, InData%EdgeVelVar) + call RegPack(RF, InData%LastIndex) + call RegPackAlloc(RF, InData%SumSpecNoiseSep) + call RegPackAlloc(RF, InData%OASPL) + call RegPackAlloc(RF, InData%DirectiviOutput) + call RegPackAlloc(RF, InData%PtotalFreq) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1809,17 +1424,19 @@ subroutine AA_UnPackMisc(RF, OutData) call RegUnpackAlloc(RF, OutData%SPLP); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%SPLS); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%SPLALPH); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%SPLTBL); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%SPLTIP); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%SPLTI); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%SPLTIGui); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%SPLBLUNT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%CfVar); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%d99Var); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dStarVar); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%EdgeVelVar); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%speccou); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%filesopen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CfVar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%d99Var); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dStarVar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EdgeVelVar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastIndex); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SumSpecNoiseSep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OASPL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DirectiviOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtotalFreq); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -1828,10 +1445,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2, i3 integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_CopyParam' ErrStat = ErrID_None ErrMsg = '' @@ -1852,95 +1467,35 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%KinVisc = SrcParamData%KinVisc DstParamData%SpdSound = SrcParamData%SpdSound DstParamData%HubHeight = SrcParamData%HubHeight - DstParamData%toptip = SrcParamData%toptip - DstParamData%bottip = SrcParamData%bottip - if (allocated(SrcParamData%rotorregionlimitsVert)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsVert) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsVert) - if (.not. allocated(DstParamData%rotorregionlimitsVert)) then - allocate(DstParamData%rotorregionlimitsVert(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%RotorRegion_k_minus1)) then + LB(1:2) = lbound(SrcParamData%RotorRegion_k_minus1) + UB(1:2) = ubound(SrcParamData%RotorRegion_k_minus1) + if (.not. allocated(DstParamData%RotorRegion_k_minus1)) then + allocate(DstParamData%RotorRegion_k_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsVert.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RotorRegion_k_minus1.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%rotorregionlimitsVert = SrcParamData%rotorregionlimitsVert - end if - if (allocated(SrcParamData%rotorregionlimitsHorz)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsHorz) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsHorz) - if (.not. allocated(DstParamData%rotorregionlimitsHorz)) then - allocate(DstParamData%rotorregionlimitsHorz(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsHorz.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%rotorregionlimitsHorz = SrcParamData%rotorregionlimitsHorz - end if - if (allocated(SrcParamData%rotorregionlimitsalph)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsalph) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsalph) - if (.not. allocated(DstParamData%rotorregionlimitsalph)) then - allocate(DstParamData%rotorregionlimitsalph(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsalph.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%rotorregionlimitsalph = SrcParamData%rotorregionlimitsalph - end if - if (allocated(SrcParamData%rotorregionlimitsrad)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsrad) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsrad) - if (.not. allocated(DstParamData%rotorregionlimitsrad)) then - allocate(DstParamData%rotorregionlimitsrad(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsrad.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%rotorregionlimitsrad = SrcParamData%rotorregionlimitsrad + DstParamData%RotorRegion_k_minus1 = SrcParamData%RotorRegion_k_minus1 end if + DstParamData%NumRotorRegionLimitsAlph = SrcParamData%NumRotorRegionLimitsAlph + DstParamData%NumRotorRegionLimitsRad = SrcParamData%NumRotorRegionLimitsRad DstParamData%NrObsLoc = SrcParamData%NrObsLoc DstParamData%aweightflag = SrcParamData%aweightflag DstParamData%TxtFileOutput = SrcParamData%TxtFileOutput DstParamData%AAStart = SrcParamData%AAStart - if (allocated(SrcParamData%ObsX)) then - LB(1:1) = lbound(SrcParamData%ObsX) - UB(1:1) = ubound(SrcParamData%ObsX) - if (.not. allocated(DstParamData%ObsX)) then - allocate(DstParamData%ObsX(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsX.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%ObsX = SrcParamData%ObsX - end if - if (allocated(SrcParamData%ObsY)) then - LB(1:1) = lbound(SrcParamData%ObsY) - UB(1:1) = ubound(SrcParamData%ObsY) - if (.not. allocated(DstParamData%ObsY)) then - allocate(DstParamData%ObsY(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsY.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%ObsY = SrcParamData%ObsY - end if - if (allocated(SrcParamData%ObsZ)) then - LB(1:1) = lbound(SrcParamData%ObsZ) - UB(1:1) = ubound(SrcParamData%ObsZ) - if (.not. allocated(DstParamData%ObsZ)) then - allocate(DstParamData%ObsZ(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%ObsXYZ)) then + LB(1:2) = lbound(SrcParamData%ObsXYZ) + UB(1:2) = ubound(SrcParamData%ObsXYZ) + if (.not. allocated(DstParamData%ObsXYZ)) then + allocate(DstParamData%ObsXYZ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsZ.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsXYZ.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%ObsZ = SrcParamData%ObsZ + DstParamData%ObsXYZ = SrcParamData%ObsXYZ end if if (allocated(SrcParamData%FreqList)) then LB(1:1) = lbound(SrcParamData%FreqList) @@ -1966,10 +1521,7 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%Aweight = SrcParamData%Aweight end if - DstParamData%Fsample = SrcParamData%Fsample - DstParamData%total_sample = SrcParamData%total_sample - DstParamData%total_sampleTI = SrcParamData%total_sampleTI - DstParamData%AA_Bl_Prcntge = SrcParamData%AA_Bl_Prcntge + DstParamData%Num_total_sampleTI = SrcParamData%Num_total_sampleTI DstParamData%startnode = SrcParamData%startnode DstParamData%Lturb = SrcParamData%Lturb DstParamData%avgV = SrcParamData%avgV @@ -1977,32 +1529,10 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%FTitle = SrcParamData%FTitle DstParamData%outFmt = SrcParamData%outFmt DstParamData%NrOutFile = SrcParamData%NrOutFile - DstParamData%delim = SrcParamData%delim DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%NumOutsForPE = SrcParamData%NumOutsForPE - DstParamData%NumOutsForSep = SrcParamData%NumOutsForSep - DstParamData%NumOutsForNodes = SrcParamData%NumOutsForNodes + DstParamData%NumOutsAll = SrcParamData%NumOutsAll DstParamData%unOutFile = SrcParamData%unOutFile - DstParamData%unOutFile2 = SrcParamData%unOutFile2 - DstParamData%unOutFile3 = SrcParamData%unOutFile3 - DstParamData%unOutFile4 = SrcParamData%unOutFile4 DstParamData%RootName = SrcParamData%RootName - if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam) - UB(1:1) = ubound(SrcParamData%OutParam) - if (.not. allocated(DstParamData%OutParam)) then - allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcParamData%StallStart)) then LB(1:2) = lbound(SrcParamData%StallStart) UB(1:2) = ubound(SrcParamData%StallStart) @@ -2063,22 +1593,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%BlAFID = SrcParamData%BlAFID end if - if (allocated(SrcParamData%AFInfo)) then - LB(1:1) = lbound(SrcParamData%AFInfo) - UB(1:1) = ubound(SrcParamData%AFInfo) - if (.not. allocated(DstParamData%AFInfo)) then - allocate(DstParamData%AFInfo(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFInfo.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call AFI_CopyParam(SrcParamData%AFInfo(i1), DstParamData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcParamData%AFLECo)) then LB(1:3) = lbound(SrcParamData%AFLECo) UB(1:3) = ubound(SrcParamData%AFLECo) @@ -2115,6 +1629,18 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%BlSpn = SrcParamData%BlSpn end if + if (allocated(SrcParamData%BlElemSpn)) then + LB(1:2) = lbound(SrcParamData%BlElemSpn) + UB(1:2) = ubound(SrcParamData%BlElemSpn) + if (.not. allocated(DstParamData%BlElemSpn)) then + allocate(DstParamData%BlElemSpn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlElemSpn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BlElemSpn = SrcParamData%BlElemSpn + end if if (allocated(SrcParamData%BlChord)) then LB(1:2) = lbound(SrcParamData%BlChord) UB(1:2) = ubound(SrcParamData%BlChord) @@ -2265,33 +1791,14 @@ subroutine AA_DestroyParam(ParamData, ErrStat, ErrMsg) type(AA_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2, i3 - integer(B4Ki) :: LB(3), UB(3) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_DestroyParam' ErrStat = ErrID_None ErrMsg = '' - if (allocated(ParamData%rotorregionlimitsVert)) then - deallocate(ParamData%rotorregionlimitsVert) - end if - if (allocated(ParamData%rotorregionlimitsHorz)) then - deallocate(ParamData%rotorregionlimitsHorz) - end if - if (allocated(ParamData%rotorregionlimitsalph)) then - deallocate(ParamData%rotorregionlimitsalph) + if (allocated(ParamData%RotorRegion_k_minus1)) then + deallocate(ParamData%RotorRegion_k_minus1) end if - if (allocated(ParamData%rotorregionlimitsrad)) then - deallocate(ParamData%rotorregionlimitsrad) - end if - if (allocated(ParamData%ObsX)) then - deallocate(ParamData%ObsX) - end if - if (allocated(ParamData%ObsY)) then - deallocate(ParamData%ObsY) - end if - if (allocated(ParamData%ObsZ)) then - deallocate(ParamData%ObsZ) + if (allocated(ParamData%ObsXYZ)) then + deallocate(ParamData%ObsXYZ) end if if (allocated(ParamData%FreqList)) then deallocate(ParamData%FreqList) @@ -2299,15 +1806,6 @@ subroutine AA_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%Aweight)) then deallocate(ParamData%Aweight) end if - if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam) - UB(1:1) = ubound(ParamData%OutParam) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ParamData%OutParam) - end if if (allocated(ParamData%StallStart)) then deallocate(ParamData%StallStart) end if @@ -2323,15 +1821,6 @@ subroutine AA_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%BlAFID)) then deallocate(ParamData%BlAFID) end if - if (allocated(ParamData%AFInfo)) then - LB(1:1) = lbound(ParamData%AFInfo) - UB(1:1) = ubound(ParamData%AFInfo) - do i1 = LB(1), UB(1) - call AFI_DestroyParam(ParamData%AFInfo(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ParamData%AFInfo) - end if if (allocated(ParamData%AFLECo)) then deallocate(ParamData%AFLECo) end if @@ -2341,6 +1830,9 @@ subroutine AA_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%BlSpn)) then deallocate(ParamData%BlSpn) end if + if (allocated(ParamData%BlElemSpn)) then + deallocate(ParamData%BlElemSpn) + end if if (allocated(ParamData%BlChord)) then deallocate(ParamData%BlChord) end if @@ -2383,8 +1875,6 @@ subroutine AA_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(AA_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackParam' - integer(B4Ki) :: i1, i2, i3 - integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DT) call RegPack(RF, InData%IBLUNT) @@ -2403,25 +1893,17 @@ subroutine AA_PackParam(RF, Indata) call RegPack(RF, InData%KinVisc) call RegPack(RF, InData%SpdSound) call RegPack(RF, InData%HubHeight) - call RegPack(RF, InData%toptip) - call RegPack(RF, InData%bottip) - call RegPackAlloc(RF, InData%rotorregionlimitsVert) - call RegPackAlloc(RF, InData%rotorregionlimitsHorz) - call RegPackAlloc(RF, InData%rotorregionlimitsalph) - call RegPackAlloc(RF, InData%rotorregionlimitsrad) + call RegPackAlloc(RF, InData%RotorRegion_k_minus1) + call RegPack(RF, InData%NumRotorRegionLimitsAlph) + call RegPack(RF, InData%NumRotorRegionLimitsRad) call RegPack(RF, InData%NrObsLoc) call RegPack(RF, InData%aweightflag) call RegPack(RF, InData%TxtFileOutput) call RegPack(RF, InData%AAStart) - call RegPackAlloc(RF, InData%ObsX) - call RegPackAlloc(RF, InData%ObsY) - call RegPackAlloc(RF, InData%ObsZ) + call RegPackAlloc(RF, InData%ObsXYZ) call RegPackAlloc(RF, InData%FreqList) call RegPackAlloc(RF, InData%Aweight) - call RegPack(RF, InData%Fsample) - call RegPack(RF, InData%total_sample) - call RegPack(RF, InData%total_sampleTI) - call RegPack(RF, InData%AA_Bl_Prcntge) + call RegPack(RF, InData%Num_total_sampleTI) call RegPack(RF, InData%startnode) call RegPack(RF, InData%Lturb) call RegPack(RF, InData%avgV) @@ -2429,42 +1911,19 @@ subroutine AA_PackParam(RF, Indata) call RegPack(RF, InData%FTitle) call RegPack(RF, InData%outFmt) call RegPack(RF, InData%NrOutFile) - call RegPack(RF, InData%delim) call RegPack(RF, InData%NumOuts) - call RegPack(RF, InData%NumOutsForPE) - call RegPack(RF, InData%NumOutsForSep) - call RegPack(RF, InData%NumOutsForNodes) + call RegPack(RF, InData%NumOutsAll) call RegPack(RF, InData%unOutFile) - call RegPack(RF, InData%unOutFile2) - call RegPack(RF, InData%unOutFile3) - call RegPack(RF, InData%unOutFile4) call RegPack(RF, InData%RootName) - call RegPack(RF, allocated(InData%OutParam)) - if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) - LB(1:1) = lbound(InData%OutParam) - UB(1:1) = ubound(InData%OutParam) - do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) - end do - end if call RegPackAlloc(RF, InData%StallStart) call RegPackAlloc(RF, InData%TEThick) call RegPackAlloc(RF, InData%TEAngle) call RegPackAlloc(RF, InData%AerCent) call RegPackAlloc(RF, InData%BlAFID) - call RegPack(RF, allocated(InData%AFInfo)) - if (allocated(InData%AFInfo)) then - call RegPackBounds(RF, 1, lbound(InData%AFInfo), ubound(InData%AFInfo)) - LB(1:1) = lbound(InData%AFInfo) - UB(1:1) = ubound(InData%AFInfo) - do i1 = LB(1), UB(1) - call AFI_PackParam(RF, InData%AFInfo(i1)) - end do - end if call RegPackAlloc(RF, InData%AFLECo) call RegPackAlloc(RF, InData%AFTECo) call RegPackAlloc(RF, InData%BlSpn) + call RegPackAlloc(RF, InData%BlElemSpn) call RegPackAlloc(RF, InData%BlChord) call RegPackAlloc(RF, InData%ReListBL) call RegPackAlloc(RF, InData%AOAListBL) @@ -2484,7 +1943,6 @@ subroutine AA_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackParam' - integer(B4Ki) :: i1, i2, i3 integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc @@ -2506,25 +1964,17 @@ subroutine AA_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%HubHeight); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%toptip); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%bottip); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%rotorregionlimitsVert); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%rotorregionlimitsHorz); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%rotorregionlimitsalph); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%rotorregionlimitsrad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotorRegion_k_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumRotorRegionLimitsAlph); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumRotorRegionLimitsRad); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NrObsLoc); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%aweightflag); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%TxtFileOutput); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%AAStart); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ObsX); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ObsY); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%ObsZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ObsXYZ); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%FreqList); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%Aweight); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Fsample); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%total_sample); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%total_sampleTI); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AA_Bl_Prcntge); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Num_total_sampleTI); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%startnode); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Lturb); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%avgV); if (RegCheckErr(RF, RoutineName)) return @@ -2532,50 +1982,19 @@ subroutine AA_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%FTitle); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%outFmt); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NrOutFile); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%delim); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumOutsForPE); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumOutsForSep); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%NumOutsForNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOutsAll); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%unOutFile); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%unOutFile2); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%unOutFile3); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%unOutFile4); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam - end do - end if call RegUnpackAlloc(RF, OutData%StallStart); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%TEThick); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%TEAngle); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%AerCent); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%BlAFID); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%AFInfo)) deallocate(OutData%AFInfo) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%AFInfo(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call AFI_UnpackParam(RF, OutData%AFInfo(i1)) ! AFInfo - end do - end if call RegUnpackAlloc(RF, OutData%AFLECo); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%AFTECo); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%BlSpn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlElemSpn); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%BlChord); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%ReListBL); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%AOAListBL); if (RegCheckErr(RF, RoutineName)) return @@ -2721,95 +2140,11 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AA_CopyOutput' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcOutputData%SumSpecNoise)) then - LB(1:3) = lbound(SrcOutputData%SumSpecNoise) - UB(1:3) = ubound(SrcOutputData%SumSpecNoise) - if (.not. allocated(DstOutputData%SumSpecNoise)) then - allocate(DstOutputData%SumSpecNoise(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SumSpecNoise.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstOutputData%SumSpecNoise = SrcOutputData%SumSpecNoise - end if - if (allocated(SrcOutputData%SumSpecNoiseSep)) then - LB(1:3) = lbound(SrcOutputData%SumSpecNoiseSep) - UB(1:3) = ubound(SrcOutputData%SumSpecNoiseSep) - if (.not. allocated(DstOutputData%SumSpecNoiseSep)) then - allocate(DstOutputData%SumSpecNoiseSep(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SumSpecNoiseSep.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstOutputData%SumSpecNoiseSep = SrcOutputData%SumSpecNoiseSep - end if - if (allocated(SrcOutputData%OASPL)) then - LB(1:3) = lbound(SrcOutputData%OASPL) - UB(1:3) = ubound(SrcOutputData%OASPL) - if (.not. allocated(DstOutputData%OASPL)) then - allocate(DstOutputData%OASPL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OASPL.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstOutputData%OASPL = SrcOutputData%OASPL - end if - if (allocated(SrcOutputData%OASPL_Mech)) then - LB(1:4) = lbound(SrcOutputData%OASPL_Mech) - UB(1:4) = ubound(SrcOutputData%OASPL_Mech) - if (.not. allocated(DstOutputData%OASPL_Mech)) then - allocate(DstOutputData%OASPL_Mech(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OASPL_Mech.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstOutputData%OASPL_Mech = SrcOutputData%OASPL_Mech - end if - if (allocated(SrcOutputData%DirectiviOutput)) then - LB(1:1) = lbound(SrcOutputData%DirectiviOutput) - UB(1:1) = ubound(SrcOutputData%DirectiviOutput) - if (.not. allocated(DstOutputData%DirectiviOutput)) then - allocate(DstOutputData%DirectiviOutput(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%DirectiviOutput.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstOutputData%DirectiviOutput = SrcOutputData%DirectiviOutput - end if - if (allocated(SrcOutputData%OutLECoords)) then - LB(1:4) = lbound(SrcOutputData%OutLECoords) - UB(1:4) = ubound(SrcOutputData%OutLECoords) - if (.not. allocated(DstOutputData%OutLECoords)) then - allocate(DstOutputData%OutLECoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OutLECoords.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstOutputData%OutLECoords = SrcOutputData%OutLECoords - end if - if (allocated(SrcOutputData%PtotalFreq)) then - LB(1:2) = lbound(SrcOutputData%PtotalFreq) - UB(1:2) = ubound(SrcOutputData%PtotalFreq) - if (.not. allocated(DstOutputData%PtotalFreq)) then - allocate(DstOutputData%PtotalFreq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%PtotalFreq.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstOutputData%PtotalFreq = SrcOutputData%PtotalFreq - end if if (allocated(SrcOutputData%WriteOutputForPE)) then LB(1:1) = lbound(SrcOutputData%WriteOutputForPE) UB(1:1) = ubound(SrcOutputData%WriteOutputForPE) @@ -2846,17 +2181,17 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if DstOutputData%WriteOutputSep = SrcOutputData%WriteOutputSep end if - if (allocated(SrcOutputData%WriteOutputNode)) then - LB(1:1) = lbound(SrcOutputData%WriteOutputNode) - UB(1:1) = ubound(SrcOutputData%WriteOutputNode) - if (.not. allocated(DstOutputData%WriteOutputNode)) then - allocate(DstOutputData%WriteOutputNode(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcOutputData%WriteOutputNodes)) then + LB(1:1) = lbound(SrcOutputData%WriteOutputNodes) + UB(1:1) = ubound(SrcOutputData%WriteOutputNodes) + if (.not. allocated(DstOutputData%WriteOutputNodes)) then + allocate(DstOutputData%WriteOutputNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputNode.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputNodes.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%WriteOutputNode = SrcOutputData%WriteOutputNode + DstOutputData%WriteOutputNodes = SrcOutputData%WriteOutputNodes end if end subroutine @@ -2867,27 +2202,6 @@ subroutine AA_DestroyOutput(OutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AA_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' - if (allocated(OutputData%SumSpecNoise)) then - deallocate(OutputData%SumSpecNoise) - end if - if (allocated(OutputData%SumSpecNoiseSep)) then - deallocate(OutputData%SumSpecNoiseSep) - end if - if (allocated(OutputData%OASPL)) then - deallocate(OutputData%OASPL) - end if - if (allocated(OutputData%OASPL_Mech)) then - deallocate(OutputData%OASPL_Mech) - end if - if (allocated(OutputData%DirectiviOutput)) then - deallocate(OutputData%DirectiviOutput) - end if - if (allocated(OutputData%OutLECoords)) then - deallocate(OutputData%OutLECoords) - end if - if (allocated(OutputData%PtotalFreq)) then - deallocate(OutputData%PtotalFreq) - end if if (allocated(OutputData%WriteOutputForPE)) then deallocate(OutputData%WriteOutputForPE) end if @@ -2897,8 +2211,8 @@ subroutine AA_DestroyOutput(OutputData, ErrStat, ErrMsg) if (allocated(OutputData%WriteOutputSep)) then deallocate(OutputData%WriteOutputSep) end if - if (allocated(OutputData%WriteOutputNode)) then - deallocate(OutputData%WriteOutputNode) + if (allocated(OutputData%WriteOutputNodes)) then + deallocate(OutputData%WriteOutputNodes) end if end subroutine @@ -2907,17 +2221,10 @@ subroutine AA_PackOutput(RF, Indata) type(AA_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackOutput' if (RF%ErrStat >= AbortErrLev) return - call RegPackAlloc(RF, InData%SumSpecNoise) - call RegPackAlloc(RF, InData%SumSpecNoiseSep) - call RegPackAlloc(RF, InData%OASPL) - call RegPackAlloc(RF, InData%OASPL_Mech) - call RegPackAlloc(RF, InData%DirectiviOutput) - call RegPackAlloc(RF, InData%OutLECoords) - call RegPackAlloc(RF, InData%PtotalFreq) call RegPackAlloc(RF, InData%WriteOutputForPE) call RegPackAlloc(RF, InData%WriteOutput) call RegPackAlloc(RF, InData%WriteOutputSep) - call RegPackAlloc(RF, InData%WriteOutputNode) + call RegPackAlloc(RF, InData%WriteOutputNodes) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -2925,21 +2232,14 @@ subroutine AA_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackOutput' - integer(B4Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return - call RegUnpackAlloc(RF, OutData%SumSpecNoise); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%SumSpecNoiseSep); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%OASPL); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%OASPL_Mech); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%DirectiviOutput); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%OutLECoords); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%PtotalFreq); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputForPE); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputSep); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%WriteOutputNode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputNodes); if (RegCheckErr(RF, RoutineName)) return end subroutine END MODULE AeroAcoustics_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 6ed9b86c50..f70b8d71b7 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -65,7 +65,7 @@ module AeroDyn !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine sets the initialization output data structure, which contains data to be returned to the calling program (e.g., !! FAST or AeroDyn_Driver) -subroutine AD_SetInitOut(MHK, WtrDpth, p, p_AD, InputFileData, InitOut, errStat, errMsg) +subroutine AD_SetInitOut(MHK, WtrDpth, p, p_AD, InputFileData, AA_InitOut, InitOut, errStat, errMsg) integer(IntKi), intent(in ) :: MHK ! MHK flag real(ReKi), intent(in ) :: WtrDpth ! water depth @@ -73,6 +73,7 @@ subroutine AD_SetInitOut(MHK, WtrDpth, p, p_AD, InputFileData, InitOut, errStat, type(RotInputFile), intent(in ) :: InputFileData ! input file data (for setting airfoil shape outputs) type(RotParameterType), intent(in ) :: p ! Parameters type(AD_ParameterType), intent(in ) :: p_AD ! Parameters + type(AA_InitOutputType), intent(in ) :: AA_InitOut ! Output for initialization routine integer(IntKi), intent( out) :: errStat ! Error status of the operation character(*), intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None @@ -94,10 +95,10 @@ subroutine AD_SetInitOut(MHK, WtrDpth, p, p_AD, InputFileData, InitOut, errStat, InitOut%AirDens = p%AirDens - call AllocAry( InitOut%WriteOutputHdr, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutputHdr', errStat2, errMsg2 ) + call AllocAry( InitOut%WriteOutputHdr, p%numOuts + p%AA%numOuts + p%BldNd_TotNumOuts, 'WriteOutputHdr', errStat2, errMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( InitOut%WriteOutputUnt, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutputUnt', errStat2, errMsg2 ) + call AllocAry( InitOut%WriteOutputUnt, p%numOuts + p%AA%numOuts + p%BldNd_TotNumOuts, 'WriteOutputUnt', errStat2, errMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) if (ErrStat >= AbortErrLev) return @@ -107,8 +108,34 @@ subroutine AD_SetInitOut(MHK, WtrDpth, p, p_AD, InputFileData, InitOut, errStat, InitOut%WriteOutputUnt(i) = p%OutParam(i)%Units end do - - + + if (p%AA%numOuts > 0) then + i = p%NumOuts + do j=1,p%AA%numOutsAll(1) + i = i + 1 + InitOut%WriteOutputHdr(i) = AA_InitOut%WriteOutputHdr(j) + InitOut%WriteOutputUnt(i) = AA_InitOut%WriteOutputUnt(j) + end do + + do j=1,p%AA%numOutsAll(2) + i = i + 1 + InitOut%WriteOutputHdr(i) = AA_InitOut%WriteOutputHdrforPE(j) + InitOut%WriteOutputUnt(i) = AA_InitOut%WriteOutputUntforPE(j) + end do + + do j=1,p%AA%numOutsAll(3) + i = i + 1 + InitOut%WriteOutputHdr(i) = AA_InitOut%WriteOutputHdrSep(j) + InitOut%WriteOutputUnt(i) = AA_InitOut%WriteOutputUntSep(j) + end do + + do j=1,p%AA%numOutsAll(4) + i = i + 1 + InitOut%WriteOutputHdr(i) = AA_InitOut%WriteOutputHdrNodes(j) + InitOut%WriteOutputUnt(i) = AA_InitOut%WriteOutputUntNodes(j) + end do + end if + ! Set the info in WriteOutputHdr and WriteOutputUnt CALL AllBldNdOuts_InitOut( InitOut, p, InputFileData, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -228,7 +255,7 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Local variables integer(IntKi) :: i,k ! loop counter integer(IntKi) :: iR ! loop on rotors - integer(IntKi) :: nNodesVelRot ! number of nodes associated with the rotor that need wind velocity (for CFD coupling) + type(AA_InitOutputType) :: AA_InitOut ! Output for initialization routine integer(IntKi) :: errStat2 ! temporary error status of the operation character(ErrMsgLen) :: errMsg2 ! temporary error message @@ -430,7 +457,7 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Initialize the BEMT module (also sets other variables for sub module) !............................................................................................ - ! initialize BEMT after setting parameters and inputs because we are going to use the already- + ! initialize BEMT and AA after setting parameters and inputs because we are going to use the already- ! calculated node positions from the input meshes if (p%Wake_Mod /= WakeMod_FVW) then @@ -447,7 +474,7 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Initialize the AeroAcoustics Module if the CompAA flag is set !............................................................................................ if (p%rotors(iR)%CompAA) then - call Init_AAmodule( InitInp%rotors(iR), InputFileData, InputFileData%rotors(iR), u%rotors(iR), m%rotors(iR)%AA_u, p%rotors(iR), p, x%rotors(iR)%AA, xd%rotors(iR)%AA, z%rotors(iR)%AA, OtherState%rotors(iR)%AA, m%rotors(iR)%AA_y, m%rotors(iR)%AA, ErrStat2, ErrMsg2 ) + call Init_AAmodule( InitInp%rotors(iR), InputFileData, InputFileData%rotors(iR), u%rotors(iR), m%rotors(iR)%AA_u, p%rotors(iR), p, xd%rotors(iR)%AA, OtherState%rotors(iR)%AA, m%rotors(iR)%AA_y, m%rotors(iR)%AA, AA_InitOut, ErrStat2, ErrMsg2 ) if (Failed()) return; end if enddo @@ -465,6 +492,7 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut if (.not. allocated(m%FVW_u)) Allocate(m%FVW_u(3)) !size(u))) call Init_OLAF( InputFileData, u, m%FVW_u(1), p, x%FVW, xd%FVW, z%FVW, OtherState%FVW, m, ErrStat2, ErrMsg2 ) if (Failed()) return; + ! populate the rest of the FVW_u so that extrap-interp will work do i=2,3 !size(u) call FVW_CopyInput( m%FVW_u(1), m%FVW_u(i), MESH_NEWCOPY, ErrStat2, ErrMsg2 ) @@ -518,7 +546,7 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut !............................................................................................ InitOut%Ver = AD_Ver do iR = 1, nRotors - call AD_SetInitOut(InitInp%MHK, InitInp%WtrDpth, p%rotors(iR), p, InputFileData%rotors(iR), InitOut%rotors(iR), errStat2, errMsg2) + call AD_SetInitOut(InitInp%MHK, InitInp%WtrDpth, p%rotors(iR), p, InputFileData%rotors(iR), AA_InitOut, InitOut%rotors(iR), errStat2, errMsg2) if (Failed()) return; enddo @@ -584,10 +612,12 @@ logical function Failed() Failed = ErrStat >= AbortErrLev if (Failed) call Cleanup() end function Failed + subroutine Cleanup() CALL AD_DestroyInputFile( InputFileData, ErrStat2, ErrMsg2 ) CALL NWTC_Library_Destroyfileinfotype(FileInfo_In, ErrStat2, ErrMsg2) + CALL AA_DestroyInitOutput( AA_InitOut, ErrStat2, ErrMsg2 ) if (allocated(NumBlades )) deallocate(NumBlades) if (allocated(AeroProjMod )) deallocate(AeroProjMod) if (allocated(calcCrvAngle)) deallocate(calcCrvAngle) @@ -662,7 +692,7 @@ subroutine Init_MiscVars(m, p, p_AD, u, y, errStat, errMsg) ! Local variables - integer(intKi) :: i, j, k + integer(intKi) :: j, k integer(intKi) :: ErrStat2 ! temporary Error status character(ErrMsgLen) :: ErrMsg2 ! temporary Error message character(*), parameter :: RoutineName = 'Init_MiscVars' @@ -1083,12 +1113,10 @@ subroutine Init_y(y, u, p, errStat, errMsg) end do - call AllocAry( y%WriteOutput, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutput', errStat2, errMsg2 ) + call AllocAry( y%WriteOutput, p%NumOuts + p%AA%numOuts + p%BldNd_TotNumOuts, 'WriteOutput', errStat2, errMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev) RETURN - - end subroutine Init_y !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes AeroDyn meshes and input array variables for use during the simulation. @@ -1623,6 +1651,7 @@ subroutine AD_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None integer :: iW + integer :: iR @@ -1644,9 +1673,22 @@ subroutine AD_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) call FVW_End( m%FVW_u, p%FVW, x%FVW, xd%FVW, z%FVW, OtherState%FVW, m%FVW_y, m%FVW, ErrStat, ErrMsg ) - endif - + else + + if (allocated(p%rotors)) then + do iR = 1, SIZE(p%rotors) + + if (p%rotors(iR)%CompAA) then + call AA_End( m%rotors(iR)%AA_u, p%rotors(iR)%AA, xd%rotors(iR)%AA, OtherState%rotors(iR)%AA, m%rotors(iR)%AA_y, m%rotors(iR)%AA, ErrStat, ErrMsg ) + end if + enddo + end if + + end if + + + ! Close files here: @@ -1756,7 +1798,8 @@ subroutine AD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, errStat ! Also, SetInputs() [called above] calls SetInputsForBEMT() which in turn establishes current versions of the Global to local transformations we need as inputs to AA call SetInputsForAA(p%rotors(iR), u(1)%rotors(iR), m%Inflow(1)%RotInflow(iR), m%rotors(iR), errStat2, errMsg2) if (Failed()) return - call AA_UpdateStates(t, n, m%rotors(iR)%AA, m%rotors(iR)%AA_u, p%rotors(iR)%AA, xd%rotors(iR)%AA, errStat2, errMsg2) + + call AA_UpdateStates(t, n, m%rotors(iR)%AA, m%rotors(iR)%AA_u, p%rotors(iR)%AA, xd%rotors(iR)%AA, OtherState%rotors(iR)%AA, errStat2, errMsg2) if (Failed()) return end if enddo @@ -1805,10 +1848,9 @@ subroutine AD_CalcWind(t, u, FLowField, p, o, Inflow, ErrStat, ErrMsg) integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - integer(intKi) :: StartNode, iWT, k + integer(intKi) :: StartNode, iWT real(ReKi) :: PosOffset(3) real(ReKi), allocatable :: NoAcc(:,:) - type(RotInflowType), pointer :: RotInflow ! pointer to shorten names ErrStat = ErrID_None ErrMsg = "" @@ -2103,8 +2145,9 @@ subroutine RotCalcOutput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ! Also, SetInputs() [called above] calls SetInputsForBEMT() which in turn establishes current versions of the Global to local transformations we need as inputs to AA call SetInputsForAA(p, u, RotInflow, m, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AA_CalcOutput(t, m%AA_u, p%AA, x%AA, xd%AA, z%AA, OtherState%AA, m%AA_y, m%AA, errStat2, errMsg2) + call AA_CalcOutput(t, m%AA_u, p%AA, xd%AA, OtherState%AA, m%AA_y, m%AA, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! end if endif @@ -2157,7 +2200,7 @@ subroutine RotWriteOutputs( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m ! NOTE: m%BEMT_u(i) indices are set differently from the way OpenFAST typically sets up the u and uTimes arrays integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - integer(intKi) :: i, k + integer(intKi) :: i, j, k integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 @@ -2171,18 +2214,40 @@ subroutine RotWriteOutputs( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m call Calc_WriteOutput( p, p_AD, u, RotInflow, x, m, m_AD, y, OtherState, xd, indx, iRot, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - !............................................................................................................................... + !............................................................................................................................... ! Place the selected output channels into the WriteOutput(:) array with the proper sign: - !............................................................................................................................... - + !............................................................................................................................... do i = 1,p%NumOuts ! Loop through all selected output channels y%WriteOutput(i) = p%OutParam(i)%SignM * m%AllOuts( p%OutParam(i)%Indx ) end do ! i - All selected output channels end if + + i = p%NumOuts + if (p%AA%numOuts > 0) then + do j=1,p%AA%numOutsAll(1) + i = i + 1 + y%WriteOutput(i) = m%AA_y%WriteOutput(j) + end do + + do j=1,p%AA%numOutsAll(2) + i = i + 1 + y%WriteOutput(i) = m%AA_y%WriteOutputforPE(j) + end do + + do j=1,p%AA%numOutsAll(3) + i = i + 1 + y%WriteOutput(i) = m%AA_y%WriteOutputSep(j) + end do + + do j=1,p%AA%numOutsAll(4) + i = i + 1 + y%WriteOutput(i) = m%AA_y%WriteOutputNodes(j) + end do + end if if (p%BldNd_TotNumOuts > 0) then - y%WriteOutput(p%NumOuts+1:) = 0.0_ReKi + y%WriteOutput(i + 1:) = 0.0_ReKi !bjj: is this really necessary? ! Now we need to populate the blade node outputs here if (p%NumBlades > 0) then @@ -2859,19 +2924,15 @@ subroutine SetSectAvgInflow(t, p, p_AD, u, RotInflow, m, errStat, errMsg) integer(IntKi), intent( out) :: errStat !< Error status of the operation character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None ! local variables - real(R8Ki) :: R_li !< real(ReKi) :: x_hat_disk(3) !< unit vector normal to disk along hub x axis real(ReKi) :: r_A(3) !< Vector from global origin to blade node real(ReKi) :: r_H(3) !< Vector from global origin to hub center - real(ReKi) :: r_S(3) !< Vector from global origin to point in sector - real(ReKi) :: rHS(3) !< Vector from rotor center to point in sector real(ReKi) :: rHA(3) !< Vector from rotor center to blade node real(ReKi) :: rHA_perp(3) !< Component of rHA perpendicular to x_hat_disk real(ReKi) :: rHA_para(3) !< Component of rHA paralel to x_hat_disk real(ReKi) :: rHA_perp_n !< Norm of rHA_perp real(ReKi) :: e_r(3) !< Polar unit vector along rHA_perp real(ReKi) :: e_t(3) !< Polar unit vector perpendicular to rHA_perp ("e_theta") - real(ReKi) :: temp_norm real(ReKi) :: psi !< Azimuthal offset in the current sector, runs from -psi_bwd to psi_fwd real(ReKi) :: dpsi !< Azimuthal increment real(ReKi), allocatable :: SectPos(:,:)!< Points used to define a given sector (for a given blade node A) @@ -2998,7 +3059,6 @@ subroutine SetInputsForBEMT(p, p_AD, u, RotInflow, m, indx, errStat, errMsg) real(R8Ki) :: y_hat_disk(3) real(R8Ki) :: z_hat_disk(3) real(ReKi) :: tmp(3) - real(ReKi) :: tmp_sz, tmp_sz_y real(ReKi) :: rmax real(R8Ki) :: thetaBladeNds(p%NumBlNds,p%NumBlades) real(R8Ki) :: Azimuth(p%NumBlades) @@ -4386,7 +4446,7 @@ SUBROUTINE Init_AFIparams( InputFileData, p_AFI, UnEc, RootName, ErrStat, ErrMsg END SUBROUTINE Init_AFIparams !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes the Airfoil Noise module from within AeroDyn. -SUBROUTINE Init_AAmodule( DrvInitInp, AD_InputFileData, RotInputFileData, u_AD, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +SUBROUTINE Init_AAmodule( DrvInitInp, AD_InputFileData, RotInputFileData, u_AD, u, p, p_AD, xd, OtherState, y, m, InitOut, ErrStat, ErrMsg ) !.................................................................................................................................. type(RotInitInputType), intent(in ) :: DrvInitInp !< AeroDyn-level initialization inputs type(AD_InputFile), intent(in ) :: AD_InputFileData !< All the data in the AeroDyn input file @@ -4395,13 +4455,14 @@ SUBROUTINE Init_AAmodule( DrvInitInp, AD_InputFileData, RotInputFileData, u_AD, type(AA_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined type(RotParameterType), intent(inout) :: p !< Parameters ! intent out b/c we set the AA parameters here type(AD_ParameterType), intent(inout) :: p_AD !< Parameters ! intent out b/c we set the AA parameters here - type(AA_ContinuousStateType), intent( out) :: x !< Initial continuous states + !type(AA_ContinuousStateType), intent( out) :: x !< Initial continuous states type(AA_DiscreteStateType), intent( out) :: xd !< Initial discrete states - type(AA_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states + !type(AA_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states type(AA_OtherStateType), intent( out) :: OtherState !< Initial other states type(AA_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated; !! only the output mesh is initialized) type(AA_MiscVarType), intent( out) :: m !< Initial misc/optimization variables + type(AA_InitOutputType), intent( out) :: InitOut ! Output for initialization routine integer(IntKi), intent( out) :: errStat !< Error status of the operation character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None ! Local variables @@ -4412,7 +4473,6 @@ SUBROUTINE Init_AAmodule( DrvInitInp, AD_InputFileData, RotInputFileData, u_AD, ! Output is the actual coupling interval that will be used ! by the glue code. type(AA_InitInputType) :: InitInp ! Input data for initialization routine - type(AA_InitOutputType) :: InitOut ! Output for initialization routine integer(intKi) :: i ! airfoil file index integer(intKi) :: j ! node index integer(intKi) :: k ! blade index @@ -4433,17 +4493,6 @@ SUBROUTINE Init_AAmodule( DrvInitInp, AD_InputFileData, RotInputFileData, u_AD, InitInp%SpdSound = AD_InputFileData%SpdSound InitInp%HubHeight = DrvInitInp%HubPosition(3) - ! --- Transfer of airfoil info - ALLOCATE ( InitInp%AFInfo( size(p_AD%AFI) ), STAT=ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat ( ErrID_Fatal, 'Error allocating memory for the InitInp%AFInfo array.', ErrStat2, ErrMsg2, RoutineName ) - RETURN - ENDIF - do i=1,size(p_AD%AFI) - call AFI_CopyParam( p_AD%AFI(i), InitInp%AFInfo(i), MESH_NEWCOPY, errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - end do - ! --- Allocate and set AirfoilID, chord and Span for each blades ! note here that each blade is required to have the same number of nodes call AllocAry( InitInp%BlAFID, p%NumBlNds, p%NumBlades,'InitInp%BlAFID', errStat2, ErrMsg2 ) @@ -4458,14 +4507,14 @@ SUBROUTINE Init_AAmodule( DrvInitInp, AD_InputFileData, RotInputFileData, u_AD, end if do k = 1, p%NumBlades do j=1, RotInputFileData%BladeProps(k)%NumBlNds - InitInp%BlChord(j,k) = RotInputFileData%BladeProps(k)%BlChord( j) + InitInp%BlChord(j,k) = RotInputFileData%BladeProps(k)%BlChord(j) InitInp%BlSpn (j,k) = RotInputFileData%BladeProps(k)%BlSpn(j) - InitInp%BlAFID(j,k) = RotInputFileData%BladeProps(k)%BlAFID(j) + InitInp%BlAFID(j,k) = RotInputFileData%BladeProps(k)%BlAFID(j) end do end do ! --- AeroAcoustics initialization call - call AA_Init(InitInp, u, p%AA, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat2, ErrMsg2 ) + call AA_Init(InitInp, u, p%AA, xd, OtherState, y, m, Interval, p_AD%AFI, InitOut, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) call Cleanup() @@ -4473,8 +4522,7 @@ SUBROUTINE Init_AAmodule( DrvInitInp, AD_InputFileData, RotInputFileData, u_AD, contains subroutine Cleanup() - call AA_DestroyInitInput ( InitInp, ErrStat2, ErrMsg2 ) - call AA_DestroyInitOutput( InitOut, ErrStat2, ErrMsg2 ) + call AA_DestroyInitInput ( InitInp, ErrStat2, ErrMsg2 ) end subroutine Cleanup END SUBROUTINE Init_AAmodule @@ -4891,7 +4939,6 @@ SUBROUTINE TFin_CalcOutput(p, p_AD, u, RotInflow, m, y, ErrStat, ErrMsg ) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - real(ReKi) :: PRef(3) ! ref point real(ReKi) :: V_rel_tf(3) ! relative wind speed in tailfin coordinate system real(ReKi) :: V_rel_orth2 ! square norm of V_rel_tf in orthogonal plane real(ReKi) :: V_rel(3) ! relative wind speed @@ -6927,7 +6974,7 @@ SUBROUTINE Init_Jacobian_u( InputFileData, p, p_AD, u, InitOut, ErrStat, ErrMsg) CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! local variables: - INTEGER(IntKi) :: i, j, k, index, indexNames, index_last, nu, i_meshField + INTEGER(IntKi) :: i, k, index, indexNames, index_last, nu, i_meshField INTEGER(IntKi) :: NumFieldsForLinearization REAL(ReKi) :: perturb, perturb_t, perturb_b(AD_MaxBl_Out) LOGICAL :: FieldMask(FIELDMASK_SIZE) diff --git a/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 index 1a9e9bca75..c3cdd0febf 100644 --- a/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 @@ -234,7 +234,7 @@ SUBROUTINE AllBldNdOuts_InitOut( InitOut, p, InputFileData, ErrStat, ErrMsg ) ! Populate the header an unit lines for all blades and nodes ! First set a counter so we know where in the output array we are in ! NOTE: we populate invalid names as well (some names are not valid outputs for certain configurations). That means we will have zeros in those values. - INDX = p%NumOuts + 1 ! p%NumOuts is the number of outputs from the normal AeroDyn output. The WriteOutput array is sized to p%NumOuts + num(AllBldNdOuts) + INDX = p%NumOuts + p%AA%numOuts + 1 ! The WriteOutput array is sized to p%NumOuts + p%AA%numOuts + AllBldNdOuts DO IdxChan=1,p%BldNd_NumOuts @@ -327,7 +327,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, RotI ! Populate the header an unit lines for all blades and nodes ! First set a counter so we know where in the output array we are in - iOut = p%NumOuts + 1 ! p%NumOuts is the number of outputs from the normal AeroDyn output. The WriteOutput array is sized to p%NumOuts + num(AllBldNdOuts) + iOut = p%NumOuts + p%AA%numOuts + 1 ! p%NumOuts is the number of outputs from the normal AeroDyn output. The WriteOutput array is sized to p%NumOuts + p%AA%numOuts + num(AllBldNdOuts) ! Case to assign output to this channel and populate based on Indx value (this indicates what the channel is) diff --git a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 index e692dc0af0..8f2483211d 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 @@ -99,8 +99,7 @@ subroutine Dvr_Init(dvr, ADI, FED, errStat, errMsg ) ! local variables integer(IntKi) :: errStat2 ! local status of error message character(ErrMsgLen) :: errMsg2 ! local error message if errStat /= ErrID_None - character(1000) :: inputFile ! String to hold the file name. - character(200) :: git_commit ! String containing the current git commit hash + character(1000) :: InputFile ! String to hold the file name. character(20) :: FlagArg ! flag argument from command line integer :: iWT ! Index on wind turbines/rotors errStat = ErrID_None @@ -111,7 +110,7 @@ subroutine Dvr_Init(dvr, ADI, FED, errStat, errMsg ) InputFile = "" ! initialize to empty string to make sure it's input from the command line CALL CheckArgs( InputFile, Flag=FlagArg ) - IF ( LEN( TRIM(FlagArg) ) > 0 ) CALL NormStop() + IF ( LEN( TRIM(FlagArg) ) > 0 ) CALL NormStop() ! stop if user set a flag argument (like '-h' or '-v') ! Display the copyright notice and compile info: CALL DispCopyrightLicense( version%Name ) @@ -449,17 +448,17 @@ subroutine Init_ADI_ForDriver(iCase, ADI, dvr, FED, dt, needInitIW, errStat, err ! UA does not like changes of dt between cases if ( .not. EqualRealNos(ADI%p%AD%DT, dt) ) then call WrScr('Info: dt is changing between cases, AeroDyn will be re-initialized') - call ADI_End( ADI%u(1:1), ADI%p, ADI%x(1), ADI%xd(1), ADI%z(1), ADI%OtherState(1), ADI%y, ADI%m, errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Init_ADI_ForDriver'); if(Failed()) return - !call AD_Dvr_DestroyAeroDyn_Data (AD , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) needInit=.true. endif if (ADI%p%AD%Wake_Mod == WakeMod_FVW) then call WrScr('[INFO] OLAF is used, AeroDyn will be re-initialized') needInit=.true. endif + if (needInit) then call ADI_End( ADI%u(1:1), ADI%p, ADI%x(1), ADI%xd(1), ADI%z(1), ADI%OtherState(1), ADI%y, ADI%m, errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Init_ADI_ForDriver'); if(Failed()) return endif + endif ! if wind profile changed in a combined case, need to re-init @@ -477,6 +476,7 @@ subroutine Init_ADI_ForDriver(iCase, ADI, dvr, FED, dt, needInitIW, errStat, err InitInp%IW_InitInp%RefHt = dvr%IW_InitInp%RefHt InitInp%IW_InitInp%PLExp = dvr%IW_InitInp%PLExp InitInp%IW_InitInp%MHK = dvr%MHK + InitInp%IW_InitInp%OutputAccel= dvr%MHK /= MHK_None InitInp%IW_InitInp%FilePassingMethod = 0_IntKi ! read input file instead of passed file data ! AeroDyn InitInp%AD%Gravity = 9.80665_ReKi diff --git a/modules/aerodyn/src/AeroDyn_Inflow.f90 b/modules/aerodyn/src/AeroDyn_Inflow.f90 index 8da6e10758..d730dfa2ee 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow.f90 @@ -73,14 +73,25 @@ subroutine ADI_Init(InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut p%MHK = InitInp%AD%MHK p%WtrDpth = InitInp%AD%WtrDpth - ! --- Initialize Inflow Wind + ! --- Initialize Inflow Wind call ADI_InitInflowWind(InitInp%RootName, InitInp%IW_InitInp, u%AD, OtherState%AD, m%IW, Interval, InitOut_IW, errStat2, errMsg2); if (Failed()) return ! Concatenate AD outputs to IW outputs call concatOutputHeaders(InitOut%WriteOutputHdr, InitOut%WriteOutputUnt, InitOut_IW%WriteOutputHdr, InitOut_IW%WriteOutputUnt, errStat2, errMsg2); if(Failed()) return ! --- Initialize AeroDyn ! Link InflowWind's FlowField to AeroDyn's FlowField - InitInp%AD%FlowField => InitOut_IW%FlowField + select case (m%IW%CompInflow) + case (0) ! steady wind - data stored as a flowfield dataset + InitInp%AD%FlowField => InitOut_IW%FlowField + case (1) ! IfW is used directly in ADI + InitInp%AD%FlowField => InitOut_IW%FlowField + case (2) ! FlowField pointer is passed in + InitInp%AD%FlowField => InitInp%FlowField + case default + ErrStat2 = ErrID_Fatal + ErrMsg2 = 'Invalid value for CompInflow' + if (Failed()) return + end select call AD_Init(InitInp%AD, u%AD, p%AD, x%AD, xd%AD, z%AD, OtherState%AD, y%AD, m%AD, Interval, InitOut_AD, errStat2, errMsg2); if (Failed()) return InitOut%Ver = InitOut_AD%ver @@ -251,7 +262,6 @@ end subroutine ADI_UpdateStates !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. subroutine ADI_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, errStat, errMsg) - use IfW_FlowField, only: IfW_FlowField_GetVelAcc real(DbKi), intent(in ) :: t !< Current simulation time in seconds type(ADI_InputType), intent(inout) :: u !< Inputs at Time t ! NOTE: set as in-out since "Inflow" needs to be set type(ADI_ParameterType), intent(in ) :: p !< Parameters @@ -267,14 +277,15 @@ subroutine ADI_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, errStat, errMsg) integer(IntKi) :: errStat2 character(errMsgLen) :: errMsg2 - integer(IntKi) :: node character(*), parameter :: RoutineName = 'ADI_CalcOutput' integer :: iWT errStat = ErrID_None errMsg = "" !---------------------------------------------------------------------------- - ! Calculate InflowWind outputs if module was initialized + ! Calculate InflowWind outputs if module is directly used within ADI. + ! NOTE: if IfW is external and only the FlowField pointer is used, we don't do + ! any IfW calcoutput here !---------------------------------------------------------------------------- if (m%IW%CompInflow == 1) then @@ -375,7 +386,7 @@ subroutine ADI_InitInflowWind(Root, i_IW, u_AD, o_AD, IW, dt, InitOutData, errSt if(Failed()) return IW%p%FlowField%AccFieldValid = .true. end if - else + elseif (i_IW%CompInflow == 1) then ! InflowWind loaded here ! Initialze InflowWind module InitInData%InputFileName = i_IW%InputFile InitInData%Linearize = i_IW%Linearize @@ -388,12 +399,15 @@ subroutine ADI_InitInflowWind(Root, i_IW, u_AD, o_AD, IW, dt, InitOutData, errSt endif InitInData%RootName = trim(Root)//'.IfW' InitInData%MHK = i_IW%MHK + InitInData%WtrDpth = i_IW%WtrDpth + InitInData%MSL2SWL = i_IW%MSL2SWL ! OLAF might be used in AD, in which case we need to allow out of bounds for some calcs. To do that ! the average values for the entire wind profile must be calculated and stored (we don't know if OLAF ! is used until after AD_Init below). InitInData%BoxExceedAllow = .true. - - !bjj: what about these initialization inputs? + InitInData%OutputAccel = i_IW%OutputAccel + + !FIXME: bjj: what about these initialization inputs? ! InitInData%HubPosition ! InitInData%RadAvg @@ -401,6 +415,7 @@ subroutine ADI_InitInflowWind(Root, i_IW, u_AD, o_AD, IW, dt, InitOutData, errSt IW%x, IW%xd, IW%z, IW%OtherSt, & IW%y, IW%m, dt, InitOutData, errStat2, errMsg2 ) if(Failed()) return + !elseif (i_IW%CompInflow == 2) then ! InflowWind is external, using FlowField pointer, no init call required endif ! --- Store main init input data (data that don't use InfloWind directly) diff --git a/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 b/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 index 140dfc27f1..22ecc7d1b6 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 @@ -20,32 +20,42 @@ MODULE AeroDyn_Inflow_C_BINDING USE ISO_C_BINDING + USE AeroDyn_Inflow_c_binding_Types USE AeroDyn_Inflow USE AeroDyn_Inflow_Types USE AeroDyn_Driver_Types, only: Dvr_SimData, Dvr_Outputs USE AeroDyn_Driver_Subs, only: Dvr_InitializeOutputs, Dvr_WriteOutputs, SetVTKParameters !, WrVTK_Surfaces, WrVTK_Lines, WrVTK_Ground USE IfW_FlowField, only: IfW_FlowField_GetVelAcc USE NWTC_Library + USE NWTC_C_Binding, only: ErrMsgLen_C, IntfStrLen, SetErrStat_F2C USE VersionInfo IMPLICIT NONE SAVE PUBLIC :: ADI_C_Init - !PUBLIC :: ADI_C_ReInit PUBLIC :: ADI_C_CalcOutput PUBLIC :: ADI_C_UpdateStates PUBLIC :: ADI_C_End - PUBLIC :: ADI_C_PreInit ! Initial call to setup number of turbines - PUBLIC :: ADI_C_SetupRotor ! Initial node positions etc for a rotor - PUBLIC :: ADI_C_SetRotorMotion ! Set motions for a given rotor - PUBLIC :: ADI_C_GetRotorLoads ! Retrieve loads for a given rotor - PUBLIC :: ADI_C_GetDiskAvgVel ! Get the disk average velocity for the rotor + PUBLIC :: ADI_C_PreInit ! Initial call to setup number of turbines + PUBLIC :: ADI_C_SetupRotor ! Initial node positions etc for a rotor + PUBLIC :: ADI_C_SetRotorMotion ! Set motions for a given rotor + PUBLIC :: ADI_C_GetRotorLoads ! Retrieve loads for a given rotor + PUBLIC :: ADI_C_GetDiskAvgVel ! Get the disk average velocity for the rotor + PUBLIC :: ADI_C_SetFlowFieldPointer ! Set the pointer to the flowfield data (from external IfW instance) + PUBLIC :: ADI_C_GetFlowFieldPointer ! Get the pointer to the flowfield data (to pass to external IfW instance) !------------------------------------------------------------------------------------ ! Version info for display type(ProgDesc), parameter :: version = ProgDesc( 'AeroDyn-Inflow library', '', '' ) + !------------------------------------------------------------------------------------ + ! Wind + ! externFlowField - FlowField is handled externally to ADI, pointer must be set manually + ! FlowFieldPtrSet - is the FlowField pointer set from external? + logical :: externFlowField = .false. + logical :: FlowFieldPtrSet = .false. + !------------------------------------------------------------------------------------ ! Debugging: DebugLevel -- passed at PreInit ! 0 - none @@ -61,14 +71,6 @@ MODULE AeroDyn_Inflow_C_BINDING ! false - loads returned by ADI_C_GetRotorLoads are distributed (N/m, N-m/m) loads at mesh points logical :: PointLoadOutput = .true. - !------------------------------------------------------------------------------------ - ! Error handling - ! This must exactly match the value in the python-lib. If ErrMsgLen changes at - ! some point in the nwtc-library, this should be updated, but the logic exists - ! to correctly handle different lengths of the strings - integer(IntKi), parameter :: ErrMsgLen_C = 1025 - integer(IntKi), parameter :: IntfStrLen = 1025 ! length of other strings through the C interface - !------------------------------------------------------------------------------------ ! Potential issues ! - if MaxADIOutputs is sufficiently large, we may overrun the buffer on the Python @@ -80,6 +82,10 @@ MODULE AeroDyn_Inflow_C_BINDING ! IfW: MaxOutputs = 59 integer(IntKi), parameter :: MaxADIOutputs = 8000 + !------------------------------------------------------------------------------------ + ! Disk average velocity points + type(DiskAvgVelData), allocatable :: DiskAvgVelVars(:) + !------------------------------------------------------------------------------------ ! Data storage ! All AeroDyn data is stored within the following data structures inside this @@ -128,7 +134,9 @@ MODULE AeroDyn_Inflow_C_BINDING ! interface and therefore must store it here analogously to how it is handled ! in the OpenFAST glue code. integer(IntKi) :: n_Global ! global timestep - integer(IntKi) :: n_VTK ! VTK timestep + integer(IntKi) :: VTKn_Global ! global timestep for VTK + integer(IntKi) :: VTKn_last ! last global timestep for VTK + character(IntfStrLen) :: OutVTKDir !< Output directory for files (relative to current location) real(DbKi) :: InputTimePrev ! input time of last UpdateStates call real(DbKi) :: InputTimePrev_Calc ! input time of last CalcOutput call ! Note that we are including the previous state info here (not done in OF this way) @@ -140,54 +148,6 @@ MODULE AeroDyn_Inflow_C_BINDING integer(IntKi), parameter :: INPUT_CURR = 2 ! Index for current input at t integer(IntKi), parameter :: INPUT_PRED = 1 ! Index for predicted input at t+dt - !------------------------------- - ! Variables for disk average velocity calculations - integer(IntKi), parameter :: NumPtsDiskAvg = 144 - type :: DiskAvgVelData_Type - real(ReKi) :: DiskWindPosRel(3,NumPtsDiskAvg) - real(ReKi) :: DiskWindPosAbs(3,NumPtsDiskAvg) - real(ReKi) :: DiskWindVel(3,NumPtsDiskAvg) - real(ReKi) :: DiskAvgVel(3) - end type DiskAvgVelData_Type - type(DiskAvgVelData_Type), allocatable :: DiskAvgVelVars(:) - - !------------------------------------------------------------------------------------ - ! Meshes for motions and loads - ! Meshes are used within AD to handle all motions and loads. Rather than directly - ! map to those nodes, we will create a mapping to go between the array of node - ! positions passed into this module and what is used inside AD. This is done - ! through a pair of meshes for the motion and loads corresponding to the node - ! positions passed in. - - ! ========= BladeNodeToMeshPointMapType ======= - TYPE, PUBLIC :: BladeNodeToMeshPointMapType - INTEGER(IntKi), ALLOCATABLE :: BladeNodeToMeshPoint(:) !< Blade node -> structural mesh point mapping (sized by the number of nodes on the blade) - END TYPE BladeNodeToMeshPointMapType - ! ======================= - ! ========= BladeStrMeshCoordsType ======= - TYPE, PUBLIC :: BladeStrMeshCoordsType - REAL(ReKi), DIMENSION(:,:), ALLOCATABLE :: Position !< Position of all blade points (sized by 3 x number of mesh points on the blade [x,y,z]) - REAL(ReKi), DIMENSION(:,:,:), ALLOCATABLE :: Orient !< Orientation of all blade points (sized by 3 x 3 x number of mesh points on the blade [r11,r12,r13,r21,r22,r23,r31,r32,r33]) - REAL(ReKi), DIMENSION(:,:), ALLOCATABLE :: Velocity !< Velocity of all blade points (sized by 6 x number of mesh points on the blade [u,v,w,p,q,r]) - REAL(ReKi), DIMENSION(:,:), ALLOCATABLE :: Accln !< Acceleration of all blade points (sized by 6 x number of mesh points on the blade [udot,vdot,wdot,pdot,qdot,rdot]) - REAL(ReKi), DIMENSION(:,:), ALLOCATABLE :: Force !< Force of all blade points (sized by 6 x number of mesh points on the blade [Fx,Fy,Fz,Mx,My,Mz]) - END TYPE BladeStrMeshCoordsType - ! ======================= - ! ========= StrucPtsToBladeMapType ======= - TYPE, PUBLIC :: StrucPtsToBladeMapType - INTEGER(IntKi) :: NumBlades ! Number of blades on this rotor - INTEGER(IntKi), ALLOCATABLE :: NumMeshPtsPerBlade(:) ! Number of structural mesh points on each blade (sized by the number of blades) - INTEGER(IntKi), ALLOCATABLE :: MeshPt_2_BladeNum(:) ! Structural mesh point -> which blade on the rotor it is on (sized by the number of mesh points on the rotor) - TYPE(BladeNodeToMeshPointMapType),ALLOCATABLE:: BladeNode_2_MeshPt(:) ! Blade node on blade -> structural mesh point (sized by the number of mesh points on the blade) - TYPE(BladeStrMeshCoordsType), ALLOCATABLE :: BladeStrMeshCoords(:) ! Mesh point coordinates for each blade (sized by the number of blades) - END TYPE StrucPtsToBladeMapType - ! ======================= - ! ========= MeshByBladeType ======= - TYPE, PUBLIC :: MeshByBladeType - ! TODO: Sometime we should rename Mesh to BldMesh - TYPE(MeshType), ALLOCATABLE :: Mesh(:) ! Mesh for motions/loads of external nodes at each blade (sized by number of blades on the rotor) - END TYPE MeshByBladeType - ! ======================= !------------------------------ ! Meshes for external nodes @@ -225,59 +185,74 @@ MODULE AeroDyn_Inflow_C_BINDING CONTAINS -!> This routine sets the error status in C_CHAR for export to calling code. -!! Make absolutely certain that we do not overrun the end of ErrMsg_C. That is hard coded to 1025, -!! but ErrMsgLen is set in the nwtc_library, and could change without updates here. We don't want an -!! inadvertant buffer overrun -- that can lead to bad things. -subroutine SetErr(ErrStat, ErrMsg, ErrStat_C, ErrMsg_C) - integer, intent(in ) :: ErrStat !< aggregated error message (fortran type) - character(ErrMsgLen), intent(in ) :: ErrMsg !< aggregated error message (fortran type) - integer(c_int), intent( out) :: ErrStat_C - character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) - integer :: i - ErrStat_C = ErrStat ! We will send back the same error status that is used in OpenFAST - if (ErrMsgLen > ErrMsgLen_C-1) then ! If ErrMsgLen is > the space in ErrMsg_C, do not copy everything over - ErrMsg_C = TRANSFER( trim(ErrMsg(1:ErrMsgLen_C-1))//C_NULL_CHAR, ErrMsg_C ) - else - ErrMsg_C = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_C ) - endif - if (ErrStat /= ErrID_None) call WrScr(NewLine//'ADI_C_Binding: '//trim(ErrMsg)//NewLine) -end subroutine SetErr - !=============================================================================================================== !--------------------------------------------- AeroDyn PreInit ------------------------------------------------- !=============================================================================================================== !> Allocate all the arrays for data storage for all turbine rotors -subroutine ADI_C_PreInit(NumTurbines_C, TransposeDCM_in, PointLoadOutput_in, DebugLevel_in, ErrStat_C, ErrMsg_C) BIND (C, NAME='ADI_C_PreInit') +subroutine ADI_C_PreInit( & + NumTurbines_C, & + TransposeDCM_in, PointLoadOutput_in, & + gravity_in, defFldDens_in, defKinVisc_in, & + defSpdSound_in, defPatm_in, defPvap_in, & + WtrDpth_in, MSL2SWL_in, & + MHK_in, & + externFlowField_in, & + OutVTKDir_C, & + WrVTK_in, WrVTK_inType, WrVTK_inDT, & + VTKNacDim_in, VTKHubRad_in, & + DebugLevel_in, ErrStat_C, ErrMsg_C & +) BIND (C, NAME='ADI_C_PreInit') implicit none #ifndef IMPLICIT_DLLEXPORT !DEC$ ATTRIBUTES DLLEXPORT :: ADI_C_PreInit !GCC$ ATTRIBUTES DLLEXPORT :: ADI_C_PreInit #endif - integer(c_int), intent(in ) :: NumTurbines_C - integer(c_int), intent(in ) :: TransposeDCM_in !< Transpose DCMs as they are passed i - integer(c_int), intent(in ) :: PointLoadOutput_in - integer(c_int), intent(in ) :: DebugLevel_in - integer(c_int), intent( out) :: ErrStat_C - character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + integer(c_int), intent(in ) :: NumTurbines_C + integer(c_int), intent(in ) :: TransposeDCM_in !< Transpose DCMs as they are passed in + integer(c_int), intent(in ) :: PointLoadOutput_in + real(c_float), intent(in ) :: gravity_in !< Gravitational acceleration (m/s^2) + real(c_float), intent(in ) :: defFldDens_in !< Air density (kg/m^3) + real(c_float), intent(in ) :: defKinVisc_in !< Kinematic viscosity of working fluid (m^2/s) + real(c_float), intent(in ) :: defSpdSound_in !< Speed of sound in working fluid (m/s) + real(c_float), intent(in ) :: defPatm_in !< Atmospheric pressure (Pa) [used only for an MHK turbine cavitation check] + real(c_float), intent(in ) :: defPvap_in !< Vapour pressure of working fluid (Pa) [used only for an MHK turbine cavitation check] + real(c_float), intent(in ) :: WtrDpth_in !< Water depth (m) [used only for an MHK turbine] + real(c_float), intent(in ) :: MSL2SWL_in !< Offset between still-water level and mean sea level (m) [positive upward, used only for an MHK turbine] + integer(c_int), intent(in ) :: MHK_in !< Marine hydrokinetic turbine [0: none; 1: fixed bottom MHK; 2: Floating MHK] + ! inflow + integer(c_int), intent(in ) :: externFlowField_in !< skip IfW setup and use external module with pointer + ! VTK + character(kind=c_char), intent(in ) :: OutVTKDir_C(IntfStrLen) !< Directory to put all vtk output + integer(c_int), intent(in ) :: WrVTK_in !< Write VTK outputs [0: none, 1: init only, 2: animation] + integer(c_int), intent(in ) :: WrVTK_inType !< Write VTK outputs as [1: surface, 2: lines, 3: both] + real(c_double), intent(in ) :: WrVTK_inDT !< Timestep between VTK writes + real(c_float), intent(in ) :: VTKNacDim_in(6) !< Nacelle dimension passed in for VTK surface rendering [0,y0,z0,Lx,Ly,Lz] (m) + real(c_float), intent(in ) :: VTKHubrad_in !< Hub radius for VTK surface rendering + integer(c_int), intent(in ) :: DebugLevel_in + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) ! Local variables integer(IntKi) :: iWT !< current turbine - integer :: ErrStat !< aggregated error status - character(ErrMsgLen) :: ErrMsg !< aggregated error message - integer :: ErrStat2 !< temporary error status from a call - character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call + integer(IntKi) :: i !< generic index variables + integer :: ErrStat_F !< aggregated error status + character(ErrMsgLen) :: ErrMsg_F !< aggregated error message + integer :: ErrStat_F2 !< temporary error status from a call + character(ErrMsgLen) :: ErrMsg_F2 !< temporary error message from a call character(*), parameter :: RoutineName = 'ADI_C_PreInit' !< for error handling ! Initialize error handling - ErrStat = ErrID_None - ErrMsg = "" + ErrStat_F = ErrID_None + ErrMsg_F = "" CALL NWTC_Init( ProgNameIn=version%Name ) CALL DispCopyrightLicense( version%Name ) CALL DispCompileRuntimeInfo( version%Name ) + ! clear out any memory that may be leftover from previous use of library without unloading + call ClearTmpStorage() + ! Save flag for outputting point or distributed loads PointLoadOutput = PointLoadOutput_in /= 0 @@ -291,8 +266,8 @@ subroutine ADI_C_PreInit(NumTurbines_C, TransposeDCM_in, PointLoadOutput_in, Deb ! check valid debug level if (DebugLevel < 0_IntKi) then - ErrStat2 = ErrID_Fatal - ErrMsg2 = "Interface debug level must be 0 or greater"//NewLine// & + ErrStat_F2 = ErrID_Fatal + ErrMsg_F2 = "Interface debug level must be 0 or greater"//NewLine// & " 0 - none"//NewLine// & " 1 - some summary info and variables passed through interface"//NewLine// & " 2 - above + all position/orientation info"//NewLine// & @@ -305,8 +280,8 @@ subroutine ADI_C_PreInit(NumTurbines_C, TransposeDCM_in, PointLoadOutput_in, Deb Sim%NumTurbines = int(NumTurbines_C,IntKi) if (Sim%NumTurbines < 1_IntKi .or. Sim%NumTurbines > 9_IntKi) then - ErrStat2 = ErrID_Fatal - ErrMsg2 = 'AeroDyn_Inflow simulates between 1 and 9 turbines, but '//trim(Num2LStr(Sim%NumTurbines))//' was specified' + ErrStat_F2 = ErrID_Fatal + ErrMsg_F2 = 'AeroDyn_Inflow simulates between 1 and 9 turbines, but '//trim(Num2LStr(Sim%NumTurbines))//' was specified' if (Failed()) return; endif @@ -315,22 +290,22 @@ subroutine ADI_C_PreInit(NumTurbines_C, TransposeDCM_in, PointLoadOutput_in, Deb ! Allocate arrays and meshes for the number of turbines if (allocated(InitInp%AD%rotors)) deallocate(InitInp%AD%rotors) - allocate(InitInp%AD%rotors(Sim%NumTurbines),stat=errStat2); if (Failed0('rotors')) return + allocate(InitInp%AD%rotors(Sim%NumTurbines),stat=ErrStat_F2); if (Failed0('rotors')) return ! allocate data storage for DiskAvgVel retrieval if (allocated(DiskAvgVelVars)) deallocate(DiskAvgVelVars) - allocate(DiskAvgVelVars(Sim%NumTurbines), STAT=ErrStat2); if (Failed0('DiskAvgVelVars')) return + allocate(DiskAvgVelVars(Sim%NumTurbines), STAT=ErrStat_F2); if (Failed0('DiskAvgVelVars')) return ! Allocate data storage for turbine info if (allocated(Sim%WT)) deallocate(Sim%WT) - allocate(Sim%WT(Sim%NumTurbines),stat=errStat2); if (Failed0('wind turbines')) return + allocate(Sim%WT(Sim%NumTurbines),stat=ErrStat_F2); if (Failed0('wind turbines')) return do iWT=1,Sim%NumTurbines Sim%WT(iWT)%NumBlades = -999 enddo ! Storage for number of meshpoints if (allocated(NumMeshPts)) deallocate(NumMeshPts) - allocate(NumMeshPts(Sim%NumTurbines),stat=errStat2); if (Failed0('NumMeshPts')) return + allocate(NumMeshPts(Sim%NumTurbines),stat=ErrStat_F2); if (Failed0('NumMeshPts')) return NumMeshPts = -999 ! Allocate meshes and mesh mappings @@ -339,45 +314,96 @@ subroutine ADI_C_PreInit(NumTurbines_C, TransposeDCM_in, PointLoadOutput_in, Deb if (allocated(BldStrLoadMesh_tmp)) deallocate(BldStrLoadMesh_tmp) ! if (allocated(NacMotionMesh )) deallocate(NacMotionMesh ) ! if (allocated(NacLoadMesh )) deallocate(NacLoadMesh ) - allocate(BldStrMotionMesh( Sim%NumTurbines), STAT=ErrStat2); if (Failed0('BldStrMotionMesh' )) return - allocate(BldStrLoadMesh( Sim%NumTurbines), STAT=ErrStat2); if (Failed0('BldStrLoadMesh' )) return - allocate(BldStrLoadMesh_tmp(Sim%NumTurbines), STAT=ErrStat2); if (Failed0('BldStrLoadMesh_tmp')) return - ! allocate(NacMotionMesh( Sim%NumTurbines), STAT=ErrStat2); if (Failed0('NacMotionMesh' )) return - ! allocate(NacLoadMesh( Sim%NumTurbines), STAT=ErrStat2); if (Failed0('NacLoadMesh' )) return + allocate(BldStrMotionMesh( Sim%NumTurbines), STAT=ErrStat_F2); if (Failed0('BldStrMotionMesh' )) return + allocate(BldStrLoadMesh( Sim%NumTurbines), STAT=ErrStat_F2); if (Failed0('BldStrLoadMesh' )) return + allocate(BldStrLoadMesh_tmp(Sim%NumTurbines), STAT=ErrStat_F2); if (Failed0('BldStrLoadMesh_tmp')) return + ! allocate(NacMotionMesh( Sim%NumTurbines), STAT=ErrStat_F2); if (Failed0('NacMotionMesh' )) return + ! allocate(NacLoadMesh( Sim%NumTurbines), STAT=ErrStat_F2); if (Failed0('NacLoadMesh' )) return if (allocated(Map_BldStrMotion_2_AD_Blade )) deallocate(Map_BldStrMotion_2_AD_Blade ) if (allocated(Map_AD_BldLoad_P_2_BldStrLoad )) deallocate(Map_AD_BldLoad_P_2_BldStrLoad) ! if (allocated(Map_NacPtMotion_2_AD_Nac )) deallocate(Map_NacPtMotion_2_AD_Nac ) - ! allocate(Map_NacPtMotion_2_AD_Nac(Sim%NumTurbines),STAT=ErrStat2); if (Failed0('Map_AD_BldLoad_P_2_BldStrLoad')) returns + ! allocate(Map_NacPtMotion_2_AD_Nac(Sim%NumTurbines),STAT=ErrStat_F2); if (Failed0('Map_AD_BldLoad_P_2_BldStrLoad')) returns ! Allocate the StrucPtsToBladeMapType array used for mapping structural points to blades of the rotor if (allocated(StrucPts_2_Bld_Map)) deallocate(StrucPts_2_Bld_Map) - allocate(StrucPts_2_Bld_Map(Sim%NumTurbines), STAT=ErrStat2); if (Failed0('StrucPts_2_Bld_Map' )) return + allocate(StrucPts_2_Bld_Map(Sim%NumTurbines), STAT=ErrStat_F2); if (Failed0('StrucPts_2_Bld_Map' )) return + + !---------------------------------------------------- + ! Set AeroDyn initialization data + !---------------------------------------------------- + InitInp%AD%Gravity = REAL(gravity_in, ReKi) + InitInp%AD%defFldDens = REAL(defFldDens_in, ReKi) + InitInp%AD%defKinVisc = REAL(defKinVisc_in, ReKi) + InitInp%AD%defSpdSound = REAL(defSpdSound_in, ReKi) + InitInp%AD%defPatm = REAL(defPatm_in, ReKi) + InitInp%AD%defPvap = REAL(defPvap_in, ReKi) + InitInp%AD%WtrDpth = REAL(WtrDpth_in, ReKi) + InitInp%AD%MSL2SWL = REAL(MSL2SWL_in, ReKi) + + ! Set whether these are MHK turbines + InitInp%AD%MHK = MHK_in + InitInp%IW_InitInp%MHK = MHK_in + InitInp%IW_InitInp%OutputAccel = MHK_in /= MHK_None + InitInp%IW_InitInp%WtrDpth = REAL(WtrDpth_in, ReKi) + InitInp%IW_InitInp%MSL2SWL = REAL(MSL2SWL_in, ReKi) + + ! Offset the origin to account for water depth for MHK turbines + do iWT=1,Sim%NumTurbines + if ( InitInp%AD%MHK == MHK_FixedBottom ) then + Sim%WT(iWT)%originInit(3) = Sim%WT(iWT)%originInit(3) - InitInp%AD%WtrDpth + end if + enddo - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + + !---------------------------------------------------- + ! ADI settings + !---------------------------------------------------- + ! FlowField - internal to ADI library, or external + ! if externally set, must call the ADI_C_SetFlowFieldPointer routine + if (externFlowField_in==1_c_int) then + externFlowField = .true. + endif + + ! Setup VTK + ! OutVTKDir -- output directory + OutVTKDir = TRANSFER( OutVTKDir_C, OutVTKDir ) + i = INDEX(OutVTKDir,C_NULL_CHAR) - 1 ! if this has a c null character at the end... + if ( i > 0 ) OutVTKDir = OutVTKDir(1:I) ! remove it + + ! VTK writing + WrOutputsData%WrVTK = int(WrVTK_in, IntKi) + WrOutputsData%WrVTK_Type = int(WrVTK_inType, IntKi) + WrOutputsData%VTK_dt = real(WrVTK_inDT, DbKi) + WrOutputsData%VTKNacDim = real(VTKNacDim_in, SiKi) + WrOutputsData%VTKHubrad = real(VTKHubrad_in, SiKi) + WrOutputsData%VTKRefPoint = (/ 0.0_ReKi, 0.0_ReKi, 0.0_ReKi /) !TODO: should this be an input? + WrOutputsData%n_VTKTime = 1 ! output every timestep + + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) contains logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev + CALL SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + Failed = ErrStat_F >= AbortErrLev if (Failed) then call ClearTmpStorage() - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) endif end function Failed ! check for failed where /= 0 is fatal logical function Failed0(txt) character(*), intent(in) :: txt - if (ErrStat2 /= 0) then - ErrStat2 = ErrID_Fatal - ErrMsg2 = "Could not allocate "//trim(txt) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat_F2 /= 0) then + ErrStat_F2 = ErrID_Fatal + ErrMsg_F2 = "Could not allocate "//trim(txt) + call SetErrStat(ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName) endif - Failed0 = ErrStat >= AbortErrLev + Failed0 = ErrStat_F >= AbortErrLev if(Failed0) then call ClearTmpStorage() - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) endif end function Failed0 @@ -394,6 +420,23 @@ subroutine ShowPassedData() TmpFlag="F"; if (TransposeDCM_in==1_c_int) TmpFlag="T" call WrScr(" TransposeDCM_in "//TmpFlag ) call WrScr(" debuglevel "//trim(Num2LStr( DebugLevel_in )) ) + call WrScr(" Environment variables") + call WrScr(" gravity_C "//trim(Num2LStr( gravity_in )) ) + call WrScr(" defFldDens_C "//trim(Num2LStr( defFldDens_in )) ) + call WrScr(" defKinVisc_C "//trim(Num2LStr( defKinVisc_in )) ) + call WrScr(" defSpdSound_C "//trim(Num2LStr( defSpdSound_in )) ) + call WrScr(" defPatm_C "//trim(Num2LStr( defPatm_in )) ) + call WrScr(" defPvap_C "//trim(Num2LStr( defPvap_in )) ) + call WrScr(" WtrDpth_C "//trim(Num2LStr( WtrDpth_in )) ) + call WrScr(" MSL2SWL_C "//trim(Num2LStr( MSL2SWL_in )) ) + call WrScr(" Wind from external IfW instance") + TmpFlag="F"; if (externFlowField_in==1_c_int) TmpFlag="T" + call WrScr(" externFlowField_in "//TmpFlag ) + call WrScr(" VTK visualization variables") + call WrScr(" OutVTKDir "//trim(OutVTKDir) ) + call WrScr(" WrVTK_in "//trim(Num2LStr( WrVTK_in )) ) + call WrScr(" WrVTK_inType "//trim(Num2LStr( WrVTK_inType )) ) + call WrScr(" WrVTK_inDT "//trim(Num2LStr( WrVTK_inDT )) ) call WrScr("-----------------------------------------------------------") end subroutine ShowPassedData @@ -404,13 +447,8 @@ end subroutine ADI_C_PreInit !=============================================================================================================== SUBROUTINE ADI_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileStringLength_C, & IfWinputFilePassed, IfWinputFileString_C, IfWinputFileStringLength_C, OutRootName_C, & - OutVTKDir_C, & - gravity_C, defFldDens_C, defKinVisc_C, defSpdSound_C, & - defPatm_C, defPvap_C, WtrDpth_C, MSL2SWL_C, & InterpOrder_C, DT_C, TMax_C, & storeHHVel, & - WrVTK_in, WrVTK_inType, WrVTK_inDT, & - VTKNacDim_in, VTKHubRad_in, & wrOuts_C, DT_Outs_C, & NumChannels_C, OutputChannelNames_C, OutputChannelUnits_C, & ErrStat_C, ErrMsg_C) BIND (C, NAME='ADI_C_Init') @@ -420,23 +458,13 @@ SUBROUTINE ADI_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileString !GCC$ ATTRIBUTES DLLEXPORT :: ADI_C_Init #endif ! Input file info - integer(c_int), intent(in ) :: ADinputFilePassed !< 0: pass the input file name; 1: pass the input file content - type(c_ptr), intent(in ) :: ADinputFileString_C !< Input file as a single string with lines deliniated by C_NULL_CHAR + integer(c_int), intent(in ) :: ADinputFilePassed !< Whether to load the file from the filesystem - 1: ADinputFileString_C contains the contents of the input file; otherwise, ADinputFileString_C contains the path to the input file + type(c_ptr), intent(in ) :: ADinputFileString_C !< Input file as a single string with lines delineated by C_NULL_CHAR integer(c_int), intent(in ) :: ADinputFileStringLength_C !< length of the input file string - integer(c_int), intent(in ) :: IfWinputFilePassed !< 0: pass the input file name; 1: pass the input file content - type(c_ptr), intent(in ) :: IfWinputFileString_C !< Input file as a single string with lines deliniated by C_NULL_CHAR + integer(c_int), intent(in ) :: IfWinputFilePassed !< Whether to load the file from the filesystem - 1: IfWinputFileString_C contains the contents of the input file; otherwise, IfWinputFileString_C contains the path to the input file + type(c_ptr), intent(in ) :: IfWinputFileString_C !< Input file as a single string with lines delineated by C_NULL_CHAR integer(c_int), intent(in ) :: IfWinputFileStringLength_C !< length of the input file string character(kind=c_char), intent(in ) :: OutRootName_C(IntfStrLen) !< Root name to use for echo files and other - character(kind=c_char), intent(in ) :: OutVTKDir_C(IntfStrLen) !< Directory to put all vtk output - ! Environmental - real(c_float), intent(in ) :: gravity_C !< Gravitational acceleration (m/s^2) - real(c_float), intent(in ) :: defFldDens_C !< Air density (kg/m^3) - real(c_float), intent(in ) :: defKinVisc_C !< Kinematic viscosity of working fluid (m^2/s) - real(c_float), intent(in ) :: defSpdSound_C !< Speed of sound in working fluid (m/s) - real(c_float), intent(in ) :: defPatm_C !< Atmospheric pressure (Pa) [used only for an MHK turbine cavitation check] - real(c_float), intent(in ) :: defPvap_C !< Vapour pressure of working fluid (Pa) [used only for an MHK turbine cavitation check] - real(c_float), intent(in ) :: WtrDpth_C !< Water depth (m) - real(c_float), intent(in ) :: MSL2SWL_C !< Offset between still-water level and mean sea level (m) [positive upward] ! Interpolation integer(c_int), intent(in ) :: InterpOrder_C !< Interpolation order to use (must be 1 or 2) ! Time @@ -444,12 +472,6 @@ SUBROUTINE ADI_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileString real(c_double), intent(in ) :: TMax_C !< Maximum time for simulation ! Flags integer(c_int), intent(in ) :: storeHHVel !< Store hub height time series from IfW - ! VTK - integer(c_int), intent(in ) :: WrVTK_in !< Write VTK outputs [0: none, 1: init only, 2: animation] - integer(c_int), intent(in ) :: WrVTK_inType !< Write VTK outputs as [1: surface, 2: lines, 3: both] - real(c_double), intent(in ) :: WrVTK_inDT !< Timestep between VTK writes - real(c_float), intent(in ) :: VTKNacDim_in(6) !< Nacelle dimension passed in for VTK surface rendering [0,y0,z0,Lx,Ly,Lz] (m) - real(c_float), intent(in ) :: VTKHubrad_in !< Hub radius for VTK surface rendering integer(c_int), intent(in ) :: wrOuts_C !< Write ADI output file real(c_double), intent(in ) :: DT_Outs_C !< Timestep to write output file from ADI ! Output @@ -462,24 +484,23 @@ SUBROUTINE ADI_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileString ! Local variables character(IntfStrLen) :: OutRootName !< Root name to use for echo files and other character(IntfStrLen) :: TmpFileName !< Temporary file name if not passing AD or IfW input file contents directly - character(kind=C_char, len=ADinputFileStringLength_C), pointer :: ADinputFileString !< Input file as a single string with NULL chracter separating lines - character(kind=C_char, len=IfWinputFileStringLength_C), pointer:: IfWinputFileString !< Input file as a single string with NULL chracter separating lines - - integer(IntKi) :: ErrStat !< aggregated error message - character(ErrMsgLen) :: ErrMsg !< aggregated error message - integer(IntKi) :: ErrStat2 !< temporary error status from a call - character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call - character(IntfStrLen) :: OutVTKDir !< Output directory for files (relative to current location) + character(kind=C_char, len=ADinputFileStringLength_C), pointer :: ADinputFileString !< Input file as a single string with NULL character separating lines + character(kind=C_char, len=IfWinputFileStringLength_C), pointer:: IfWinputFileString !< Input file as a single string with NULL character separating lines + + integer(IntKi) :: ErrStat_F !< aggregated error message + character(ErrMsgLen) :: ErrMsg_F !< aggregated error message + integer(IntKi) :: ErrStat_F2 !< temporary error status from a call + character(ErrMsgLen) :: ErrMsg_F2 !< temporary error message from a call integer(IntKi) :: i,j,k !< generic index variables integer(IntKi) :: iWT !< current turbine number (iterate through during setup for ADI_Init call) integer(IntKi) :: AeroProjMod !< for checking that all turbines use the same AeroProjMod character(*), parameter :: RoutineName = 'ADI_C_Init' !< for error handling ! Initialize error handling - ErrStat = ErrID_None - ErrMsg = "" - ErrStat2 = ErrID_None - ErrMsg2 = "" + ErrStat_F = ErrID_None + ErrMsg_F = "" + ErrStat_F2 = ErrID_None + ErrMsg_F2 = "" NumChannels_C = 0_c_int OutputChannelNames_C(:) = '' OutputChannelUnits_C(:) = '' @@ -487,13 +508,31 @@ SUBROUTINE ADI_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileString ! check if Pre-Init was called if (Sim%NumTurbines < 0_IntKi) then - ErrStat2 = ErrID_Fatal - ErrMsg2 = "Call ADI_C_PreInit and ADI_C_SetupRotor prior to calling ADI_C_Init" + ErrStat_F2 = ErrID_Fatal + ErrMsg_F2 = "Call ADI_C_PreInit and ADI_C_SetupRotor prior to calling ADI_C_Init" if (Failed()) return endif + ! if using an external IfW, check that the pointer was actually set and is valid + if (externFlowField) then + if (.not. FlowFieldPtrSet) then + ErrStat_F2 = ErrID_Fatal + ErrMsg_F2 = "FlowField data from an external InflowWind instance declared, but pointer to data not set. Call ADI_C_SetFlowFieldPointer after ADI_C_PreInit, but before ADI_C_Init" + if (Failed()) return + endif + if (associated(InitInp%FlowField)) then + ! basic sanity check + if (InitInp%FlowField%FieldType <= 0_IntKi) then + ErrStat_F2 = ErrID_Fatal + ErrMsg_F2 = "Invalid FlowField pointer passed in, or external InflowWind FlowField not initialized. Call ADI_C_SetFlowFieldPointer after ADI_C_PreInit, but before ADI_C_Init" + if (Failed()) return + endif + endif + endif + + do iWT=1,Sim%NumTurbines - if (Sim%WT(iWT)%NumBlades < 0) call SetErrStat(ErrID_Fatal,"Rotor "//trim(Num2LStr(iWT))//" not initialized. Call ADI_C_SetupRotor prior to calling ADI_C_Init",ErrStat,ErrMsg,RoutineName) + if (Sim%WT(iWT)%NumBlades < 0) call SetErrStat(ErrID_Fatal,"Rotor "//trim(Num2LStr(iWT))//" not initialized. Call ADI_C_SetupRotor prior to calling ADI_C_Init",ErrStat_F2,ErrMsg_F2,RoutineName) enddo if (Failed()) return @@ -502,15 +541,12 @@ SUBROUTINE ADI_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileString AeroProjMod = InitInp%AD%rotors(1)%AeroProjMod do iWT = 2,Sim%NumTurbines if(AeroProjMod /= InitInp%AD%rotors(iWT)%AeroProjMod) then - ErrStat2 = ErrID_Fatal - ErrMsg2 = "Different AeroProjMod values for each turbine (set from TurbineIsHAWT flag). Check that all turbines are of the same type (HAWT or not)." + ErrStat_F2 = ErrID_Fatal + ErrMsg_F2 = "Different AeroProjMod values for each turbine (set from TurbineIsHAWT flag). Check that all turbines are of the same type (HAWT or not)." if (Failed()) return endif enddo - ! Setup temporary storage arrays for simpler transfers - call SetTempStorage(ErrStat2,ErrMsg2); if (Failed()) return - !-------------------------- ! Input files @@ -520,11 +556,6 @@ SUBROUTINE ADI_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileString i = INDEX(OutRootName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... if ( i > 0 ) OutRootName = OutRootName(1:I) ! remove it - ! OutVTKDir -- output directory - OutVTKDir = TRANSFER( OutVTKDir_C, OutVTKDir ) - i = INDEX(OutVTKDir,C_NULL_CHAR) - 1 ! if this has a c null character at the end... - if ( i > 0 ) OutVTKDir = OutVTKDir(1:I) ! remove it - ! For debugging the interface: if (DebugLevel > 0) then call ShowPassedData() @@ -540,7 +571,7 @@ SUBROUTINE ADI_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileString if (ADinputFilePassed==1_c_int) then InitInp%AD%UsePrimaryInputFile = .FALSE. ! Don't try to read an input -- use passed data instead (blades and AF tables not passed) InitInp%AD%InputFile = "passed_ad_file" ! not actually used - call InitFileInfo(ADinputFileString, InitInp%AD%PassedPrimaryInputData, ErrStat2, ErrMsg2); if (Failed()) return + call InitFileInfo(ADinputFileString, InitInp%AD%PassedPrimaryInputData, ErrStat_F2, ErrMsg_F2); if (Failed()) return else InitInp%AD%UsePrimaryInputFile = .TRUE. ! Read input info from a primary input file i = min(IntfStrLen,ADinputFileStringLength_C) @@ -557,7 +588,7 @@ SUBROUTINE ADI_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileString if (IfWinputFilePassed==1_c_int) then InitInp%IW_InitInp%FilePassingMethod = 1_IntKi ! Don't try to read an input -- use passed data instead (blades and AF tables not passed) using FileInfoType InitInp%IW_InitInp%InputFile = "passed_ifw_file" ! not actually used - call InitFileInfo(IfWinputFileString, InitInp%IW_InitInp%PassedFileInfo, ErrStat2, ErrMsg2); if (Failed()) return + call InitFileInfo(IfWinputFileString, InitInp%IW_InitInp%PassedFileInfo, ErrStat_F2, ErrMsg_F2); if (Failed()) return else InitInp%IW_InitINp%FilePassingMethod = 0_IntKi ! Read input info from a primary input file i = min(IntfStrLen,IfWinputFileStringLength_C) @@ -584,54 +615,41 @@ SUBROUTINE ADI_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileString Sim%root = trim(OutRootName) ! Timekeeping n_Global = 0_IntKi ! Assume we are on timestep 0 at start - n_VTK = -1_IntKi ! counter advance just before writing + VTKn_Global = 0_IntKi + VTKn_last = -1_IntKi ! Interpolation order InterpOrder = int(InterpOrder_C, IntKi) - ! VTK outputs - WrOutputsData%WrVTK = int(WrVTK_in, IntKi) - WrOutputsData%WrVTK_Type = int(WrVTK_inType, IntKi) - WrOutputsData%VTK_dt = real(WrVTK_inDT, DbKi) - WrOutputsData%VTKNacDim = real(VTKNacDim_in, SiKi) - WrOutputsData%VTKHubrad = real(VTKHubrad_in, SiKi) - WrOutputsData%VTKRefPoint = (/ 0.0_ReKi, 0.0_ReKi, 0.0_ReKi /) !TODO: should this be an input? + ! VTK output file WrOutputsData%root = trim(OutRootName) - WrOutputsData%n_VTKTime = 1 ! output every timestep ! Write outputs to file WrOutputsData%fileFmt = int(wrOuts_C, IntKi) WrOutputsData%DT_Outs = real(DT_Outs_C, DbKi) ! Validate and set some inputs (moved to subroutine to make cleaner to read - call ValidateSetInputs(ErrStat2,ErrMsg2); if(Failed()) return + call ValidateSetInputs(ErrStat_F2,ErrMsg_F2); if(Failed()) return + call ValidateSetVTK(ErrStat_F2,ErrMsg_F2); if(Failed()) return ! Linearization ! for now, set linearization to false. Pass this in later when interface supports it InitInp%AD%Linearize = .FALSE. !InitInp%IW_InitInp%Linearize = .FALSE. - - !---------------------------------------------------- - ! Set AeroDyn initialization data - !---------------------------------------------------- - InitInp%AD%Gravity = REAL(gravity_C, ReKi) - InitInp%AD%defFldDens = REAL(defFldDens_C, ReKi) - InitInp%AD%defKinVisc = REAL(defKinVisc_C, ReKi) - InitInp%AD%defSpdSound = REAL(defSpdSound_C, ReKi) - InitInp%AD%defPatm = REAL(defPatm_C, ReKi) - InitInp%AD%defPvap = REAL(defPvap_C, ReKi) - InitInp%AD%WtrDpth = REAL(WtrDpth_C, ReKi) - InitInp%AD%MSL2SWL = REAL(MSL2SWL_C, ReKi) - InitInp%storeHHVel = storeHHVel==1_c_int - InitInp%WrVTK = WrOutputsData%WrVTK - InitInp%WrVTK_Type = WrOutputsData%WrVTK_Type - InitInp%IW_InitInp%CompInflow = 1 ! Use InflowWind - ! setup rotors for AD -- interface only supports one rotor at present do iWT=1,Sim%NumTurbines InitInp%AD%rotors(iWT)%numBlades = Sim%WT(iWT)%NumBlades enddo + ! Flags and output data + InitInp%storeHHVel = storeHHVel==1_c_int + InitInp%WrVTK = WrOutputsData%WrVTK + InitInp%WrVTK_Type = WrOutputsData%WrVTK_Type + if (externFlowField) then + InitInp%IW_InitInp%CompInflow = 2 ! Use external instance of InflowWind + else + InitInp%IW_InitInp%CompInflow = 1 ! Use InflowWind + endif !---------------------------------------------------- ! Allocate input array u and corresponding InputTimes @@ -642,19 +660,19 @@ SUBROUTINE ADI_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileString ! u(1) inputs at t ! u(2) inputs at t - dt ! u(3) inputs at t - 2*dt ! quadratic only - allocate(ADI%u(InterpOrder+1), STAT=ErrStat2); if (Failed0("inputs" )) return - allocate(ADI%x(0:2), STAT=errStat2); if (Failed0("x" )) return - allocate(ADI%xd(0:2), STAT=errStat2); if (Failed0("xd" )) return - allocate(ADI%z(0:2), STAT=errStat2); if (Failed0("z" )) return - allocate(ADI%OtherState(0:2), STAT=errStat2); if (Failed0("OtherState")) return - call AllocAry( ADI%InputTimes, InterpOrder+1, "InputTimes", ErrStat2, ErrMsg2 ); if (Failed()) return + allocate(ADI%u(InterpOrder+1), STAT=ErrStat_F2); if (Failed0("inputs" )) return + allocate(ADI%x(0:2), STAT=ErrStat_F2); if (Failed0("x" )) return + allocate(ADI%xd(0:2), STAT=ErrStat_F2); if (Failed0("xd" )) return + allocate(ADI%z(0:2), STAT=ErrStat_F2); if (Failed0("z" )) return + allocate(ADI%OtherState(0:2), STAT=ErrStat_F2); if (Failed0("OtherState")) return + call AllocAry( ADI%InputTimes, InterpOrder+1, "InputTimes", ErrStat_F2, ErrMsg_F2 ); if (Failed()) return ! Call the main subroutine AeroDyn_Inflow_Init ! Sim%dT and InitInp are passed into AD_Init, all the rest are set by AD_Init ! ! NOTE: Pass u(1) only (this is empty and will be set inside Init). We will copy ! this to u(2) and u(3) afterwards - call ADI_Init( InitInp, ADI%u(1), ADI%p, ADI%x(STATE_CURR), ADI%xd(STATE_CURR), ADI%z(STATE_CURR), ADI%OtherState(STATE_CURR), ADI%y, ADI%m, Sim%dT, InitOutData, ErrStat2, ErrMsg2 ) + call ADI_Init( InitInp, ADI%u(1), ADI%p, ADI%x(STATE_CURR), ADI%xd(STATE_CURR), ADI%z(STATE_CURR), ADI%OtherState(STATE_CURR), ADI%y, ADI%m, Sim%dT, InitOutData, ErrStat_F2, ErrMsg_F2 ) if (Failed()) return @@ -670,18 +688,18 @@ SUBROUTINE ADI_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileString ! Set the interface meshes for motion inputs and loads output !------------------------------------------------------------- call SetupMotionLoadsInterfaceMeshes(); if (Failed()) return - ! setup meshes + ! setup VTK params if (WrOutputsData%WrVTK > 0_IntKi) then if (len_trim(OutVTKDir) <= 0) then OutVTKDir = 'vtk-ADI' endif - call setVTKParameters(WrOutputsData, Sim, ADI, ErrStat2, ErrMsg2, OutVTKDir) + call setVTKParameters(WrOutputsData, Sim, ADI, ErrStat_F2, ErrMsg_F2, OutVTKDir) if (Failed()) return endif ! write meshes for this rotor if (WrOutputsData%WrVTK > 0_IntKi) then do iWT=1,Sim%NumTurbines - call WrVTK_refMeshes(ADI%u(1)%AD%rotors(:),WrOutputsData%VTKRefPoint,ErrStat2,ErrMsg2) + call WrVTK_refMeshes(ADI%u(1)%AD%rotors(:),WrOutputsData%VTKRefPoint,ErrStat_F2,ErrMsg_F2) enddo if (Failed()) return endif @@ -704,7 +722,7 @@ SUBROUTINE ADI_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileString ! Since we may run correction steps, there are some things we don't want to do !------------------------------------------------------------- do i=2,InterpOrder+1 - call ADI_CopyInput (ADI%u(1), ADI%u(i), MESH_NEWCOPY, Errstat2, ErrMsg2) + call ADI_CopyInput (ADI%u(1), ADI%u(i), MESH_NEWCOPY, ErrStat_F2, ErrMsg_F2) if (Failed()) return enddo do i = 1, InterpOrder + 1 @@ -717,25 +735,25 @@ SUBROUTINE ADI_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileString ! copy of ADI inputs. AD_SetInputMotion will set this mesh. When CalcOutput is called, ! this data is used. When UpdateStates is called, this data is copied over to the ADI%u !------------------------------------------------------------- - call ADI_CopyInput (ADI%u(1), ADI_u, MESH_NEWCOPY, Errstat2, ErrMsg2) + call ADI_CopyInput (ADI%u(1), ADI_u, MESH_NEWCOPY, ErrStat_F2, ErrMsg_F2) if (Failed()) return !------------------------------------------------------------- ! Initial setup of other pieces of x,xd,z,OtherState !------------------------------------------------------------- - CALL ADI_CopyContState ( ADI%x( STATE_CURR), ADI%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL ADI_CopyDiscState ( ADI%xd( STATE_CURR), ADI%xd( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL ADI_CopyConstrState( ADI%z( STATE_CURR), ADI%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL ADI_CopyOtherState ( ADI%OtherState(STATE_CURR), ADI%OtherState(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyContState ( ADI%x( STATE_CURR), ADI%x( STATE_PRED), MESH_NEWCOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL ADI_CopyDiscState ( ADI%xd( STATE_CURR), ADI%xd( STATE_PRED), MESH_NEWCOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL ADI_CopyConstrState( ADI%z( STATE_CURR), ADI%z( STATE_PRED), MESH_NEWCOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL ADI_CopyOtherState ( ADI%OtherState(STATE_CURR), ADI%OtherState(STATE_PRED), MESH_NEWCOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return !------------------------------------------------------------- ! Setup the previous timestep copies of states !------------------------------------------------------------- - CALL ADI_CopyContState ( ADI%x( STATE_CURR), ADI%x( STATE_LAST), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL ADI_CopyDiscState ( ADI%xd( STATE_CURR), ADI%xd( STATE_LAST), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL ADI_CopyConstrState( ADI%z( STATE_CURR), ADI%z( STATE_LAST), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL ADI_CopyOtherState ( ADI%OtherState(STATE_CURR), ADI%OtherState(STATE_LAST), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyContState ( ADI%x( STATE_CURR), ADI%x( STATE_LAST), MESH_NEWCOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL ADI_CopyDiscState ( ADI%xd( STATE_CURR), ADI%xd( STATE_LAST), MESH_NEWCOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL ADI_CopyConstrState( ADI%z( STATE_CURR), ADI%z( STATE_LAST), MESH_NEWCOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL ADI_CopyOtherState ( ADI%OtherState(STATE_CURR), ADI%OtherState(STATE_LAST), MESH_NEWCOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return !------------------------------------------------- @@ -769,36 +787,36 @@ SUBROUTINE ADI_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileString ! destroy the InitInp and InitOutput - call ADI_DestroyInitInput( InitInp, Errstat2, ErrMsg2); if (Failed()) return - call ADI_DestroyInitOutput(InitOutData, Errstat2, ErrMsg2); if (Failed()) return + call ADI_DestroyInitInput( InitInp, ErrStat_F2, ErrMsg_F2); if (Failed()) return + call ADI_DestroyInitOutput(InitOutData, ErrStat_F2, ErrMsg_F2); if (Failed()) return - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) CONTAINS logical function Failed(Msg) character(*), optional :: Msg - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev + CALL SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + Failed = ErrStat_F >= AbortErrLev if (Failed) then - if (present(Msg)) ErrMsg = trim(ErrMsg)//' ('//trim(Msg)//')' + if (present(Msg)) ErrMsg_F = trim(ErrMsg_F)//' ('//trim(Msg)//')' call ClearTmpStorage() - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) endif end function Failed ! check for failed where /= 0 is fatal logical function Failed0(txt) character(*), intent(in) :: txt - if (ErrStat2 /= 0) then - ErrStat2 = ErrID_Fatal - ErrMsg2 = "Could not allocate "//trim(txt) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat_F2 /= 0) then + ErrStat_F2 = ErrID_Fatal + ErrMsg_F2 = "Could not allocate "//trim(txt) + call SetErrStat(ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName) endif - Failed0 = ErrStat >= AbortErrLev + Failed0 = ErrStat_F >= AbortErrLev if(Failed0) then call ClearTmpStorage() - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) endif end function Failed0 @@ -817,23 +835,6 @@ subroutine ValidateSetInputs(ErrStat3,ErrMsg3) return endif - ! VTK outputs - if ( WrOutputsData%WrVTK < 0_IntKi .or. WrOutputsData%WrVTK > 2_IntKi ) then - call SetErrStat(ErrID_Fatal,"WrVTK option for writing VTK visualization files must be [0: none, 1: init only, 2: animation]",ErrStat3,ErrMsg3,RoutineName) - return - endif - if ( WrOutputsData%WrVTK_Type > 0_IntKi ) then - if ( WrOutputsData%WrVTK_Type < 1_IntKi .or. WrOutputsData%WrVTK_Type > 3_IntKi ) then - call SetErrStat(ErrID_Fatal,"WrVTK_Type option for writing VTK visualization files must be [1: surface, 2: lines, 3: both]",ErrStat3,ErrMsg3,RoutineName) - return - endif - if (WrOutputsData%VTKHubRad < 0.0_SiKi) then - call SetErrStat(ErrID_Warn,"VTKHubRad for surface visualization of hub less than zero. Setting to zero.",ErrStat3,ErrMsg3,RoutineName) - WrOutputsData%VTKHubRad = 0.0_SiKi - endif - endif - - ! check fileFmt if ( WrOutputsData%fileFmt /= idFmtNone .and. WrOutputsData%fileFmt /= idFmtAscii .and. & WrOutputsData%fileFmt /= idFmtBinary .and. WrOutputsData%fileFmt /= idFmtBoth) then @@ -853,6 +854,31 @@ subroutine ValidateSetInputs(ErrStat3,ErrMsg3) call SetErrStat(ErrID_Warn,"Requested DT_Outs is not an integer multiple of DT. Changing DT_Outs to "//trim(Num2LStr(WrOutputsData%DT_Outs))//".",ErrStat3,ErrMsg3,RoutineName) endif endif + end subroutine ValidateSetInputs + !> Validate and set some of the outputs (values must be stored before here as some might be changed) + subroutine ValidateSetVTK(ErrStat3,ErrMsg3) + integer(IntKi), intent( out) :: ErrStat3 !< temporary error status + character(ErrMsgLen), intent( out) :: ErrMsg3 !< temporary error message + + ErrStat3 = ErrID_None + ErrMsg3 = "" + + ! VTK outputs + if ( WrOutputsData%WrVTK < 0_IntKi .or. WrOutputsData%WrVTK > 2_IntKi ) then + call SetErrStat(ErrID_Fatal,"WrVTK option for writing VTK visualization files must be [0: none, 1: init only, 2: animation]",ErrStat3,ErrMsg3,RoutineName) + return + endif + if ( WrOutputsData%WrVTK_Type > 0_IntKi ) then + if ( WrOutputsData%WrVTK_Type < 1_IntKi .or. WrOutputsData%WrVTK_Type > 3_IntKi ) then + call SetErrStat(ErrID_Fatal,"WrVTK_Type option for writing VTK visualization files must be [1: surface, 2: lines, 3: both]",ErrStat3,ErrMsg3,RoutineName) + return + endif + if (WrOutputsData%VTKHubRad < 0.0_SiKi) then + call SetErrStat(ErrID_Warn,"VTKHubRad for surface visualization of hub less than zero. Setting to zero.",ErrStat3,ErrMsg3,RoutineName) + WrOutputsData%VTKHubRad = 0.0_SiKi + endif + endif + if (WrOutputsData%WrVTK > 1_IntKi) then ! only if writing during simulation is requested (ignore init or no outputs) ! If a smaller timestep between outputs is requested than the simulation runs at, change to DT if (WrOutputsData%VTK_DT < Sim%dT) then @@ -866,30 +892,30 @@ subroutine ValidateSetInputs(ErrStat3,ErrMsg3) call SetErrStat(ErrID_Warn,"Requested VTK_DT is not an integer multiple of DT. Changing VTK_DT to "//trim(Num2LStr(WrOutputsData%VTK_DT))//".",ErrStat3,ErrMsg3,RoutineName) endif endif - end subroutine ValidateSetInputs + end subroutine ValidateSetVTK !> allocate data storage for file outputs subroutine SetupFileOutputs() ! time channel (stored but not counted as an output) - allocate(WrOutputsData%WriteOutputHdr(1), STAT=ErrStat2); if(Failed0("WriteOutputHdr")) return; - allocate(WrOutputsData%WriteOutputUnt(1), STAT=ErrStat2); if(Failed0("WriteOutputUnt")) return; - allocate(Sim%wt(1)%WriteOutput(1), STAT=ErrStat2); if(Failed0("WriteOutput")) return; + allocate(WrOutputsData%WriteOutputHdr(1), STAT=ErrStat_F2); if(Failed0("WriteOutputHdr")) return; + allocate(WrOutputsData%WriteOutputUnt(1), STAT=ErrStat_F2); if(Failed0("WriteOutputUnt")) return; + allocate(Sim%wt(1)%WriteOutput(1), STAT=ErrStat_F2); if(Failed0("WriteOutput")) return; WrOutputsData%WriteOutputHdr(1) = 'Time' WrOutputsData%WriteOutputUnt(1) = '(s)' WrOutputsData%nDvrOutputs = 0 ! assemble all headers - call concatOutputHeaders(WrOutputsData%WriteOutputHdr, WrOutputsData%WriteOutputUnt, InitOutData%WriteOutputHdr, InitOutData%WriteOutputUnt, errStat2, errMsg2); if(Failed()) return + call concatOutputHeaders(WrOutputsData%WriteOutputHdr, WrOutputsData%WriteOutputUnt, InitOutData%WriteOutputHdr, InitOutData%WriteOutputUnt, ErrStat_F2, ErrMsg_F2); if(Failed()) return ! allocate output file handling and set formats WrOutputsData%outFmt = "ES15.8E2" WrOutputsData%delim = TAB WrOutputsData%AD_ver = InitOutData%Ver - allocate(WrOutputsData%unOutFile(Sim%numTurbines), STAT=ErrStat2); if(Failed0("unOutFile")) return; + allocate(WrOutputsData%unOutFile(Sim%numTurbines), STAT=ErrStat_F2); if(Failed0("unOutFile")) return; WrOutputsData%unOutFile = -1 !FIXME: number of timesteps is incorrect! - call Dvr_InitializeOutputs(Sim%numTurbines, WrOutputsData, Sim%numSteps-1, ErrStat2, ErrMsg2); if(Failed()) return - call Dvr_WriteOutputs(n_Global+1, ADI%InputTimes(INPUT_CURR), Sim, WrOutputsData, ADI%y, errStat2, errMsg2); if(Failed()) return + call Dvr_InitializeOutputs(Sim%numTurbines, WrOutputsData, Sim%numSteps-1, ErrStat_F2, ErrMsg_F2); if(Failed()) return + call Dvr_WriteOutputs(n_Global+1, ADI%InputTimes(INPUT_CURR), Sim, WrOutputsData, ADI%y, ErrStat_F2, ErrMsg_F2); if(Failed()) return end subroutine SetupFileOutputs @@ -898,6 +924,7 @@ end subroutine SetupFileOutputs subroutine ShowPassedData() character(1) :: TmpFlag integer :: i,j + character(IntfStrLen) :: tmpPath call WrSCr("") call WrScr("-----------------------------------------------------------") call WrScr("Interface debugging: Variables passed in through interface") @@ -908,21 +935,19 @@ subroutine ShowPassedData() call WrScr(" ADinputFilePassed_C "//TmpFlag ) call WrScr(" ADinputFileString_C (ptr addr) "//trim(Num2LStr(LOC(ADinputFileString_C))) ) call WrScr(" ADinputFileStringLength_C "//trim(Num2LStr( ADinputFileStringLength_C )) ) + if (ADinputFilePassed==0_c_int) then + i = index(ADinputFileString, char(0)) ! skip anything after c_null_char + call WrScr(" ADinputFileString_C "//ADinputFileString(1:i)) + endif TmpFlag="F"; if (IfWinputFilePassed==1_c_int) TmpFlag="T" call WrScr(" IfWinputFilePassed_C "//TmpFlag ) call WrScr(" IfWinputFileString_C (ptr addr)"//trim(Num2LStr(LOC(IfWinputFileString_C))) ) call WrScr(" IfWinputFileStringLength_C "//trim(Num2LStr( IfWinputFileStringLength_C )) ) + if (IfWinputFilePassed==0_c_int) then + i = index(IfWinputFileString, char(0)) ! skip anything after c_null_char + call WrScr(" IfWinputFileString_C "//trim(IfWinputFileString(1:i))) + endif call WrScr(" OutRootName "//trim(OutRootName) ) - call WrScr(" OutVTKDir "//trim(OutVTKDir) ) - call WrScr(" Environment variables") - call WrScr(" gravity_C "//trim(Num2LStr( gravity_C )) ) - call WrScr(" defFldDens_C "//trim(Num2LStr( defFldDens_C )) ) - call WrScr(" defKinVisc_C "//trim(Num2LStr( defKinVisc_C )) ) - call WrScr(" defSpdSound_C "//trim(Num2LStr( defSpdSound_C )) ) - call WrScr(" defPatm_C "//trim(Num2LStr( defPatm_C )) ) - call WrScr(" defPvap_C "//trim(Num2LStr( defPvap_C )) ) - call WrScr(" WtrDpth_C "//trim(Num2LStr( WtrDpth_C )) ) - call WrScr(" MSL2SWL_C "//trim(Num2LStr( MSL2SWL_C )) ) call WrScr(" Interpolation") call WrScr(" InterpOrder_C "//trim(Num2LStr( InterpOrder_C )) ) call WrScr(" Time variables") @@ -934,11 +959,10 @@ subroutine ShowPassedData() call WrScr(" Flags") TmpFlag="F"; if (storeHHVel==1_c_int) TmpFlag="T" call WrScr(" storeHHVel "//TmpFlag ) - call WrScr(" WrVTK_in "//trim(Num2LStr( WrVTK_in )) ) - call WrScr(" WrVTK_inType "//trim(Num2LStr( WrVTK_inType )) ) - call WrScr(" WrVTK_inDT "//trim(Num2LStr( WrVTK_inDT )) ) call WrScr("-----------------------------------------------------------") end subroutine ShowPassedData +!FIXME: add a ShowReturnData here! + !> This subroutine sets the interface meshes to map to the input motions to the AD !! meshes @@ -955,8 +979,8 @@ subroutine SetupMotionLoadsInterfaceMeshes() ! NOTE: storing mappings in 2D this way may increase memory usage slightly if one turbine has many more blades than another. However ! the speed an memory penalties are negligible, so I don't see much reason to change that at this point. - allocate(Map_BldStrMotion_2_AD_Blade( maxBlades, Sim%NumTurbines), STAT=ErrStat2); if (Failed0('Map_BldStrMotion_2_AD_Blade' )) return - allocate(Map_AD_BldLoad_P_2_BldStrLoad(maxBlades, Sim%NumTurbines), STAT=ErrStat2); if (Failed0('Map_AD_BldLoad_P_2_BldStrLoad')) return + allocate(Map_BldStrMotion_2_AD_Blade( maxBlades, Sim%NumTurbines), STAT=ErrStat_F2); if (Failed0('Map_BldStrMotion_2_AD_Blade' )) return + allocate(Map_AD_BldLoad_P_2_BldStrLoad(maxBlades, Sim%NumTurbines), STAT=ErrStat_F2); if (Failed0('Map_AD_BldLoad_P_2_BldStrLoad')) return ! Step through all turbine rotors do iWT=1,Sim%NumTurbines @@ -966,32 +990,32 @@ subroutine SetupMotionLoadsInterfaceMeshes() do iBlade=1,Sim%WT(iWT)%NumBlades !------------------------------------------------------------- ! Load mesh for blades - CALL MeshCopy( SrcMesh = BldStrMotionMesh(iWT)%Mesh(iBlade) ,& - DestMesh = BldStrLoadMesh(iWT)%Mesh(iBlade) ,& + CALL MeshCopy( SrcMesh = BldStrMotionMesh(iWT)%BldMesh(iBlade) ,& + DestMesh = BldStrLoadMesh(iWT)%BldMesh(iBlade) ,& CtrlCode = MESH_SIBLING ,& IOS = COMPONENT_OUTPUT ,& - ErrStat = ErrStat2 ,& - ErrMess = ErrMsg2 ,& + ErrStat = ErrStat_F2 ,& + ErrMess = ErrMsg_F2 ,& Force = .TRUE. ,& Moment = .TRUE. ) if(Failed()) return - BldStrMotionMesh(iWT)%Mesh(iBlade)%RemapFlag = .FALSE. + BldStrMotionMesh(iWT)%BldMesh(iBlade)%RemapFlag = .FALSE. ! Temp mesh for load transfer - CALL MeshCopy( SrcMesh = BldStrLoadMesh(iWT)%Mesh(iBlade) ,& - DestMesh = BldStrLoadMesh_tmp(iWT)%Mesh(iBlade) ,& + CALL MeshCopy( SrcMesh = BldStrLoadMesh(iWT)%BldMesh(iBlade) ,& + DestMesh = BldStrLoadMesh_tmp(iWT)%BldMesh(iBlade) ,& CtrlCode = MESH_COUSIN ,& IOS = COMPONENT_OUTPUT ,& - ErrStat = ErrStat2 ,& - ErrMess = ErrMsg2 ,& + ErrStat = ErrStat_F2 ,& + ErrMess = ErrMsg_F2 ,& Force = .TRUE. ,& Moment = .TRUE. ) if(Failed()) return - BldStrLoadMesh_tmp(iWT)%Mesh(iBlade)%RemapFlag = .FALSE. + BldStrLoadMesh_tmp(iWT)%BldMesh(iBlade)%RemapFlag = .FALSE. ! For checking the mesh ! Note: CU is is output unit (platform dependent). - if (DebugLevel >= 4) call MeshPrintInfo( CU, BldStrLoadMesh(iWT)%Mesh(iBlade), MeshName='BldStrLoadMesh'//trim(Num2LStr(iWT))//'_'//trim(Num2LStr(iBlade)) ) + if (DebugLevel >= 4) call MeshPrintInfo( CU, BldStrLoadMesh(iWT)%BldMesh(iBlade), MeshName='BldStrLoadMesh'//trim(Num2LStr(iWT))//'_'//trim(Num2LStr(iBlade)) ) enddo ! iBlade enddo ! iWT end subroutine SetupMotionLoadsInterfaceMeshes @@ -1011,8 +1035,8 @@ subroutine MapLoadsInterfaceMeshes() !------------------------------------------------------------- ! Set the mapping meshes ! blades - call MeshMapCreate( BldStrMotionMesh(iWT)%Mesh(iBlade), ADI%u(1)%AD%rotors(iWT)%BladeMotion(iBlade), Map_BldStrMotion_2_AD_Blade(iBlade, iWT), ErrStat2, ErrMsg2 ); if(Failed('Struct to blade '//trim(Num2LStr(iBlade)))) return - call MeshMapCreate( ADI%y%AD%rotors(iWT)%BladeLoad(iBlade), BldStrLoadMesh(iWT)%Mesh(iBlade), Map_AD_BldLoad_P_2_BldStrLoad(iBlade, iWT), ErrStat2, ErrMsg2 ); if(Failed('Blade '//trim(Num2LStr(iBlade))//' to struct')) return + call MeshMapCreate( BldStrMotionMesh(iWT)%BldMesh(iBlade), ADI%u(1)%AD%rotors(iWT)%BladeMotion(iBlade), Map_BldStrMotion_2_AD_Blade(iBlade, iWT), ErrStat_F2, ErrMsg_F2 ); if(Failed('Struct to blade '//trim(Num2LStr(iBlade)))) return + call MeshMapCreate( ADI%y%AD%rotors(iWT)%BladeLoad(iBlade), BldStrLoadMesh(iWT)%BldMesh(iBlade), Map_AD_BldLoad_P_2_BldStrLoad(iBlade, iWT), ErrStat_F2, ErrMsg_F2 ); if(Failed('Blade '//trim(Num2LStr(iBlade))//' to struct')) return enddo ! iBlade enddo ! iWT end subroutine MapLoadsInterfaceMeshes @@ -1050,54 +1074,6 @@ end subroutine SetDiskAvgPoints END SUBROUTINE ADI_C_Init - -!!=============================================================================================================== -!!--------------------------------------------- AeroDyn ReInit--------------------------------------------------- -!!=============================================================================================================== -!!TODO: finish this routine so it is usable if we need re-init capability for coupling -!SUBROUTINE ADI_C_ReInit( DT_C, TMax_C, & -! ErrStat_C, ErrMsg_C) BIND (C, NAME='ADI_C_ReInit') -! implicit none -!#ifndef IMPLICIT_DLLEXPORT -!!DEC$ ATTRIBUTES DLLEXPORT :: ADI_C_ReInit -!!GCC$ ATTRIBUTES DLLEXPORT :: ADI_C_ReInit -!#endif -! -! real(c_double), intent(in ) :: DT_C !< Timestep used with AD for stepping forward from t to t+dt. Must be constant. -! real(c_double), intent(in ) :: TMax_C !< Maximum time for simulation (used to set arrays for wave kinematics) -! integer(c_int), intent( out) :: ErrStat_C !< Error status -! character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) !< Error message (C_NULL_CHAR terminated) -! -! integer(IntKi) :: ErrStat !< aggregated error message -! character(ErrMsgLen) :: ErrMsg !< aggregated error message -! integer(IntKi) :: ErrStat2 !< temporary error status from a call -! character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call -! character(*), parameter :: RoutineName = 'ADI_C_ReInit' !< for error handling -! -! ! Initialize error handling -! ErrStat = ErrID_None -! ErrMsg = "" -! -!ErrStat = ErrID_Fatal -!ErrMsg = "AeroDyn_Inflo_C_ReInit is not currently functional. Aborting." -!call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) -! -! call ADI_ReInit(ADI%p, ADI%x(STATE_CURR), ADI%xd(STATE_CURR), ADI%z(STATE_CURR), ADI%OtherState(STATE_CURR), ADI%m, Sim%dT, errStat2, errMsg2) -! if (Failed()) return -! -! call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) -! -!CONTAINS -! logical function Failed() -! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) -! Failed = ErrStat >= AbortErrLev -! if (Failed) then -! call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) -! endif -! end function Failed -!END SUBROUTINE ADI_C_ReInit - - !=============================================================================================================== !--------------------------------------------- AeroDyn CalcOutput --------------------------------------------- !=============================================================================================================== @@ -1117,23 +1093,23 @@ SUBROUTINE ADI_C_CalcOutput(Time_C, & ! Local variables real(DbKi) :: Time - integer(IntKi) :: ErrStat !< aggregated error status - character(ErrMsgLen) :: ErrMsg !< aggregated error message - integer(IntKi) :: ErrStat2 !< temporary error status from a call - character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call + integer(IntKi) :: ErrStat_F !< aggregated error status + character(ErrMsgLen) :: ErrMsg_F !< aggregated error message + integer(IntKi) :: ErrStat_F2 !< temporary error status from a call + character(ErrMsgLen) :: ErrMsg_F2 !< temporary error message from a call character(*), parameter :: RoutineName = 'ADI_C_CalcOutput' !< for error handling ! Initialize error handling - ErrStat = ErrID_None - ErrMsg = "" + ErrStat_F = ErrID_None + ErrMsg_F = "" ! Convert the inputs from C to Fortrn Time = REAL(Time_C,DbKi) ! Call the main subroutine ADI_CalcOutput to get the resulting forces and moments at time T - call ADI_CopyInput (ADI_u, ADI%u(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) ! copy new inputs over + call ADI_CopyInput (ADI_u, ADI%u(1), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2) ! copy new inputs over if (Failed()) return - CALL ADI_CalcOutput( Time, ADI%u(1), ADI%p, ADI%x(STATE_CURR), ADI%xd(STATE_CURR), ADI%z(STATE_CURR), ADI%OtherState(STATE_CURR), ADI%y, ADI%m, ErrStat2, ErrMsg2 ) + CALL ADI_CalcOutput( Time, ADI%u(1), ADI%p, ADI%x(STATE_CURR), ADI%xd(STATE_CURR), ADI%z(STATE_CURR), ADI%OtherState(STATE_CURR), ADI%y, ADI%m, ErrStat_F2, ErrMsg_F2 ) if (Failed()) return ! Get the output channel info out of y @@ -1144,33 +1120,36 @@ SUBROUTINE ADI_C_CalcOutput(Time_C, & !------------------------------------------------------- ! Write VTK if requested (animation=2) if (WrOutputsData%WrVTK > 1_IntKi) then - ! Check if writing this step (note this may overwrite if we rerun a step in a correction loop) - if ( mod( n_Global, WrOutputsData%n_VTKTime ) == 0 ) THEN - ! increment the current VTK output number if not a correction step, otherwise overwrite previous - if (.not. EqualRealNos( real(Time,DbKi), InputTimePrev_Calc ) ) then - n_VTK = n_VTK + 1_IntKi ! Increment for this write - endif - call WrVTK_Meshes(ADI%u(1)%AD%rotors(:),(/0.0_SiKi,0.0_SiKi,0.0_SiKi/),ErrStat2,ErrMsg2) + ! only write on desired time interval (same logic used in c-binding modules) + VTKn_Global = nint(Time_C / WrOutputsData%VTK_dt ) + if (VTKn_Global /= VTKn_last) then ! already wrote this one + VTKn_last = VTKn_Global ! store the current number to make sure we don't write it twice + call WrVTK_Meshes(ADI%u(1)%AD%rotors(:),(/0.0_SiKi,0.0_SiKi,0.0_SiKi/),ErrStat_F2,ErrMsg_F2) + if (Failed()) return endif endif if (WrOutputsData%fileFmt > idFmtNone) then !FIXME: need some way to overwrite the correction timesteps (for text file)! - call Dvr_WriteOutputs(n_Global+1, ADI%InputTimes(INPUT_CURR), Sim, WrOutputsData, ADI%y, errStat2, errMsg2); if(Failed()) return + call Dvr_WriteOutputs(n_Global+1, ADI%InputTimes(INPUT_CURR), Sim, WrOutputsData, ADI%y, ErrStat_F2, ErrMsg_F2); if(Failed()) return endif ! Set error status - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) ! Store info what time we just ran calcs for InputTimePrev_Calc = Time CONTAINS logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - if (Failed) call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + CALL SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + Failed = ErrStat_F >= AbortErrLev + if (Failed) then + call ClearTmpStorage() + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) + endif end function Failed +!FIXME: add a showpassed/return routine END SUBROUTINE ADI_C_CalcOutput !=============================================================================================================== @@ -1196,15 +1175,15 @@ SUBROUTINE ADI_C_UpdateStates( Time_C, TimeNext_C, & ! Local variables logical :: CorrectionStep ! if we are repeating a timestep in UpdateStates, don't update the inputs array - integer(IntKi) :: ErrStat !< aggregated error status - character(ErrMsgLen) :: ErrMsg !< aggregated error message - integer(IntKi) :: ErrStat2 !< temporary error status from a call - character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call + integer(IntKi) :: ErrStat_F !< aggregated error status + character(ErrMsgLen) :: ErrMsg_F !< aggregated error message + integer(IntKi) :: ErrStat_F2 !< temporary error status from a call + character(ErrMsgLen) :: ErrMsg_F2 !< temporary error message from a call character(*), parameter :: RoutineName = 'ADI_C_UpdateStates' !< for error handling ! Initialize error handling - ErrStat = ErrID_None - ErrMsg = "" + ErrStat_F = ErrID_None + ErrMsg_F = "" CorrectionStep = .false. @@ -1246,36 +1225,36 @@ SUBROUTINE ADI_C_UpdateStates( Time_C, TimeNext_C, & ! Step back to previous state because we are doing a correction step ! -- repeating the T -> T+dt update with new inputs at T+dt ! -- the STATE_CURR contains states at T+dt from the previous call, so revert those - CALL ADI_CopyContState (ADI%x( STATE_LAST), ADI%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL ADI_CopyDiscState (ADI%xd( STATE_LAST), ADI%xd( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL ADI_CopyConstrState (ADI%z( STATE_LAST), ADI%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL ADI_CopyOtherState (ADI%OtherState(STATE_LAST), ADI%OtherState(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyContState (ADI%x( STATE_LAST), ADI%x( STATE_CURR), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL ADI_CopyDiscState (ADI%xd( STATE_LAST), ADI%xd( STATE_CURR), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL ADI_CopyConstrState (ADI%z( STATE_LAST), ADI%z( STATE_CURR), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL ADI_CopyOtherState (ADI%OtherState(STATE_LAST), ADI%OtherState(STATE_CURR), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return else ! Cycle inputs back one timestep since we are moving forward in time. if (InterpOrder>1) then ! quadratic, so keep the old time - call ADI_CopyInput( ADI%u(INPUT_CURR), ADI%u(INPUT_LAST), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ADI_CopyInput( ADI%u(INPUT_CURR), ADI%u(INPUT_LAST), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return endif ! Move inputs from previous t+dt (now t) to t - call ADI_CopyInput( ADI%u(INPUT_PRED), ADI%u(INPUT_CURR), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call ADI_CopyInput( ADI%u(INPUT_PRED), ADI%u(INPUT_CURR), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return endif ! Set copy the current state over to the predicted state for sending to UpdateStates ! -- The STATE_PREDicted will get updated in the call. ! -- The UpdateStates routine expects this to contain states at T at the start of the call (history not passed in) - CALL ADI_CopyContState (ADI%x( STATE_CURR), ADI%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL ADI_CopyDiscState (ADI%xd( STATE_CURR), ADI%xd( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL ADI_CopyConstrState (ADI%z( STATE_CURR), ADI%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL ADI_CopyOtherState (ADI%OtherState(STATE_CURR), ADI%OtherState(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyContState (ADI%x( STATE_CURR), ADI%x( STATE_PRED), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL ADI_CopyDiscState (ADI%xd( STATE_CURR), ADI%xd( STATE_PRED), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL ADI_CopyConstrState (ADI%z( STATE_CURR), ADI%z( STATE_PRED), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL ADI_CopyOtherState (ADI%OtherState(STATE_CURR), ADI%OtherState(STATE_PRED), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return ! Copy newinputs for time u(INPUT_PRED) - call ADI_CopyInput (ADI_u, ADI%u(INPUT_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + call ADI_CopyInput (ADI_u, ADI%u(INPUT_PRED), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2) if (Failed()) return ! Call the main subroutine ADI_UpdateStates to get the velocities - CALL ADI_UpdateStates( ADI%InputTimes(INPUT_CURR), n_Global, ADI%u, ADI%InputTimes, ADI%p, ADI%x(STATE_PRED), ADI%xd(STATE_PRED), ADI%z(STATE_PRED), ADI%OtherState(STATE_PRED), ADI%m, ErrStat2, ErrMsg2 ) + CALL ADI_UpdateStates( ADI%InputTimes(INPUT_CURR), n_Global, ADI%u, ADI%InputTimes, ADI%p, ADI%x(STATE_PRED), ADI%xd(STATE_PRED), ADI%z(STATE_PRED), ADI%OtherState(STATE_PRED), ADI%m, ErrStat_F2, ErrMsg_F2 ) if (Failed()) return @@ -1285,25 +1264,28 @@ SUBROUTINE ADI_C_UpdateStates( Time_C, TimeNext_C, & ! move current state at T to previous state at T-dt ! -- STATE_LAST now contains info at time T ! -- this allows repeating the T --> T+dt update - CALL ADI_CopyContState (ADI%x( STATE_CURR), ADI%x( STATE_LAST), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL ADI_CopyDiscState (ADI%xd( STATE_CURR), ADI%xd( STATE_LAST), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL ADI_CopyConstrState (ADI%z( STATE_CURR), ADI%z( STATE_LAST), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL ADI_CopyOtherState (ADI%OtherState(STATE_CURR), ADI%OtherState(STATE_LAST), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyContState (ADI%x( STATE_CURR), ADI%x( STATE_LAST), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL ADI_CopyDiscState (ADI%xd( STATE_CURR), ADI%xd( STATE_LAST), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL ADI_CopyConstrState (ADI%z( STATE_CURR), ADI%z( STATE_LAST), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL ADI_CopyOtherState (ADI%OtherState(STATE_CURR), ADI%OtherState(STATE_LAST), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return ! Update the predicted state as the new current state ! -- we have now advanced from T to T+dt. This allows calling with CalcOuput to get the outputs at T+dt - CALL ADI_CopyContState (ADI%x( STATE_PRED), ADI%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL ADI_CopyDiscState (ADI%xd( STATE_PRED), ADI%xd( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL ADI_CopyConstrState (ADI%z( STATE_PRED), ADI%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL ADI_CopyOtherState (ADI%OtherState(STATE_PRED), ADI%OtherState(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL ADI_CopyContState (ADI%x( STATE_PRED), ADI%x( STATE_CURR), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL ADI_CopyDiscState (ADI%xd( STATE_PRED), ADI%xd( STATE_CURR), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL ADI_CopyConstrState (ADI%z( STATE_PRED), ADI%z( STATE_CURR), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL ADI_CopyOtherState (ADI%OtherState(STATE_PRED), ADI%OtherState(STATE_CURR), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) contains logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - if (Failed) call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + CALL SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + Failed = ErrStat_F >= AbortErrLev + if (Failed) then + call ClearTmpStorage() + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) + endif end function Failed END SUBROUTINE ADI_C_UpdateStates @@ -1325,15 +1307,15 @@ SUBROUTINE ADI_C_End(ErrStat_C,ErrMsg_C) BIND (C, NAME='ADI_C_End') integer(IntKi) :: i !< generic loop counter character(10) :: sWT !< string for turbine integer(IntKi) :: iWT !< current wind turbine - integer :: ErrStat !< aggregated error status - character(ErrMsgLen) :: ErrMsg !< aggregated error message - integer :: ErrStat2 !< temporary error status from a call - character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call + integer :: ErrStat_F !< aggregated error status + character(ErrMsgLen) :: ErrMsg_F !< aggregated error message + integer :: ErrStat_F2 !< temporary error status from a call + character(ErrMsgLen) :: ErrMsg_F2 !< temporary error message from a call character(*), parameter :: RoutineName = 'ADI_C_End' !< for error handling ! Initialize error handling - ErrStat = ErrID_None - ErrMsg = "" + ErrStat_F = ErrID_None + ErrMsg_F = "" ! Finalize output file if (WrOutputsData%fileFmt > idFmtNone .and. allocated(WrOutputsData%unOutFile)) then @@ -1350,8 +1332,8 @@ SUBROUTINE ADI_C_End(ErrStat_C,ErrMsg_C) BIND (C, NAME='ADI_C_End') else sWT = '' endif - call WrBinFAST(trim(WrOutputsData%Root)//trim(sWT)//'.outb', FileFmtID_ChanLen_In, 'ADI_C_Library', WrOutputsData%WriteOutputHdr, WrOutputsData%WriteOutputUnt, (/0.0_DbKi, Sim%dT/), WrOutputsData%storage(:,:,iWT), errStat2, errMsg2) - call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + call WrBinFAST(trim(WrOutputsData%Root)//trim(sWT)//'.outb', FileFmtID_ChanLen_In, 'ADI_C_Library', WrOutputsData%WriteOutputHdr, WrOutputsData%WriteOutputUnt, (/0.0_DbKi, Sim%dT/), WrOutputsData%storage(:,:,iWT), ErrStat_F2, ErrMsg_F2) + call SetErrStat(ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName) enddo endif end if @@ -1362,8 +1344,8 @@ SUBROUTINE ADI_C_End(ErrStat_C,ErrMsg_C) BIND (C, NAME='ADI_C_End') ! or AD_C_End got called before Init. We don't want a segfault, so check ! for allocation. if (allocated(ADI%u)) then - call ADI_End( ADI%u(:), ADI%p, ADI%x(STATE_CURR), ADI%xd(STATE_CURR), ADI%z(STATE_CURR), ADI%OtherState(STATE_CURR), ADI%y, ADI%m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call ADI_End( ADI%u(:), ADI%p, ADI%x(STATE_CURR), ADI%xd(STATE_CURR), ADI%z(STATE_CURR), ADI%OtherState(STATE_CURR), ADI%y, ADI%m, ErrStat_F2, ErrMsg_F2 ) + call SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) endif ! NOTE: ADI_End only takes 1 instance of u, not the array. So extra @@ -1372,25 +1354,13 @@ SUBROUTINE ADI_C_End(ErrStat_C,ErrMsg_C) BIND (C, NAME='ADI_C_End') ! or some other code using the c-bindings. if (allocated(ADI%u)) then do i=2,size(ADI%u) - call ADI_DestroyInput( ADI%u(i), ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call ADI_DestroyInput( ADI%u(i), ErrStat_F2, ErrMsg_F2 ) + call SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) enddo if (allocated(ADI%u)) deallocate(ADI%u) endif - ! Destroy any other copies of states (rerun on (STATE_CURR) is ok) - call ADI_DestroyContState( ADI%x( STATE_LAST), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call ADI_DestroyContState( ADI%x( STATE_CURR), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call ADI_DestroyContState( ADI%x( STATE_PRED), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call ADI_DestroyDiscState( ADI%xd( STATE_LAST), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call ADI_DestroyDiscState( ADI%xd( STATE_CURR), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call ADI_DestroyDiscState( ADI%xd( STATE_PRED), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call ADI_DestroyConstrState( ADI%z( STATE_LAST), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call ADI_DestroyConstrState( ADI%z( STATE_CURR), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call ADI_DestroyConstrState( ADI%z( STATE_PRED), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call ADI_DestroyOtherState( ADI%OtherState(STATE_LAST), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call ADI_DestroyOtherState( ADI%OtherState(STATE_CURR), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call ADI_DestroyOtherState( ADI%OtherState(STATE_PRED), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call ADI_DestroyData(ADI, ErrStat_F2, ErrMsg_F2 ); call SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) ! if deallocate other items now !if (allocated(InputTimes)) deallocate(InputTimes) @@ -1398,7 +1368,7 @@ SUBROUTINE ADI_C_End(ErrStat_C,ErrMsg_C) BIND (C, NAME='ADI_C_End') ! Clear out mesh related data storage call ClearTmpStorage() - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) END SUBROUTINE ADI_C_End @@ -1440,16 +1410,16 @@ subroutine ADI_C_SetupRotor(iWT_c, TurbineIsHAWT_c, TurbOrigin_C, & integer(IntKi) :: iWT !< current turbine integer(IntKi) :: iBlade !< current blade logical :: TurbineIsHAWT !< true for HAWT, false for VAWT - integer(IntKi) :: ErrStat !< aggregated error messagNumBlades_ee - character(ErrMsgLen) :: ErrMsg !< aggregated error message - integer(IntKi) :: ErrStat2 !< temporary error status from a call - character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call + integer(IntKi) :: ErrStat_F !< aggregated error messagNumBlades_ee + character(ErrMsgLen) :: ErrMsg_F !< aggregated error message + integer(IntKi) :: ErrStat_F2 !< temporary error status from a call + character(ErrMsgLen) :: ErrMsg_F2 !< temporary error message from a call integer(IntKi) :: i,j,k !< generic index variables character(*), parameter :: RoutineName = 'ADI_C_SetupRotor' !< for error handling ! Initialize error handling - ErrStat = ErrID_None - ErrMsg = "" + ErrStat_F = ErrID_None + ErrMsg_F = "" ! For debugging the interface: @@ -1477,8 +1447,8 @@ subroutine ADI_C_SetupRotor(iWT_c, TurbineIsHAWT_c, TurbOrigin_C, & endif - call AllocAry(InitInp%AD%rotors(iWT)%BladeRootPosition, 3, Sim%WT(iWT)%NumBlades, 'BldRootPos', errStat2, errMsg2 ); if (Failed()) return - call AllocAry(InitInp%AD%rotors(iWT)%BladeRootOrientation, 3, 3, Sim%WT(iWT)%NumBlades, 'BldRootOri', errStat2, errMsg2 ); if (Failed()) return + call AllocAry(InitInp%AD%rotors(iWT)%BladeRootPosition, 3, Sim%WT(iWT)%NumBlades, 'BldRootPos', ErrStat_F2, ErrMsg_F2 ); if (Failed()) return + call AllocAry(InitInp%AD%rotors(iWT)%BladeRootOrientation, 3, 3, Sim%WT(iWT)%NumBlades, 'BldRootOri', ErrStat_F2, ErrMsg_F2 ); if (Failed()) return InitInp%AD%rotors(iWT)%originInit = Sim%WT(iWT)%OriginInit(1:3) InitInp%AD%rotors(iWT)%HubPosition = real(HubPos_C(1:3),ReKi) + Sim%WT(iWT)%OriginInit(1:3) InitInp%AD%rotors(iWT)%HubOrientation = reshape( real(HubOri_C(1:9),R8Ki), (/3,3/) ) @@ -1509,8 +1479,8 @@ subroutine ADI_C_SetupRotor(iWT_c, TurbineIsHAWT_c, TurbOrigin_C, & ! side. Will validate this against what AD reads from the initialization info. NumMeshPts(iWT) = int(NumMeshPts_C, IntKi) if (NumMeshPts(iWT) < 1) then - ErrStat2 = ErrID_Fatal - ErrMsg2 = "At least one node point must be specified" + ErrStat_F2 = ErrID_Fatal + ErrMsg_F2 = "At least one node point must be specified" if (Failed()) return endif @@ -1520,30 +1490,31 @@ subroutine ADI_C_SetupRotor(iWT_c, TurbineIsHAWT_c, TurbOrigin_C, & call SetupMotionMesh() ! Set error status - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) contains logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev + CALL SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + Failed = ErrStat_F >= AbortErrLev if (Failed) then call ClearTmpStorage() - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) endif end function Failed ! check for failed where /= 0 is fatal logical function Failed0(txt) character(*), intent(in) :: txt - if (ErrStat2 /= 0) then - ErrStat2 = ErrID_Fatal - ErrMsg2 = "Could not allocate "//trim(txt) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + if (ErrStat_F2 /= 0) then + ErrStat_F2 = ErrID_Fatal + ErrMsg_F2 = "Could not allocate "//trim(txt) + call SetErrStat(ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName) endif - Failed0 = ErrStat >= AbortErrLev + Failed0 = ErrStat_F >= AbortErrLev if(Failed0) then call ClearTmpStorage() - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) endif end function Failed0 @@ -1609,8 +1580,8 @@ subroutine CheckMeshPts(iWT) integer(IntKi), intent(in) :: iWT do i=1,size(MeshPtToBladeNum_C) if ((MeshPtToBladeNum_C(i) < 1_c_int) .or. (MeshPtToBladeNum_C(i) > int(Sim%WT(iWT)%NumBlades))) then - ErrStat2=ErrID_Fatal - ErrMsg2 = 'Mesh Point '//trim(Num2LStr(i))//' assigned to invalid blade '//trim(Num2LStr(MeshPtToBladeNum_C(i)))//' on rotor '//trim(Num2LStr(iWT)) + ErrStat_F2=ErrID_Fatal + ErrMsg_F2 = 'Mesh Point '//trim(Num2LStr(i))//' assigned to invalid blade '//trim(Num2LStr(MeshPtToBladeNum_C(i)))//' on rotor '//trim(Num2LStr(iWT)) if (Failed()) return endif enddo @@ -1626,10 +1597,10 @@ subroutine SetupMotionMesh() !------------------------------------------------------------- StrucPts_2_Bld_Map(iWT)%NumBlades = Sim%WT(iWT)%NumBlades - call AllocAry(StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade, Sim%WT(iWT)%NumBlades, "NumMeshPtsPerBlade", ErrStat2, ErrMsg2 ); if (Failed()) return - call AllocAry( StrucPts_2_Bld_Map(iWT)%MeshPt_2_BladeNum, NumMeshPts(iWT), "MeshPt_2_BladeNum", ErrStat2, ErrMsg2 ); if (Failed()) return + call AllocAry(StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade, Sim%WT(iWT)%NumBlades, "NumMeshPtsPerBlade", ErrStat_F2, ErrMsg_F2 ); if (Failed()) return + call AllocAry( StrucPts_2_Bld_Map(iWT)%MeshPt_2_BladeNum, NumMeshPts(iWT), "MeshPt_2_BladeNum", ErrStat_F2, ErrMsg_F2 ); if (Failed()) return - allocate(StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt( Sim%WT(iWT)%NumBlades ), STAT=ErrStat2); if (Failed0('StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt' )) return + allocate(StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt( Sim%WT(iWT)%NumBlades ), STAT=ErrStat_F2); if (Failed0('StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt' )) return ! Calculate the number of mesh points per blade do i=1,Sim%WT(iWT)%NumBlades @@ -1646,7 +1617,7 @@ subroutine SetupMotionMesh() ! Allocate remaining components of StrucPts_2_Bld_Map based on the number of mesh points per blade do i=1,Sim%WT(iWT)%NumBlades - call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeNodeToMeshPoint", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeNodeToMeshPoint", ErrStat_F2, ErrMsg_F2); if (Failed()) return enddo do i=1,Sim%WT(iWT)%NumBlades @@ -1660,13 +1631,13 @@ subroutine SetupMotionMesh() enddo ! Allocate and define the components of BladeStrMeshCoords - allocate(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(Sim%WT(iWT)%NumBlades), STAT=ErrStat2); if (Failed0('StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords')) return + allocate(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(Sim%WT(iWT)%NumBlades), STAT=ErrStat_F2); if (Failed0('StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords')) return do i=1,Sim%WT(iWT)%NumBlades - call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Position, 3, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Position", ErrStat2, ErrMsg2 ); if (Failed()) return - call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Orient, 3, 3, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Orient", ErrStat2, ErrMsg2 ); if (Failed()) return - call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Velocity, 6, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Velocity", ErrStat2, ErrMsg2 ); if (Failed()) return - call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Accln, 6, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Accln", ErrStat2, ErrMsg2 ); if (Failed()) return - call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Force, 6, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Force", ErrStat2, ErrMsg2 ); if (Failed()) return + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Position, 3, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Position", ErrStat_F2, ErrMsg_F2 ); if (Failed()) return + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Orient, 3, 3, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Orient", ErrStat_F2, ErrMsg_F2 ); if (Failed()) return + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Velocity, 6, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Velocity", ErrStat_F2, ErrMsg_F2 ); if (Failed()) return + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Accln, 6, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Accln", ErrStat_F2, ErrMsg_F2 ); if (Failed()) return + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Force, 6, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Force", ErrStat_F2, ErrMsg_F2 ); if (Failed()) return enddo do i=1,Sim%WT(iWT)%NumBlades @@ -1677,20 +1648,20 @@ subroutine SetupMotionMesh() enddo ! Allocate the meshes - allocate(BldStrMotionMesh(iWT)%Mesh( Sim%WT(iWT)%NumBlades ), STAT=ErrStat2); if (Failed0('BldStrMotionMesh( iWT )%Mesh' )) return - allocate(BldStrLoadMesh(iWT)%Mesh( Sim%WT(iWT)%NumBlades ), STAT=ErrStat2); if (Failed0('BldStrLoadMesh( iWT )%Mesh' )) return - allocate(BldStrLoadMesh_tmp(iWT)%Mesh( Sim%WT(iWT)%NumBlades ), STAT=ErrStat2); if (Failed0('BldStrLoadMesh_tmp( iWT )%Mesh' )) return + allocate(BldStrMotionMesh(iWT)%BldMesh( Sim%WT(iWT)%NumBlades ), STAT=ErrStat_F2); if (Failed0('BldStrMotionMesh( iWT )%BldMesh' )) return + allocate(BldStrLoadMesh(iWT)%BldMesh( Sim%WT(iWT)%NumBlades ), STAT=ErrStat_F2); if (Failed0('BldStrLoadMesh( iWT )%BldMesh' )) return + allocate(BldStrLoadMesh_tmp(iWT)%BldMesh( Sim%WT(iWT)%NumBlades ), STAT=ErrStat_F2); if (Failed0('BldStrLoadMesh_tmp( iWT )%BldMesh' )) return !------------------------------------------------------------- ! Set the interface meshes for motion inputs and loads output !------------------------------------------------------------- ! Motion mesh for blades do iBlade=1,Sim%WT(iWT)%NumBlades - call MeshCreate( BldStrMotionMesh(iWT)%Mesh(iBlade) , & + call MeshCreate( BldStrMotionMesh(iWT)%BldMesh(iBlade) , & IOS = COMPONENT_INPUT , & Nnodes = StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(iBlade) , & - ErrStat = ErrStat2 , & - ErrMess = ErrMsg2 , & + ErrStat = ErrStat_F2 , & + ErrMess = ErrMsg_F2 , & TranslationDisp = .TRUE., Orientation = .TRUE. , & TranslationVel = .TRUE., RotationVel = .TRUE. , & TranslationAcc = .TRUE., RotationAcc = .FALSE. ) @@ -1707,30 +1678,30 @@ subroutine SetupMotionMesh() Orient = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Orient(1:3,1:3,j) endif call OrientRemap(Orient) - call MeshPositionNode( BldStrMotionMesh(iWT)%Mesh(iBlade) , & - j , & - InitPos , & ! position - ErrStat2, ErrMsg2 , & - Orient ) ! orientation + call MeshPositionNode( BldStrMotionMesh(iWT)%BldMesh(iBlade) , & + j , & + InitPos , & ! position + ErrStat_F2, ErrMsg_F2 , & + Orient ) ! orientation if(Failed()) return ! Create point or line element based on flag if (PointLoadOutput) then - call MeshConstructElement ( BldStrMotionMesh(iWT)%Mesh(iBlade), ELEMENT_POINT, ErrStat2, ErrMsg2, j ); if(Failed()) return + call MeshConstructElement ( BldStrMotionMesh(iWT)%BldMesh(iBlade), ELEMENT_POINT, ErrStat_F2, ErrMsg_F2, j ); if(Failed()) return else if (j > 1) then ! This assumes that the first point is the root - call MeshConstructElement ( BldStrMotionMesh(iWT)%Mesh(iBlade), ELEMENT_LINE2, ErrStat2, ErrMsg2, j-1, j ); if(Failed()) return + call MeshConstructElement ( BldStrMotionMesh(iWT)%BldMesh(iBlade), ELEMENT_LINE2, ErrStat_F2, ErrMsg_F2, j-1, j ); if(Failed()) return end if enddo enddo do iBlade=1,Sim%WT(iWT)%NumBlades - call MeshCommit ( BldStrMotionMesh(iWT)%Mesh(iBlade), ErrStat2, ErrMsg2 ); if(Failed()) return - BldStrMotionMesh(iWT)%Mesh(iBlade)%RemapFlag = .FALSE. + call MeshCommit ( BldStrMotionMesh(iWT)%BldMesh(iBlade), ErrStat_F2, ErrMsg_F2 ); if(Failed()) return + BldStrMotionMesh(iWT)%BldMesh(iBlade)%RemapFlag = .FALSE. ! For checking the mesh ! Note: CU is is output unit (platform dependent) - if (DebugLevel >= 4) call MeshPrintInfo( CU, BldStrMotionMesh(iWT)%Mesh(iBlade), MeshName='BldStrMotionMesh'//trim(Num2LStr(iWT))//'_'//trim(Num2LStr(iBlade)) ) + if (DebugLevel >= 4) call MeshPrintInfo( CU, BldStrMotionMesh(iWT)%BldMesh(iBlade), MeshName='BldStrMotionMesh'//trim(Num2LStr(iWT))//'_'//trim(Num2LStr(iBlade)) ) enddo ! !------------------------------------------------------------- @@ -1738,8 +1709,8 @@ subroutine SetupMotionMesh() ! call MeshCreate( NacMotionMesh(iWT) , & ! IOS = COMPONENT_INPUT , & ! Nnodes = 1 , & -! ErrStat = ErrStat2 , & -! ErrMess = ErrMsg2 , & +! ErrStat = ErrStat_F2 , & +! ErrMess = ErrMsg_F2 , & ! TranslationDisp = .TRUE., Orientation = .TRUE., & ! TranslationVel = .TRUE., RotationVel = .TRUE., & ! TranslationAcc = .TRUE., RotationAcc = .FALSE. ) @@ -1751,13 +1722,13 @@ subroutine SetupMotionMesh() ! call MeshPositionNode( NacMotionMesh(iWT) , & ! 1 , & ! InitPos , & ! position -! ErrStat2, ErrMsg2 , & +! ErrStat_F2, ErrMsg_F2 , & ! Orient ) ! orientation ! if(Failed()) return ! -! call MeshConstructElement ( NacMotionMesh(iWT), ELEMENT_POINT, ErrStat2, ErrMsg2, p1=1 ); if(Failed()) return +! call MeshConstructElement ( NacMotionMesh(iWT), ELEMENT_POINT, ErrStat_F2, ErrMsg_F2, p1=1 ); if(Failed()) return ! -! call MeshCommit ( NacMotionMesh(iWT), ErrStat2, ErrMsg2 ); if(Failed()) return +! call MeshCommit ( NacMotionMesh(iWT), ErrStat_F2, ErrMsg_F2 ); if(Failed()) return ! NacMotionMesh(iWT)%RemapFlag = .FALSE. ! ! ! For checking the mesh, uncomment this. @@ -1809,15 +1780,15 @@ subroutine ADI_C_SetRotorMotion( iWT_c, & real(DbKi) :: Time integer(IntKi) :: iWT !< current wind turbine / rotor integer(IntKi) :: i,j !< generic index variables - integer(IntKi) :: ErrStat !< aggregated error status - character(ErrMsgLen) :: ErrMsg !< aggregated error message - integer(IntKi) :: ErrStat2 !< temporary error status from a call - character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call + integer(IntKi) :: ErrStat_F !< aggregated error status + character(ErrMsgLen) :: ErrMsg_F !< aggregated error message + integer(IntKi) :: ErrStat_F2 !< temporary error status from a call + character(ErrMsgLen) :: ErrMsg_F2 !< temporary error message from a call character(*), parameter :: RoutineName = 'ADI_C_SetRotorMotion' !< for error handling ! Initialize error handling - ErrStat = ErrID_None - ErrMsg = "" + ErrStat_F = ErrID_None + ErrMsg_F = "" ! For debugging the interface: if (DebugLevel > 0) then @@ -1829,8 +1800,8 @@ subroutine ADI_C_SetRotorMotion( iWT_c, & ! Sanity check -- number of node points cannot change if ( NumMeshPts(iWT) /= int(NumMeshPts_C, IntKi) ) then - ErrStat2 = ErrID_Fatal - ErrMsg2 = "Number of node points passed in changed. This must be constant throughout simulation" + ErrStat_F2 = ErrID_Fatal + ErrMsg_F2 = "Number of node points passed in changed. This must be constant throughout simulation" if (Failed()) return endif @@ -1845,24 +1816,25 @@ subroutine ADI_C_SetRotorMotion( iWT_c, & enddo ! Transfer motions to input meshes - do iWT=1,Sim%NumTurbines - call Set_MotionMesh(iWT, ErrStat2, ErrMsg2); if (Failed()) return - call AD_SetInputMotion( iWT, ADI_u, & - HubPos_C, HubOri_C, HubVel_C, HubAcc_C, & - NacPos_C, NacOri_C, NacVel_C, NacAcc_C, & - BldRootPos_C, BldRootOri_C, BldRootVel_C, BldRootAcc_C, & - ErrStat2, ErrMsg2 ) ! transfer input motion mesh to u(1) meshes - if (Failed()) return - enddo + call Set_MotionMesh(iWT, ErrStat_F2, ErrMsg_F2); if (Failed()) return + call AD_SetInputMotion( iWT, ADI_u, & + HubPos_C, HubOri_C, HubVel_C, HubAcc_C, & + NacPos_C, NacOri_C, NacVel_C, NacAcc_C, & + BldRootPos_C, BldRootOri_C, BldRootVel_C, BldRootAcc_C, & + ErrStat_F2, ErrMsg_F2 ) ! transfer input motion mesh to u(1) meshes + if (Failed()) return ! Set error status - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) CONTAINS logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - if (Failed) call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + CALL SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + Failed = ErrStat_F >= AbortErrLev + if (Failed) then + call ClearTmpStorage() + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) + endif end function Failed !> This subroutine prints out all the variables that are passed in. Use this only !! for debugging the interface on the Fortran side. @@ -1965,16 +1937,16 @@ subroutine ADI_C_GetRotorLoads(iWT_C, & ! Local variables integer(IntKi) :: iWT !< current wind turbine / rotor - integer(IntKi) :: ErrStat !< aggregated error status - character(ErrMsgLen) :: ErrMsg !< aggregated error message - integer(IntKi) :: ErrStat2 !< temporary error status from a call - character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call + integer(IntKi) :: ErrStat_F !< aggregated error status + character(ErrMsgLen) :: ErrMsg_F !< aggregated error message + integer(IntKi) :: ErrStat_F2 !< temporary error status from a call + character(ErrMsgLen) :: ErrMsg_F2 !< temporary error message from a call character(*), parameter :: RoutineName = 'ADI_C_SetRotorMotion' !< for error handling integer(IntKi) :: i,j !< generic index variables ! Initialize error handling - ErrStat = ErrID_None - ErrMsg = "" + ErrStat_F = ErrID_None + ErrMsg_F = "" ! For debugging the interface: if (DebugLevel > 0) then @@ -1986,13 +1958,13 @@ subroutine ADI_C_GetRotorLoads(iWT_C, & ! Sanity check -- number of node points cannot change if ( NumMeshPts(iWT) /= int(NumMeshPts_C, IntKi) ) then - ErrStat2 = ErrID_Fatal - ErrMsg2 = "Number of node points passed in changed. This must be constant throughout simulation" + ErrStat_F2 = ErrID_Fatal + ErrMsg_F2 = "Number of node points passed in changed. This must be constant throughout simulation" if (Failed()) return endif ! Transfer resulting load meshes to intermediate mesh - call AD_TransferLoads( iWT, ADI%u(1), ADI%y, ErrStat2, ErrMsg2 ) + call AD_TransferLoads( iWT, ADI%u(1), ADI%y, ErrStat_F2, ErrMsg_F2 ) if (Failed()) return ! Set output force/moment array @@ -2011,13 +1983,16 @@ subroutine ADI_C_GetRotorLoads(iWT_C, & end if ! Set error status - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) CONTAINS logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - if (Failed) call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + CALL SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + Failed = ErrStat_F >= AbortErrLev + if (Failed) then + call ClearTmpStorage() + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) + endif end function Failed !> This subroutine prints out all the variables that are passed in. Use this only !! for debugging the interface on the Fortran side. @@ -2059,13 +2034,13 @@ subroutine ADI_C_GetDiskAvgVel(iWT_C, & integer(IntKi), parameter :: StartNode = 1 ! so all points are calculated real(ReKi), allocatable :: NoAcc(:,:) ! Placeholder array not used when accelerations not required. real(ReKi) :: DiskAvgVel(3) !< Wind speed vector for disk average [Vx,Vy,Vz] -- (m/s) (global) - integer(IntKi) :: ErrStat !< aggregated error status - character(ErrMsgLen) :: ErrMsg !< aggregated error message + integer(IntKi) :: ErrStat_F !< aggregated error status + character(ErrMsgLen) :: ErrMsg_F !< aggregated error message character(*), parameter :: RoutineName = 'ADI_C_GetDiskAvgVel' !< for error handling ! Initialize error handling - ErrStat = ErrID_None - ErrMsg = "" + ErrStat_F = ErrID_None + ErrMsg_F = "" ! For debugging the interface: if (DebugLevel > 0) then @@ -2083,14 +2058,14 @@ subroutine ADI_C_GetDiskAvgVel(iWT_C, & DiskAvgVelVars(iWT)%DiskWindPosAbs(:,i) = real(Hub%Position(1:3,1)+Hub%TranslationDisp(1:3,1),ReKi) & + matmul(real(Hub%Orientation(1:3,1:3,1),ReKi),DiskAvgVelVars(iWT)%DiskWindPosRel(:,i)) enddo - call IfW_FlowField_GetVelAcc(ADI%m%IW%p%FlowField, StartNode, InputTimePrev_Calc, DiskAvgVelVars(iWT)%DiskWindPosAbs, DiskAvgVelVars(iWT)%DiskWindVel, NoAcc, ErrStat, ErrMsg) + call IfW_FlowField_GetVelAcc(ADI%m%IW%p%FlowField, StartNode, InputTimePrev_Calc, DiskAvgVelVars(iWT)%DiskWindPosAbs, DiskAvgVelVars(iWT)%DiskWindVel, NoAcc, ErrStat_F, ErrMsg_F) ! calculate average DiskAvgVel = sum(DiskAvgVelVars(iWT)%DiskWindVel, dim=2) / REAL(NumPtsDiskAvg,SiKi) DiskAvgVel_C = real(DiskAvgVel, c_float) ! Set error status - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) CONTAINS !> This subroutine prints out all the variables that are passed in. Use this only @@ -2123,14 +2098,14 @@ subroutine Set_MotionMesh(iWT, ErrStat3, ErrMsg3) ! Set mesh corresponding to input motions do iBlade=1,Sim%WT(iWT)%NumBlades do j=1,StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(iBlade) - BldStrMotionMesh(iWT)%Mesh(iBlade)%TranslationDisp(1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Position(1:3,j) + Sim%WT(iWT)%OriginInit(1:3) - real(BldStrMotionMesh(iWT)%Mesh(iBlade)%Position(1:3,j), R8Ki) - BldStrMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Orient(1:3,1:3,j) - BldStrMotionMesh(iWT)%Mesh(iBlade)%TranslationVel( 1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Velocity(1:3,j) - BldStrMotionMesh(iWT)%Mesh(iBlade)%RotationVel( 1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Velocity(4:6,j) - BldStrMotionMesh(iWT)%Mesh(iBlade)%TranslationAcc( 1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Accln(1:3,j) - call OrientRemap(BldStrMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j)) + BldStrMotionMesh(iWT)%BldMesh(iBlade)%TranslationDisp(1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Position(1:3,j) + Sim%WT(iWT)%OriginInit(1:3) - real(BldStrMotionMesh(iWT)%BldMesh(iBlade)%Position(1:3,j), R8Ki) + BldStrMotionMesh(iWT)%BldMesh(iBlade)%Orientation(1:3,1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Orient(1:3,1:3,j) + BldStrMotionMesh(iWT)%BldMesh(iBlade)%TranslationVel( 1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Velocity(1:3,j) + BldStrMotionMesh(iWT)%BldMesh(iBlade)%RotationVel( 1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Velocity(4:6,j) + BldStrMotionMesh(iWT)%BldMesh(iBlade)%TranslationAcc( 1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Accln(1:3,j) + call OrientRemap(BldStrMotionMesh(iWT)%BldMesh(iBlade)%Orientation(1:3,1:3,j)) if (TransposeDCM) then - BldStrMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j) = transpose(BldStrMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j)) + BldStrMotionMesh(iWT)%BldMesh(iBlade)%Orientation(1:3,1:3,j) = transpose(BldStrMotionMesh(iWT)%BldMesh(iBlade)%Orientation(1:3,1:3,j)) endif enddo enddo @@ -2209,12 +2184,12 @@ subroutine AD_SetInputMotion( iWT, u_local, & ! Blade mesh do iBlade=1,Sim%WT(iWT)%numBlades - n_elems = size(BldStrMotionMesh(iWT)%Mesh(iBlade)%Position, 2) + n_elems = size(BldStrMotionMesh(iWT)%BldMesh(iBlade)%Position, 2) if (( u_local%AD%rotors(iWT)%BladeMotion(iBlade)%Committed ) .and. (n_elems > 0)) then if (PointLoadOutput) then - call Transfer_Point_to_Line2(BldStrMotionMesh(iWT)%Mesh(iBlade), u_local%AD%rotors(iWT)%BladeMotion(iBlade), Map_BldStrMotion_2_AD_Blade(i,iWT), ErrStat, ErrMsg) + call Transfer_Point_to_Line2(BldStrMotionMesh(iWT)%BldMesh(iBlade), u_local%AD%rotors(iWT)%BladeMotion(iBlade), Map_BldStrMotion_2_AD_Blade(i,iWT), ErrStat, ErrMsg) else - call Transfer_Line2_to_Line2(BldStrMotionMesh(iWT)%Mesh(iBlade), u_local%AD%rotors(iWT)%BladeMotion(iBlade), Map_BldStrMotion_2_AD_Blade(i,iWT), ErrStat, ErrMsg) + call Transfer_Line2_to_Line2(BldStrMotionMesh(iWT)%BldMesh(iBlade), u_local%AD%rotors(iWT)%BladeMotion(iBlade), Map_BldStrMotion_2_AD_Blade(i,iWT), ErrStat, ErrMsg) u_local%AD%rotors(iWT)%BladeMotion(iBlade)%RemapFlag = .false. end if if (ErrStat >= AbortErrLev) return @@ -2235,32 +2210,32 @@ subroutine AD_TransferLoads( iWT, u_local, y_local, ErrStat3, ErrMsg3 ) do iBlade=1,Sim%WT(iWT)%NumBlades - n_elems = size(BldStrMotionMesh(iWT)%Mesh(iBlade)%Position, 2) + n_elems = size(BldStrMotionMesh(iWT)%BldMesh(iBlade)%Position, 2) if (n_elems > 0) then - BldStrLoadMesh(iWT)%Mesh(iBlade)%Force = 0.0_ReKi - BldStrLoadMesh(iWT)%Mesh(iBlade)%Moment = 0.0_ReKi + BldStrLoadMesh(iWT)%BldMesh(iBlade)%Force = 0.0_ReKi + BldStrLoadMesh(iWT)%BldMesh(iBlade)%Moment = 0.0_ReKi endif enddo do iBlade=1,Sim%WT(iWT)%NumBlades if ( y_local%AD%rotors(iWT)%BladeLoad(iBlade)%Committed ) then if (DebugLevel >= 4) call MeshPrintInfo( CU, y_local%AD%rotors(iWT)%BladeLoad(iBlade), MeshName='AD%rotors('//trim(Num2LStr(iWT))//')%BladeLoad('//trim(Num2LStr(iBlade))//')' ) - n_elems = size(BldStrMotionMesh(iWT)%Mesh(iBlade)%Position, 2) + n_elems = size(BldStrMotionMesh(iWT)%BldMesh(iBlade)%Position, 2) if (n_elems > 0) then if (PointLoadOutput) then - call Transfer_Line2_to_Point(ADI%y%AD%rotors(iWT)%BladeLoad(iBlade), BldStrLoadMesh_tmp(iWT)%Mesh(iBlade), Map_AD_BldLoad_P_2_BldStrLoad(iBlade,iWT), & - ErrStat3, ErrMsg3, u_local%AD%rotors(iWT)%BladeMotion(iBlade), BldStrMotionMesh(iWT)%Mesh(iBlade)) + call Transfer_Line2_to_Point(ADI%y%AD%rotors(iWT)%BladeLoad(iBlade), BldStrLoadMesh_tmp(iWT)%BldMesh(iBlade), Map_AD_BldLoad_P_2_BldStrLoad(iBlade,iWT), & + ErrStat3, ErrMsg3, u_local%AD%rotors(iWT)%BladeMotion(iBlade), BldStrMotionMesh(iWT)%BldMesh(iBlade)) else - call Transfer_Line2_to_Line2(ADI%y%AD%rotors(iWT)%BladeLoad(iBlade), BldStrLoadMesh_tmp(iWT)%Mesh(iBlade), Map_AD_BldLoad_P_2_BldStrLoad(iBlade,iWT), & - ErrStat3, ErrMsg3, u_local%AD%rotors(iWT)%BladeMotion(iBlade), BldStrMotionMesh(iWT)%Mesh(iBlade)) + call Transfer_Line2_to_Line2(ADI%y%AD%rotors(iWT)%BladeLoad(iBlade), BldStrLoadMesh_tmp(iWT)%BldMesh(iBlade), Map_AD_BldLoad_P_2_BldStrLoad(iBlade,iWT), & + ErrStat3, ErrMsg3, u_local%AD%rotors(iWT)%BladeMotion(iBlade), BldStrMotionMesh(iWT)%BldMesh(iBlade)) ADI%y%AD%rotors(iWT)%BladeLoad(iBlade)%RemapFlag = .false. end if if (ErrStat3 >= AbortErrLev) return - BldStrLoadMesh(iWT)%Mesh(iBlade)%Force = BldStrLoadMesh(iWT)%Mesh(iBlade)%Force + BldStrLoadMesh_tmp(iWT)%Mesh(iBlade)%Force - BldStrLoadMesh(iWT)%Mesh(iBlade)%Moment = BldStrLoadMesh(iWT)%Mesh(iBlade)%Moment + BldStrLoadMesh_tmp(iWT)%Mesh(iBlade)%Moment + BldStrLoadMesh(iWT)%BldMesh(iBlade)%Force = BldStrLoadMesh(iWT)%BldMesh(iBlade)%Force + BldStrLoadMesh_tmp(iWT)%BldMesh(iBlade)%Force + BldStrLoadMesh(iWT)%BldMesh(iBlade)%Moment = BldStrLoadMesh(iWT)%BldMesh(iBlade)%Moment + BldStrLoadMesh_tmp(iWT)%BldMesh(iBlade)%Moment endif endif - if (DebugLevel >= 4) call MeshPrintInfo( CU, BldStrLoadMesh(iWT)%Mesh(iBlade), MeshName='BldStrLoadMesh'//trim(Num2LStr(iWT))//'_'//trim(Num2LStr(iBlade)) ) + if (DebugLevel >= 4) call MeshPrintInfo( CU, BldStrLoadMesh(iWT)%BldMesh(iBlade), MeshName='BldStrLoadMesh'//trim(Num2LStr(iWT))//'_'//trim(Num2LStr(iBlade)) ) enddo end subroutine AD_TransferLoads @@ -2273,8 +2248,8 @@ subroutine Set_OutputLoadArray(iWT) ! Set mesh corresponding to input motions do iBlade=1,Sim%WT(iWT)%NumBlades do j=1,StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(iBlade) - StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Force(1:3,j) = BldStrLoadMesh(iWT)%Mesh(iBlade)%Force( 1:3,j) - StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Force(4:6,j) = BldStrLoadMesh(iWT)%Mesh(iBlade)%Moment(1:3,j) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Force(1:3,j) = BldStrLoadMesh(iWT)%BldMesh(iBlade)%Force( 1:3,j) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Force(4:6,j) = BldStrLoadMesh(iWT)%BldMesh(iBlade)%Moment(1:3,j) enddo enddo end subroutine Set_OutputLoadArray @@ -2305,8 +2280,8 @@ subroutine WrVTK_refMeshes(rot_u, RefPoint, ErrStat, ErrMsg) integer(IntKi) :: nBlades integer(IntKi) :: iWT, nWT, iBlade character(*), parameter :: RoutineName = 'WrVTK_refMeshes' !< for error handling - integer(IntKi) :: ErrStat2 !< temporary error status - character(ErrMsgLen) :: ErrMsg2 !< temporary error message + integer(IntKi) :: ErrStat_F2 !< temporary error status + character(ErrMsgLen) :: ErrMsg_F2 !< temporary error message character(10) :: sWT ErrStat = 0_IntKi @@ -2323,19 +2298,19 @@ subroutine WrVTK_refMeshes(rot_u, RefPoint, ErrStat, ErrMsg) select case (WrOutputsData%WrVTK_Type) case (1) ! surfaces -- don't write any surface references - call WrVTK_PointsRef( ErrStat2,ErrMsg2); if (Failed()) return; + call WrVTK_PointsRef( ErrStat_F2,ErrMsg_F2); if (Failed()) return; case (2) ! lines - call WrVTK_PointsRef( ErrStat2,ErrMsg2); if (Failed()) return; - call WrVTK_LinesRef( ErrStat2,ErrMsg2); if (Failed()) return; + call WrVTK_PointsRef( ErrStat_F2,ErrMsg_F2); if (Failed()) return; + call WrVTK_LinesRef( ErrStat_F2,ErrMsg_F2); if (Failed()) return; case (3) ! both - call WrVTK_PointsRef( ErrStat2,ErrMsg2); if (Failed()) return; - call WrVTK_LinesRef( ErrStat2,ErrMsg2); if (Failed()) return; + call WrVTK_PointsRef( ErrStat_F2,ErrMsg_F2); if (Failed()) return; + call WrVTK_LinesRef( ErrStat_F2,ErrMsg_F2); if (Failed()) return; end select enddo contains logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat, ErrMsg, RoutineName ) Failed = ErrStat >= AbortErrLev end function Failed @@ -2348,7 +2323,7 @@ subroutine WrVTK_PointsRef(ErrStat3,ErrMsg3) ! Blade point motion (structural mesh from driver) do iBlade=1,Sim%WT(iWT)%NumBlades - call MeshWrVTKreference(RefPoint, BldStrMotionMesh(iWT)%Mesh(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BldStrMotionMesh'//trim(Num2LStr(iBlade)), ErrStat3, ErrMsg3) + call MeshWrVTKreference(RefPoint, BldStrMotionMesh(iWT)%BldMesh(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BldStrMotionMesh'//trim(Num2LStr(iBlade)), ErrStat3, ErrMsg3) if (ErrStat3 >= AbortErrLev) return enddo @@ -2409,8 +2384,8 @@ subroutine WrVTK_Meshes(rot_u, RefPoint, ErrStat, ErrMsg) integer(IntKi) :: iWT, nWT, iBlade character(IntfStrLen) :: TmpFileName character(*), parameter :: RoutineName = 'WrVTK_Meshes' !< for error handling - integer(IntKi) :: ErrStat2 !< temporary error status - character(ErrMsgLen) :: ErrMsg2 !< temporary error message + integer(IntKi) :: ErrStat_F2 !< temporary error status + character(ErrMsgLen) :: ErrMsg_F2 !< temporary error message character(10) :: sWT ErrStat = 0_IntKi @@ -2427,21 +2402,21 @@ subroutine WrVTK_Meshes(rot_u, RefPoint, ErrStat, ErrMsg) select case (WrOutputsData%WrVTK_Type) case (1) ! surfaces - call WrVTK_Points( ErrStat2,ErrMsg2); if (Failed()) return; - call WrVTK_Surfaces(ErrStat2,ErrMsg2); if (Failed()) return; + call WrVTK_Points( ErrStat_F2,ErrMsg_F2); if (Failed()) return; + call WrVTK_Surfaces(ErrStat_F2,ErrMsg_F2); if (Failed()) return; case (2) ! lines - call WrVTK_Points( ErrStat2,ErrMsg2); if (Failed()) return; - call WrVTK_Lines( ErrStat2,ErrMsg2); if (Failed()) return; + call WrVTK_Points( ErrStat_F2,ErrMsg_F2); if (Failed()) return; + call WrVTK_Lines( ErrStat_F2,ErrMsg_F2); if (Failed()) return; case (3) ! both - call WrVTK_Points( ErrStat2,ErrMsg2); if (Failed()) return; - call WrVTK_Surfaces(ErrStat2,ErrMsg2); if (Failed()) return; - call WrVTK_Lines( ErrStat2,ErrMsg2); if (Failed()) return; + call WrVTK_Points( ErrStat_F2,ErrMsg_F2); if (Failed()) return; + call WrVTK_Surfaces(ErrStat_F2,ErrMsg_F2); if (Failed()) return; + call WrVTK_Lines( ErrStat_F2,ErrMsg_F2); if (Failed()) return; end select enddo contains logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat, ErrMsg, RoutineName ) Failed = ErrStat >= AbortErrLev end function Failed @@ -2455,7 +2430,7 @@ subroutine WrVTK_Points(ErrStat3,ErrMsg3) ! Blade point motion (structural mesh from driver) do iBlade=1,Sim%WT(iWT)%NumBlades - call MeshWrVTK(RefPoint, BldStrMotionMesh(iWT)%Mesh(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BldStrMotionMesh'//trim(Num2LStr(iBlade)), n_VTK, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) + call MeshWrVTK(RefPoint, BldStrMotionMesh(iWT)%BldMesh(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BldStrMotionMesh'//trim(Num2LStr(iBlade)), VTKn_Global, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) if (ErrStat3 >= AbortErrLev) return enddo @@ -2463,20 +2438,20 @@ subroutine WrVTK_Points(ErrStat3,ErrMsg3) if (allocated(rot_u(iWT)%BladeRootMotion)) then do iBlade=1,Sim%WT(iWT)%NumBlades if (rot_u(iWT)%BladeRootMotion(iBlade)%Committed) then - call MeshWrVTK(RefPoint, rot_u(iWT)%BladeRootMotion(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BladeRootMotion'//trim(num2lstr(iBlade)), n_VTK, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) + call MeshWrVTK(RefPoint, rot_u(iWT)%BladeRootMotion(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BladeRootMotion'//trim(num2lstr(iBlade)), VTKn_Global, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) if (ErrStat3 >= AbortErrLev) return endif enddo endif ! Nacelle (structural point input - if ( rot_u(iWT)%NacelleMotion%Committed ) call MeshWrVTK(RefPoint, rot_u(iWT)%NacelleMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.NacelleMotion', n_VTK, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) + if ( rot_u(iWT)%NacelleMotion%Committed ) call MeshWrVTK(RefPoint, rot_u(iWT)%NacelleMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.NacelleMotion', VTKn_Global, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) if (ErrStat3 >= AbortErrLev) return ! Free wake if (allocated(ADI%m%AD%FVW_u) .and. iWT==1) then if (allocated(ADI%m%AD%FVW_u(1)%WingsMesh)) then - call WrVTK_FVW(ADI%p%AD%FVW, ADI%x(STATE_CURR)%AD%FVW, ADI%z(STATE_CURR)%AD%FVW, ADI%m%AD%FVW, trim(WrOutputsData%VTK_OutFileRoot)//'.FVW', n_VTK, WrOutputsData%VTK_tWidth, bladeFrame=.FALSE.) ! bladeFrame==.FALSE. to output in global coords + call WrVTK_FVW(ADI%p%AD%FVW, ADI%x(STATE_CURR)%AD%FVW, ADI%z(STATE_CURR)%AD%FVW, ADI%m%AD%FVW, trim(WrOutputsData%VTK_OutFileRoot)//'.FVW', VTKn_Global, WrOutputsData%VTK_tWidth, bladeFrame=.FALSE.) ! bladeFrame==.FALSE. to output in global coords endif end if end subroutine WrVTK_Points @@ -2492,11 +2467,11 @@ subroutine WrVTK_Surfaces(ErrStat3,ErrMsg3) ErrMsg3 = '' ! TODO: use this routine when it is moved out of the driver and into ADI - ! call AD_WrVTK_Surfaces(ADI%u(1)%AD, ADI%y%AD, RefPoint, ADI%m%VTK_Surfaces, n_VTK, WrOutputsData%Root, WrOutputsData%VTK_tWidth, 25, WrOutputsData%VTKHubRad) + ! call AD_WrVTK_Surfaces(ADI%u(1)%AD, ADI%y%AD, RefPoint, ADI%m%VTK_Surfaces, VTKn_Global, WrOutputsData%Root, WrOutputsData%VTK_tWidth, 25, WrOutputsData%VTKHubRad) ! Nacelle if ( rot_u(iWT)%NacelleMotion%Committed ) then - call MeshWrVTK_PointSurface (RefPoint, rot_u(iWT)%NacelleMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.NacelleSurface', n_VTK, & + call MeshWrVTK_PointSurface (RefPoint, rot_u(iWT)%NacelleMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.NacelleSurface', VTKn_Global, & OutputFields, errStat3, errMsg3, WrOutputsData%VTK_tWidth, verts=WrOutputsData%VTK_Surface(iWT)%NacelleBox) if (ErrStat3 >= AbortErrLev) return endif @@ -2504,14 +2479,14 @@ subroutine WrVTK_Surfaces(ErrStat3,ErrMsg3) ! Tower if (rot_u(iWT)%TowerMotion%Committed) then call MeshWrVTK_Ln2Surface (RefPoint, rot_u(iWT)%TowerMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.TowerSurface', & - n_VTK, OutputFields, errStat3, errMsg3, WrOutputsData%VTK_tWidth, numSectors, ADI%m%VTK_Surfaces(iWT)%TowerRad ) + VTKn_Global, OutputFields, errStat3, errMsg3, WrOutputsData%VTK_tWidth, numSectors, ADI%m%VTK_Surfaces(iWT)%TowerRad ) if (ErrStat3 >= AbortErrLev) return endif ! Hub if (rot_u(iWT)%HubMotion%Committed) then call MeshWrVTK_PointSurface (RefPoint, rot_u(iWT)%HubMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.HubSurface', & - n_VTK, OutputFields, errStat3, errMsg3, WrOutputsData%VTK_tWidth, & + VTKn_Global, OutputFields, errStat3, errMsg3, WrOutputsData%VTK_tWidth, & NumSegments=numSectors, radius=WrOutputsData%VTKHubRad) if (ErrStat3 >= AbortErrLev) return endif @@ -2521,7 +2496,7 @@ subroutine WrVTK_Surfaces(ErrStat3,ErrMsg3) do iBlade=1,Sim%WT(iWT)%NumBlades if (rot_u(iWT)%BladeMotion(iBlade)%Committed) then call MeshWrVTK_Ln2Surface (RefPoint, rot_u(iWT)%BladeMotion(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.Blade'//trim(num2lstr(iBlade))//'Surface', & - n_VTK, OutputFields, errStat3, errMsg3, WrOutputsData%VTK_tWidth , verts=ADI%m%VTK_Surfaces(iWT)%BladeShape(iBlade)%AirfoilCoords, & + VTKn_Global, OutputFields, errStat3, errMsg3, WrOutputsData%VTK_tWidth , verts=ADI%m%VTK_Surfaces(iWT)%BladeShape(iBlade)%AirfoilCoords, & Sib=ADI%y%AD%rotors(iWT)%BladeLoad(iBlade) ) if (ErrStat3 >= AbortErrLev) return endif @@ -2537,22 +2512,22 @@ subroutine WrVTK_Lines(ErrStat3,ErrMsg3) ErrMsg3 = '' ! Tower - if (rot_u(iWT)%TowerMotion%Committed) call MeshWrVTK(RefPoint, rot_u(iWT)%TowerMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.Tower', n_VTK, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) + if (rot_u(iWT)%TowerMotion%Committed) call MeshWrVTK(RefPoint, rot_u(iWT)%TowerMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.Tower', VTKn_Global, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) if (ErrStat3 >= AbortErrLev) return ! Nacelle meshes - if (rot_u(iWT)%NacelleMotion%Committed) call MeshWrVTK(RefPoint, rot_u(iWT)%NacelleMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.Nacelle', n_VTK, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) + if (rot_u(iWT)%NacelleMotion%Committed) call MeshWrVTK(RefPoint, rot_u(iWT)%NacelleMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.Nacelle', VTKn_Global, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) if (ErrStat3 >= AbortErrLev) return ! Hub - if (rot_u(iWT)%HubMotion%Committed) call MeshWrVTK(RefPoint, rot_u(iWT)%HubMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.Hub', n_VTK, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) + if (rot_u(iWT)%HubMotion%Committed) call MeshWrVTK(RefPoint, rot_u(iWT)%HubMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.Hub', VTKn_Global, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) if (ErrStat3 >= AbortErrLev) return ! Blades if (allocated(rot_u(iWT)%BladeMotion)) then do iBlade=1,Sim%WT(iWT)%NumBlades if (rot_u(iWT)%BladeMotion(iBlade)%Committed) then - call MeshWrVTK(RefPoint, rot_u(iWT)%BladeMotion(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.Blade'//trim(num2lstr(iBlade)), n_VTK, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) + call MeshWrVTK(RefPoint, rot_u(iWT)%BladeMotion(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.Blade'//trim(num2lstr(iBlade)), VTKn_Global, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) if (ErrStat3 >= AbortErrLev) return endif enddo @@ -2577,13 +2552,13 @@ subroutine WrVTK_Ground (RefPoint, HalfLengths, FileRootName, errStat, errMsg) INTEGER(IntKi), parameter :: NumberOfPoints = 4 INTEGER(IntKi), parameter :: NumberOfLines = 0 INTEGER(IntKi), parameter :: NumberOfPolys = 1 - INTEGER(IntKi) :: errStat2 - CHARACTER(ErrMsgLen) :: errMsg2 + INTEGER(IntKi) :: ErrStat_F2 + CHARACTER(ErrMsgLen) :: ErrMsg_F2 errStat = ErrID_None errMsg = "" FileName = TRIM(FileRootName)//'.vtp' - call WrVTK_header( FileName, NumberOfPoints, NumberOfLines, NumberOfPolys, Un, errStat2, errMsg2 ) - call SetErrStat(errStat2,errMsg2,errStat,errMsg,'WrVTK_Ground'); if (errStat >= AbortErrLev) return + call WrVTK_header( FileName, NumberOfPoints, NumberOfLines, NumberOfPolys, Un, ErrStat_F2, ErrMsg_F2 ) + call SetErrStat(ErrStat_F2,ErrMsg_F2,errStat,errMsg,'WrVTK_Ground'); if (errStat >= AbortErrLev) return WRITE(Un,'(A)') ' ' WRITE(Un,'(A)') ' ' WRITE(Un,VTK_AryFmt) RefPoint(1) + HalfLengths(1) , RefPoint(2) + HalfLengths(2), RefPoint(3) @@ -2605,44 +2580,16 @@ subroutine WrVTK_Ground (RefPoint, HalfLengths, FileRootName, errStat, errMsg) end subroutine WrVTK_Ground -!-------------------------------------------------------------------- -!> Set some temporary data storage arrays to simplify data conversion -subroutine SetTempStorage(ErrStat,ErrMsg) - INTEGER(IntKi), intent(out) :: errStat !< Indicates whether an error occurred (see NWTC_Library) - character(*), intent(out) :: errMsg !< Error message associated with the errStat - INTEGER(IntKi) :: errStat2 - CHARACTER(ErrMsgLen) :: errMsg2 - character(*), parameter :: RoutineName = 'SetTempStorage' !< for error handling - ErrStat = ErrID_None - ErrMsg = "" - if (.not. allocated(NumMeshPts)) then - ErrStat = ErrID_Fatal - ErrMSg = "Pre-Init has not been called yet" - return - endif - if (minval(NumMeshPts) < 0) then - ErrStat = ErrID_Fatal - ErrMSg = "ADI_C_SetupRotor haven't been called for all rotors" - return - endif - -contains - logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - end function Failed -end subroutine SetTempStorage - !-------------------------------------------------------------------- !> Don't leave junk in memory. So destroy meshes and mappings. subroutine ClearTmpStorage() - INTEGER(IntKi) :: errStat2, iWT - CHARACTER(ErrMsgLen) :: errMsg2 + INTEGER(IntKi) :: ErrStat_F2, iWT + CHARACTER(ErrMsgLen) :: ErrMsg_F2 ! Meshes do iWT=1,Sim%NumTurbines - if (allocated(BldStrMotionMesh(iWT)%Mesh)) call ClearMeshArr1(BldStrMotionMesh(iWT)%Mesh) - if (allocated(BldStrLoadMesh(iWT)%Mesh)) call ClearMeshArr1(BldStrLoadMesh(iWT)%Mesh) - if (allocated(BldStrLoadMesh_tmp(iWT)%Mesh)) call ClearMeshArr1(BldStrLoadMesh_tmp(iWT)%Mesh) + if (allocated(BldStrMotionMesh(iWT)%BldMesh)) call ClearMeshArr1(BldStrMotionMesh(iWT)%BldMesh) + if (allocated(BldStrLoadMesh(iWT)%BldMesh)) call ClearMeshArr1(BldStrLoadMesh(iWT)%BldMesh) + if (allocated(BldStrLoadMesh_tmp(iWT)%BldMesh)) call ClearMeshArr1(BldStrLoadMesh_tmp(iWT)%BldMesh) enddo ! if (allocated(NacMotionMesh )) call ClearMeshArr1(NacMotionMesh ) ! if (allocated(NacLoadMesh )) call ClearMeshArr1(NacLoadMesh ) @@ -2654,23 +2601,99 @@ subroutine ClearMeshArr1(MeshName) type(MeshType), allocatable :: MeshName(:) integer :: i do i=1,size(MeshName) - call MeshDestroy( MeshName(i), ErrStat2, ErrMsg2 ) ! ignore errors + call MeshDestroy( MeshName(i), ErrStat_F2, ErrMsg_F2 ) ! ignore errors enddo deallocate(MeshName) end subroutine ClearMeshArr1 - subroutine ClearMeshMapArr2(MapName) type(MeshMapType), allocatable :: MapName(:,:) integer :: i,j do j=1,size(MapName,2) do i=1,size(MapName,1) - call NWTC_Library_Destroymeshmaptype( MapName(i,j), ErrStat2, ErrMsg2 ) + call NWTC_Library_Destroymeshmaptype( MapName(i,j), ErrStat_F2, ErrMsg_F2 ) enddo enddo deallocate(MapName) end subroutine ClearMeshMapArr2 - end subroutine ClearTmpStorage +!> return the pointer to the WaveField data +subroutine ADI_C_GetFlowFieldPointer(FlowFieldPointer_C,ErrStat_C,ErrMsg_C) BIND (C, NAME='ADI_C_GetFlowFieldPointer') +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: ADI_C_GetFlowFieldPointer +!GCC$ ATTRIBUTES DLLEXPORT :: ADI_C_GetFlowFieldPointer +#endif + type(c_ptr), intent( out) :: FlowFieldPointer_C + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + integer :: ErrStat + character(ErrMsgLen) :: ErrMsg + character(*), parameter :: RoutineName = 'ADI_C_GetFlowFieldPointer' + ErrStat = ErrID_None + ErrMSg = "" + if (associated(ADI%m%IW%p%FlowField)) then + FlowFieldPointer_C = C_LOC(ADI%m%IW%p%FlowField) + else + FlowFieldPointer_C = C_NULL_PTR + call SetErrStat(ErrID_Fatal,"Pointer to FlowField data not valid: data not initialized",ErrStat,ErrMsg,RoutineName) + endif + call SetErrStat_F2C( ErrStat, ErrMsg, ErrStat_C, ErrMsg_C ) + if (DebugLevel > 1) call ShowPassedData() + return +contains + subroutine ShowPassedData() + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: ADI_C_GetFlowFieldPointer") + call WrScr(" --------------------------------------------------------") + call WrScr(" FlowFieldPointer_C -> "//trim(Num2LStr(loc(ADI%m%IW%p%FlowField)))) + call WrScr("-----------------------------------------------------------") + end subroutine ShowPassedData +end subroutine + + +!> set the pointer to the FlowField data +subroutine ADI_C_SetFlowFieldPointer(FlowFieldPointer_C,ErrStat_C,ErrMsg_C) BIND (C, NAME='ADI_C_SetFlowFieldPointer') +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: ADI_C_SetFlowFieldPointer +!GCC$ ATTRIBUTES DLLEXPORT :: ADI_C_SetFlowFieldPointer +#endif + type(c_ptr), intent(in ) :: FlowFieldPointer_C + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + integer :: ErrStat + character(ErrMsgLen) :: ErrMsg + character(*), parameter :: RoutineName = 'ADI_C_SetFlowFieldPointer' + ErrStat = ErrID_None + ErrMSg = "" + ! check if externFlowField expected + if (.not. externFlowField) then + call SetErrStat(ErrID_Severe,"External flowfield not expected. Set externFlowField_in=1 in call to ADI_C_PreInit prior to calling ADI_C_SetFlowFieldPointer.",ErrStat,ErrMsg,RoutineName) + endif + ! set pointer + call C_F_POINTER(FlowFieldPointer_C, InitInp%FlowField) + if (associated(InitInp%FlowField)) then + ! basic sanity check + if (InitInp%FlowField%FieldType <= 0_IntKi) then + call SetErrStat(ErrID_Fatal,"Invalid pointer passed in, or FlowField not initialized",ErrStat,ErrMsg,RoutineName) + else + FlowFieldPtrSet = .true. + endif + else + call SetErrStat(ErrID_Fatal,"Invalid pointer passed in, or FlowField not initialized.",ErrStat,ErrMsg,RoutineName) + endif + call SetErrStat_F2C( ErrStat, ErrMsg, ErrStat_C, ErrMsg_C ) + if (DebugLevel > 1) call ShowPassedData() + return +contains + subroutine ShowPassedData() + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: ADI_C_SetFlowFieldPointer") + call WrScr(" --------------------------------------------------------") + call WrScr(" FlowFieldPointer_C <- "//trim(Num2LStr(loc(InitInp%FlowField)))) + call WrScr("-----------------------------------------------------------") + end subroutine ShowPassedData +end subroutine + + END MODULE AeroDyn_Inflow_C_BINDING diff --git a/modules/aerodyn/src/AeroDyn_Inflow_C_Binding_Registry.txt b/modules/aerodyn/src/AeroDyn_Inflow_C_Binding_Registry.txt new file mode 100644 index 0000000000..81d602087d --- /dev/null +++ b/modules/aerodyn/src/AeroDyn_Inflow_C_Binding_Registry.txt @@ -0,0 +1,35 @@ +################################################################################################################################### +# Registry for AeroDyn 15 c-bindings interface +# This Registry file is used to create AeroDyn_Inflow_C_Binding_Types.f90 +# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. +# See the NWTC Programmer's Handbook for further information on the format/contents of this file. +# +# Entries are of the form +# +# +# Use ^ as a shortcut for the value in the same column from the previous line. +################################################################################################################################### +# ...... Include files (definitions from NWTC Library) ............................................................................ +include Registry_NWTC_Library.txt +# ADI c-bind types +param AeroDyn_Inflow_C_Binding/ADI_cbind - IntKi NumPtsDiskAvg - 144 - "Number of points for disk average velocity calculations" - +typedef ^ DiskAvgVelData ReKi DiskWindPosRel {3}{NumPtsDiskAvg} - - "Position points for disk average sampling, relative to hub" - +typedef ^ ^ ReKi DiskWindPosAbs {3}{NumPtsDiskAvg} - - "Position points for disk average sampling, absolute/global/interial" - +typedef ^ ^ ReKi DiskWindVel {3}{NumPtsDiskAvg} - - "Velocity at disk average sampling points" - +typedef ^ ^ ReKi DiskAvgVel {3} - - "Average velocity calculated from DiskWindVel" - + +typedef ^ BladeNodeToMeshPointMapType IntKi BladeNodeToMeshPoint {:} = = "Blade node -> structural mesh point mapping (sized by the number of nodes on the blade)" - + +typedef ^ BladeStrMeshCoordsType ReKi Position {:}{:} - - "Position of all blade points (sized by 3 x number of mesh points on the blade [x,y,z])" m +typedef ^ ^ ReKi Orient {:}{:}{:} - - "Orientation of all blade points (sized by 3 x 3 x number of mesh points on the blade [r11,r12,r13,r21,r22,r23,r31,r32,r33])" - +typedef ^ ^ ReKi Velocity {:}{:} - - "Velocity of all blade points (sized by 6 x number of mesh points on the blade [u,v,w,p,q,r])" m/s +typedef ^ ^ ReKi Accln {:}{:} - - "Acceleration of all blade points (sized by 6 x number of mesh points on the blade [udot,vdot,wdot,pdot,qdot,rdot])" m/s^2 +typedef ^ ^ ReKi Force {:}{:} - - "Force of all blade points (sized by 6 x number of mesh points on the blade [Fx,Fy,Fz,Mx,My,Mz])" N,Nm + +typedef ^ StrucPtsToBladeMapType IntKi NumBlades - - - "Number of blades on this rotor" - +typedef ^ ^ IntKi NumMeshPtsPerBlade {:} - - "Number of structural mesh points on each blade (sized by the number of blades)" - +typedef ^ ^ IntKi MeshPt_2_BladeNum {:} - - "Structural mesh point -> which blade on the rotor it is on (sized by the number of mesh points on the rotor)" - +typedef ^ ^ BladeNodeToMeshPointMapType BladeNode_2_MeshPt {:} - - "Blade node on blade -> structural mesh point (sized by the number of mesh points on the blade)" - +typedef ^ ^ BladeStrMeshCoordsType BladeStrMeshCoords {:} - - "Mesh point coordinates for each blade (sized by the number of blades)" - + +typedef ^ MeshByBladeType MeshType BldMesh {:} - - "Mesh for motions/loads of external nodes at each blade (sized by number of blades on the rotor)" - diff --git a/modules/aerodyn/src/AeroDyn_Inflow_C_Binding_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_C_Binding_Types.f90 new file mode 100644 index 0000000000..6d02105ed9 --- /dev/null +++ b/modules/aerodyn/src/AeroDyn_Inflow_C_Binding_Types.f90 @@ -0,0 +1,580 @@ +!STARTOFREGISTRYGENERATEDFILE 'AeroDyn_Inflow_C_Binding_Types.f90' +! +! WARNING This file is generated automatically by the FAST registry. +! Do not edit. Your changes to this file will be lost. +! +! FAST Registry +!********************************************************************************************************************************* +! AeroDyn_Inflow_C_Binding_Types +!................................................................................................................................. +! This file is part of AeroDyn_Inflow_C_Binding. +! +! Copyright (C) 2012-2016 National Renewable Energy Laboratory +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +! +! +! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. +! +!********************************************************************************************************************************* +!> This module contains the user-defined types needed in AeroDyn_Inflow_C_Binding. It also contains copy, destroy, pack, and +!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. +MODULE AeroDyn_Inflow_C_Binding_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE NWTC_Library +IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: NumPtsDiskAvg = 144 ! Number of points for disk average velocity calculations [-] +! ========= DiskAvgVelData ======= + TYPE, PUBLIC :: DiskAvgVelData + REAL(ReKi) , DIMENSION(1:3,1:NumPtsDiskAvg) :: DiskWindPosRel = 0.0_ReKi !< Position points for disk average sampling, relative to hub [-] + REAL(ReKi) , DIMENSION(1:3,1:NumPtsDiskAvg) :: DiskWindPosAbs = 0.0_ReKi !< Position points for disk average sampling, absolute/global/interial [-] + REAL(ReKi) , DIMENSION(1:3,1:NumPtsDiskAvg) :: DiskWindVel = 0.0_ReKi !< Velocity at disk average sampling points [-] + REAL(ReKi) , DIMENSION(1:3) :: DiskAvgVel = 0.0_ReKi !< Average velocity calculated from DiskWindVel [-] + END TYPE DiskAvgVelData +! ======================= +! ========= BladeNodeToMeshPointMapType ======= + TYPE, PUBLIC :: BladeNodeToMeshPointMapType + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BladeNodeToMeshPoint !< Blade node -> structural mesh point mapping (sized by the number of nodes on the blade) [-] + END TYPE BladeNodeToMeshPointMapType +! ======================= +! ========= BladeStrMeshCoordsType ======= + TYPE, PUBLIC :: BladeStrMeshCoordsType + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Position !< Position of all blade points (sized by 3 x number of mesh points on the blade [x,y,z]) [m] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Orient !< Orientation of all blade points (sized by 3 x 3 x number of mesh points on the blade [r11,r12,r13,r21,r22,r23,r31,r32,r33]) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Velocity !< Velocity of all blade points (sized by 6 x number of mesh points on the blade [u,v,w,p,q,r]) [m/s] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Accln !< Acceleration of all blade points (sized by 6 x number of mesh points on the blade [udot,vdot,wdot,pdot,qdot,rdot]) [m/s^2] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Force !< Force of all blade points (sized by 6 x number of mesh points on the blade [Fx,Fy,Fz,Mx,My,Mz]) [N,Nm] + END TYPE BladeStrMeshCoordsType +! ======================= +! ========= StrucPtsToBladeMapType ======= + TYPE, PUBLIC :: StrucPtsToBladeMapType + INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on this rotor [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NumMeshPtsPerBlade !< Number of structural mesh points on each blade (sized by the number of blades) [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: MeshPt_2_BladeNum !< Structural mesh point -> which blade on the rotor it is on (sized by the number of mesh points on the rotor) [-] + TYPE(BladeNodeToMeshPointMapType) , DIMENSION(:), ALLOCATABLE :: BladeNode_2_MeshPt !< Blade node on blade -> structural mesh point (sized by the number of mesh points on the blade) [-] + TYPE(BladeStrMeshCoordsType) , DIMENSION(:), ALLOCATABLE :: BladeStrMeshCoords !< Mesh point coordinates for each blade (sized by the number of blades) [-] + END TYPE StrucPtsToBladeMapType +! ======================= +! ========= MeshByBladeType ======= + TYPE, PUBLIC :: MeshByBladeType + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BldMesh !< Mesh for motions/loads of external nodes at each blade (sized by number of blades on the rotor) [-] + END TYPE MeshByBladeType +! ======================= +CONTAINS + +subroutine ADI_cbind_CopyDiskAvgVelData(SrcDiskAvgVelDataData, DstDiskAvgVelDataData, CtrlCode, ErrStat, ErrMsg) + type(DiskAvgVelData), intent(in) :: SrcDiskAvgVelDataData + type(DiskAvgVelData), intent(inout) :: DstDiskAvgVelDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ADI_cbind_CopyDiskAvgVelData' + ErrStat = ErrID_None + ErrMsg = '' + DstDiskAvgVelDataData%DiskWindPosRel = SrcDiskAvgVelDataData%DiskWindPosRel + DstDiskAvgVelDataData%DiskWindPosAbs = SrcDiskAvgVelDataData%DiskWindPosAbs + DstDiskAvgVelDataData%DiskWindVel = SrcDiskAvgVelDataData%DiskWindVel + DstDiskAvgVelDataData%DiskAvgVel = SrcDiskAvgVelDataData%DiskAvgVel +end subroutine + +subroutine ADI_cbind_DestroyDiskAvgVelData(DiskAvgVelDataData, ErrStat, ErrMsg) + type(DiskAvgVelData), intent(inout) :: DiskAvgVelDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ADI_cbind_DestroyDiskAvgVelData' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine ADI_cbind_PackDiskAvgVelData(RF, Indata) + type(RegFile), intent(inout) :: RF + type(DiskAvgVelData), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_cbind_PackDiskAvgVelData' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DiskWindPosRel) + call RegPack(RF, InData%DiskWindPosAbs) + call RegPack(RF, InData%DiskWindVel) + call RegPack(RF, InData%DiskAvgVel) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_cbind_UnPackDiskAvgVelData(RF, OutData) + type(RegFile), intent(inout) :: RF + type(DiskAvgVelData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_cbind_UnPackDiskAvgVelData' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DiskWindPosRel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DiskWindPosAbs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DiskWindVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DiskAvgVel); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_cbind_CopyBladeNodeToMeshPointMapType(SrcBladeNodeToMeshPointMapTypeData, DstBladeNodeToMeshPointMapTypeData, CtrlCode, ErrStat, ErrMsg) + type(BladeNodeToMeshPointMapType), intent(in) :: SrcBladeNodeToMeshPointMapTypeData + type(BladeNodeToMeshPointMapType), intent(inout) :: DstBladeNodeToMeshPointMapTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ADI_cbind_CopyBladeNodeToMeshPointMapType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcBladeNodeToMeshPointMapTypeData%BladeNodeToMeshPoint)) then + LB(1:1) = lbound(SrcBladeNodeToMeshPointMapTypeData%BladeNodeToMeshPoint) + UB(1:1) = ubound(SrcBladeNodeToMeshPointMapTypeData%BladeNodeToMeshPoint) + if (.not. allocated(DstBladeNodeToMeshPointMapTypeData%BladeNodeToMeshPoint)) then + allocate(DstBladeNodeToMeshPointMapTypeData%BladeNodeToMeshPoint(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeNodeToMeshPointMapTypeData%BladeNodeToMeshPoint.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeNodeToMeshPointMapTypeData%BladeNodeToMeshPoint = SrcBladeNodeToMeshPointMapTypeData%BladeNodeToMeshPoint + end if +end subroutine + +subroutine ADI_cbind_DestroyBladeNodeToMeshPointMapType(BladeNodeToMeshPointMapTypeData, ErrStat, ErrMsg) + type(BladeNodeToMeshPointMapType), intent(inout) :: BladeNodeToMeshPointMapTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ADI_cbind_DestroyBladeNodeToMeshPointMapType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BladeNodeToMeshPointMapTypeData%BladeNodeToMeshPoint)) then + deallocate(BladeNodeToMeshPointMapTypeData%BladeNodeToMeshPoint) + end if +end subroutine + +subroutine ADI_cbind_PackBladeNodeToMeshPointMapType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BladeNodeToMeshPointMapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_cbind_PackBladeNodeToMeshPointMapType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%BladeNodeToMeshPoint) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_cbind_UnPackBladeNodeToMeshPointMapType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BladeNodeToMeshPointMapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_cbind_UnPackBladeNodeToMeshPointMapType' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%BladeNodeToMeshPoint); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_cbind_CopyBladeStrMeshCoordsType(SrcBladeStrMeshCoordsTypeData, DstBladeStrMeshCoordsTypeData, CtrlCode, ErrStat, ErrMsg) + type(BladeStrMeshCoordsType), intent(in) :: SrcBladeStrMeshCoordsTypeData + type(BladeStrMeshCoordsType), intent(inout) :: DstBladeStrMeshCoordsTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ADI_cbind_CopyBladeStrMeshCoordsType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcBladeStrMeshCoordsTypeData%Position)) then + LB(1:2) = lbound(SrcBladeStrMeshCoordsTypeData%Position) + UB(1:2) = ubound(SrcBladeStrMeshCoordsTypeData%Position) + if (.not. allocated(DstBladeStrMeshCoordsTypeData%Position)) then + allocate(DstBladeStrMeshCoordsTypeData%Position(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeStrMeshCoordsTypeData%Position.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeStrMeshCoordsTypeData%Position = SrcBladeStrMeshCoordsTypeData%Position + end if + if (allocated(SrcBladeStrMeshCoordsTypeData%Orient)) then + LB(1:3) = lbound(SrcBladeStrMeshCoordsTypeData%Orient) + UB(1:3) = ubound(SrcBladeStrMeshCoordsTypeData%Orient) + if (.not. allocated(DstBladeStrMeshCoordsTypeData%Orient)) then + allocate(DstBladeStrMeshCoordsTypeData%Orient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeStrMeshCoordsTypeData%Orient.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeStrMeshCoordsTypeData%Orient = SrcBladeStrMeshCoordsTypeData%Orient + end if + if (allocated(SrcBladeStrMeshCoordsTypeData%Velocity)) then + LB(1:2) = lbound(SrcBladeStrMeshCoordsTypeData%Velocity) + UB(1:2) = ubound(SrcBladeStrMeshCoordsTypeData%Velocity) + if (.not. allocated(DstBladeStrMeshCoordsTypeData%Velocity)) then + allocate(DstBladeStrMeshCoordsTypeData%Velocity(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeStrMeshCoordsTypeData%Velocity.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeStrMeshCoordsTypeData%Velocity = SrcBladeStrMeshCoordsTypeData%Velocity + end if + if (allocated(SrcBladeStrMeshCoordsTypeData%Accln)) then + LB(1:2) = lbound(SrcBladeStrMeshCoordsTypeData%Accln) + UB(1:2) = ubound(SrcBladeStrMeshCoordsTypeData%Accln) + if (.not. allocated(DstBladeStrMeshCoordsTypeData%Accln)) then + allocate(DstBladeStrMeshCoordsTypeData%Accln(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeStrMeshCoordsTypeData%Accln.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeStrMeshCoordsTypeData%Accln = SrcBladeStrMeshCoordsTypeData%Accln + end if + if (allocated(SrcBladeStrMeshCoordsTypeData%Force)) then + LB(1:2) = lbound(SrcBladeStrMeshCoordsTypeData%Force) + UB(1:2) = ubound(SrcBladeStrMeshCoordsTypeData%Force) + if (.not. allocated(DstBladeStrMeshCoordsTypeData%Force)) then + allocate(DstBladeStrMeshCoordsTypeData%Force(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeStrMeshCoordsTypeData%Force.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeStrMeshCoordsTypeData%Force = SrcBladeStrMeshCoordsTypeData%Force + end if +end subroutine + +subroutine ADI_cbind_DestroyBladeStrMeshCoordsType(BladeStrMeshCoordsTypeData, ErrStat, ErrMsg) + type(BladeStrMeshCoordsType), intent(inout) :: BladeStrMeshCoordsTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ADI_cbind_DestroyBladeStrMeshCoordsType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BladeStrMeshCoordsTypeData%Position)) then + deallocate(BladeStrMeshCoordsTypeData%Position) + end if + if (allocated(BladeStrMeshCoordsTypeData%Orient)) then + deallocate(BladeStrMeshCoordsTypeData%Orient) + end if + if (allocated(BladeStrMeshCoordsTypeData%Velocity)) then + deallocate(BladeStrMeshCoordsTypeData%Velocity) + end if + if (allocated(BladeStrMeshCoordsTypeData%Accln)) then + deallocate(BladeStrMeshCoordsTypeData%Accln) + end if + if (allocated(BladeStrMeshCoordsTypeData%Force)) then + deallocate(BladeStrMeshCoordsTypeData%Force) + end if +end subroutine + +subroutine ADI_cbind_PackBladeStrMeshCoordsType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BladeStrMeshCoordsType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_cbind_PackBladeStrMeshCoordsType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Position) + call RegPackAlloc(RF, InData%Orient) + call RegPackAlloc(RF, InData%Velocity) + call RegPackAlloc(RF, InData%Accln) + call RegPackAlloc(RF, InData%Force) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_cbind_UnPackBladeStrMeshCoordsType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BladeStrMeshCoordsType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_cbind_UnPackBladeStrMeshCoordsType' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Position); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Orient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Velocity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Accln); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Force); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_cbind_CopyStrucPtsToBladeMapType(SrcStrucPtsToBladeMapTypeData, DstStrucPtsToBladeMapTypeData, CtrlCode, ErrStat, ErrMsg) + type(StrucPtsToBladeMapType), intent(in) :: SrcStrucPtsToBladeMapTypeData + type(StrucPtsToBladeMapType), intent(inout) :: DstStrucPtsToBladeMapTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_cbind_CopyStrucPtsToBladeMapType' + ErrStat = ErrID_None + ErrMsg = '' + DstStrucPtsToBladeMapTypeData%NumBlades = SrcStrucPtsToBladeMapTypeData%NumBlades + if (allocated(SrcStrucPtsToBladeMapTypeData%NumMeshPtsPerBlade)) then + LB(1:1) = lbound(SrcStrucPtsToBladeMapTypeData%NumMeshPtsPerBlade) + UB(1:1) = ubound(SrcStrucPtsToBladeMapTypeData%NumMeshPtsPerBlade) + if (.not. allocated(DstStrucPtsToBladeMapTypeData%NumMeshPtsPerBlade)) then + allocate(DstStrucPtsToBladeMapTypeData%NumMeshPtsPerBlade(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstStrucPtsToBladeMapTypeData%NumMeshPtsPerBlade.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstStrucPtsToBladeMapTypeData%NumMeshPtsPerBlade = SrcStrucPtsToBladeMapTypeData%NumMeshPtsPerBlade + end if + if (allocated(SrcStrucPtsToBladeMapTypeData%MeshPt_2_BladeNum)) then + LB(1:1) = lbound(SrcStrucPtsToBladeMapTypeData%MeshPt_2_BladeNum) + UB(1:1) = ubound(SrcStrucPtsToBladeMapTypeData%MeshPt_2_BladeNum) + if (.not. allocated(DstStrucPtsToBladeMapTypeData%MeshPt_2_BladeNum)) then + allocate(DstStrucPtsToBladeMapTypeData%MeshPt_2_BladeNum(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstStrucPtsToBladeMapTypeData%MeshPt_2_BladeNum.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstStrucPtsToBladeMapTypeData%MeshPt_2_BladeNum = SrcStrucPtsToBladeMapTypeData%MeshPt_2_BladeNum + end if + if (allocated(SrcStrucPtsToBladeMapTypeData%BladeNode_2_MeshPt)) then + LB(1:1) = lbound(SrcStrucPtsToBladeMapTypeData%BladeNode_2_MeshPt) + UB(1:1) = ubound(SrcStrucPtsToBladeMapTypeData%BladeNode_2_MeshPt) + if (.not. allocated(DstStrucPtsToBladeMapTypeData%BladeNode_2_MeshPt)) then + allocate(DstStrucPtsToBladeMapTypeData%BladeNode_2_MeshPt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstStrucPtsToBladeMapTypeData%BladeNode_2_MeshPt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADI_cbind_CopyBladeNodeToMeshPointMapType(SrcStrucPtsToBladeMapTypeData%BladeNode_2_MeshPt(i1), DstStrucPtsToBladeMapTypeData%BladeNode_2_MeshPt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcStrucPtsToBladeMapTypeData%BladeStrMeshCoords)) then + LB(1:1) = lbound(SrcStrucPtsToBladeMapTypeData%BladeStrMeshCoords) + UB(1:1) = ubound(SrcStrucPtsToBladeMapTypeData%BladeStrMeshCoords) + if (.not. allocated(DstStrucPtsToBladeMapTypeData%BladeStrMeshCoords)) then + allocate(DstStrucPtsToBladeMapTypeData%BladeStrMeshCoords(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstStrucPtsToBladeMapTypeData%BladeStrMeshCoords.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADI_cbind_CopyBladeStrMeshCoordsType(SrcStrucPtsToBladeMapTypeData%BladeStrMeshCoords(i1), DstStrucPtsToBladeMapTypeData%BladeStrMeshCoords(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine ADI_cbind_DestroyStrucPtsToBladeMapType(StrucPtsToBladeMapTypeData, ErrStat, ErrMsg) + type(StrucPtsToBladeMapType), intent(inout) :: StrucPtsToBladeMapTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_cbind_DestroyStrucPtsToBladeMapType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(StrucPtsToBladeMapTypeData%NumMeshPtsPerBlade)) then + deallocate(StrucPtsToBladeMapTypeData%NumMeshPtsPerBlade) + end if + if (allocated(StrucPtsToBladeMapTypeData%MeshPt_2_BladeNum)) then + deallocate(StrucPtsToBladeMapTypeData%MeshPt_2_BladeNum) + end if + if (allocated(StrucPtsToBladeMapTypeData%BladeNode_2_MeshPt)) then + LB(1:1) = lbound(StrucPtsToBladeMapTypeData%BladeNode_2_MeshPt) + UB(1:1) = ubound(StrucPtsToBladeMapTypeData%BladeNode_2_MeshPt) + do i1 = LB(1), UB(1) + call ADI_cbind_DestroyBladeNodeToMeshPointMapType(StrucPtsToBladeMapTypeData%BladeNode_2_MeshPt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(StrucPtsToBladeMapTypeData%BladeNode_2_MeshPt) + end if + if (allocated(StrucPtsToBladeMapTypeData%BladeStrMeshCoords)) then + LB(1:1) = lbound(StrucPtsToBladeMapTypeData%BladeStrMeshCoords) + UB(1:1) = ubound(StrucPtsToBladeMapTypeData%BladeStrMeshCoords) + do i1 = LB(1), UB(1) + call ADI_cbind_DestroyBladeStrMeshCoordsType(StrucPtsToBladeMapTypeData%BladeStrMeshCoords(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(StrucPtsToBladeMapTypeData%BladeStrMeshCoords) + end if +end subroutine + +subroutine ADI_cbind_PackStrucPtsToBladeMapType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(StrucPtsToBladeMapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_cbind_PackStrucPtsToBladeMapType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumBlades) + call RegPackAlloc(RF, InData%NumMeshPtsPerBlade) + call RegPackAlloc(RF, InData%MeshPt_2_BladeNum) + call RegPack(RF, allocated(InData%BladeNode_2_MeshPt)) + if (allocated(InData%BladeNode_2_MeshPt)) then + call RegPackBounds(RF, 1, lbound(InData%BladeNode_2_MeshPt), ubound(InData%BladeNode_2_MeshPt)) + LB(1:1) = lbound(InData%BladeNode_2_MeshPt) + UB(1:1) = ubound(InData%BladeNode_2_MeshPt) + do i1 = LB(1), UB(1) + call ADI_cbind_PackBladeNodeToMeshPointMapType(RF, InData%BladeNode_2_MeshPt(i1)) + end do + end if + call RegPack(RF, allocated(InData%BladeStrMeshCoords)) + if (allocated(InData%BladeStrMeshCoords)) then + call RegPackBounds(RF, 1, lbound(InData%BladeStrMeshCoords), ubound(InData%BladeStrMeshCoords)) + LB(1:1) = lbound(InData%BladeStrMeshCoords) + UB(1:1) = ubound(InData%BladeStrMeshCoords) + do i1 = LB(1), UB(1) + call ADI_cbind_PackBladeStrMeshCoordsType(RF, InData%BladeStrMeshCoords(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_cbind_UnPackStrucPtsToBladeMapType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(StrucPtsToBladeMapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_cbind_UnPackStrucPtsToBladeMapType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NumMeshPtsPerBlade); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MeshPt_2_BladeNum); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BladeNode_2_MeshPt)) deallocate(OutData%BladeNode_2_MeshPt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeNode_2_MeshPt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeNode_2_MeshPt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADI_cbind_UnpackBladeNodeToMeshPointMapType(RF, OutData%BladeNode_2_MeshPt(i1)) ! BladeNode_2_MeshPt + end do + end if + if (allocated(OutData%BladeStrMeshCoords)) deallocate(OutData%BladeStrMeshCoords) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeStrMeshCoords(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeStrMeshCoords.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADI_cbind_UnpackBladeStrMeshCoordsType(RF, OutData%BladeStrMeshCoords(i1)) ! BladeStrMeshCoords + end do + end if +end subroutine + +subroutine ADI_cbind_CopyMeshByBladeType(SrcMeshByBladeTypeData, DstMeshByBladeTypeData, CtrlCode, ErrStat, ErrMsg) + type(MeshByBladeType), intent(inout) :: SrcMeshByBladeTypeData + type(MeshByBladeType), intent(inout) :: DstMeshByBladeTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_cbind_CopyMeshByBladeType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMeshByBladeTypeData%BldMesh)) then + LB(1:1) = lbound(SrcMeshByBladeTypeData%BldMesh) + UB(1:1) = ubound(SrcMeshByBladeTypeData%BldMesh) + if (.not. allocated(DstMeshByBladeTypeData%BldMesh)) then + allocate(DstMeshByBladeTypeData%BldMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshByBladeTypeData%BldMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcMeshByBladeTypeData%BldMesh(i1), DstMeshByBladeTypeData%BldMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine ADI_cbind_DestroyMeshByBladeType(MeshByBladeTypeData, ErrStat, ErrMsg) + type(MeshByBladeType), intent(inout) :: MeshByBladeTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_cbind_DestroyMeshByBladeType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MeshByBladeTypeData%BldMesh)) then + LB(1:1) = lbound(MeshByBladeTypeData%BldMesh) + UB(1:1) = ubound(MeshByBladeTypeData%BldMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( MeshByBladeTypeData%BldMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MeshByBladeTypeData%BldMesh) + end if +end subroutine + +subroutine ADI_cbind_PackMeshByBladeType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MeshByBladeType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_cbind_PackMeshByBladeType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%BldMesh)) + if (allocated(InData%BldMesh)) then + call RegPackBounds(RF, 1, lbound(InData%BldMesh), ubound(InData%BldMesh)) + LB(1:1) = lbound(InData%BldMesh) + UB(1:1) = ubound(InData%BldMesh) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BldMesh(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_cbind_UnPackMeshByBladeType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MeshByBladeType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_cbind_UnPackMeshByBladeType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%BldMesh)) deallocate(OutData%BldMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BldMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BldMesh(i1)) ! BldMesh + end do + end if +end subroutine +END MODULE AeroDyn_Inflow_C_Binding_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt b/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt index 678ea45947..ffd1e56cb2 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt @@ -26,21 +26,25 @@ typedef ^ ^ InflowWind_ParameterType p typedef ^ ^ InflowWind_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ InflowWind_InputType u - - - "Array of inputs associated with InputTimes" typedef ^ ^ InflowWind_OutputType y - - - "System outputs" -typedef ^ ^ IntKi CompInflow - - - "0=Steady Wind, 1=InflowWind" "-" +typedef ^ ^ IntKi CompInflow - - - "0=Steady Wind, 1=InflowWind, 2=External IfW (ADI c-bind only)" "-" typedef ^ ^ ReKi HWindSpeed - - - "RefHeight Wind speed" typedef ^ ^ ReKi RefHt - - - "RefHeight" typedef ^ ^ ReKi PLExp - - - "PLExp" # ..... InflowWind Input data ..................................................................................................... typedef ^ ADI_IW_InputData Character(1024) InputFile - - - "Name of InfloWind input file" - -typedef ^ ^ IntKi CompInflow - - - "0=Steady Wind, 1=InflowWind" "-" +typedef ^ ^ IntKi CompInflow - - - "0=Steady Wind, 1=InflowWind, 2=External IfW (ADI c-bind only)" "-" typedef ^ ^ ReKi HWindSpeed - - - "RefHeight Wind speed" typedef ^ ^ ReKi RefHt - - - "RefHeight" typedef ^ ^ ReKi PLExp - - - "PLExp" typedef ^ ^ IntKi MHK - - - "MHK turbine type switch" - +typedef ^ ^ ReKi WtrDpth - - - "Water depth" m +typedef ^ ^ ReKi MSL2SWL - - - "Offset between still-water level and mean sea level" m typedef ^ ^ IntKi FilePassingMethod - 0 - "Should we read everthing from an input file (0), passed in as a FileInfoType structure (1), or passed as the IfW_InputFile structure (2)" - typedef ^ ^ FileInfoType PassedFileInfo - - - "If we don't use the input file, pass everything through this as a FileInfo structure" - typedef ^ ^ InflowWind_InputFile PassedFileData - - - "If we don't use the input file, pass everything through this as an IfW InputFile structure" - typedef ^ ^ LOGICAL Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - +typedef ^ ^ LOGICAL OutputAccel - .FALSE. - "Flag to output wind acceleration" - + # ..... InitIn .................................................................................................................... @@ -51,6 +55,8 @@ typedef ^ ^ Logical storeHHV typedef ^ ^ IntKi WrVTK - 0 - "0= no vtk, 1=init only, 2=animation" "-" typedef ^ ^ IntKi WrVTK_Type - 1 - "Flag for VTK output type (1=surface, 2=line, 3=both)" - typedef ^ ^ ReKi WtrDpth - - - "Water depth" m +typedef ^ ^ FlowFieldType *FlowField - - - "Pointer of InflowWinds flow field data type (from external IfW instance -- used with c-binding)" - + # ..... InitOut ................................................................................................................... typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index 295764d98a..c50a2238e8 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -45,7 +45,7 @@ MODULE AeroDyn_Inflow_Types TYPE(InflowWind_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(InflowWind_InputType) :: u !< Array of inputs associated with InputTimes [-] TYPE(InflowWind_OutputType) :: y !< System outputs [-] - INTEGER(IntKi) :: CompInflow = 0_IntKi !< 0=Steady Wind, 1=InflowWind [-] + INTEGER(IntKi) :: CompInflow = 0_IntKi !< 0=Steady Wind, 1=InflowWind, 2=External IfW (ADI c-bind only) [-] REAL(ReKi) :: HWindSpeed = 0.0_ReKi !< RefHeight Wind speed [-] REAL(ReKi) :: RefHt = 0.0_ReKi !< RefHeight [-] REAL(ReKi) :: PLExp = 0.0_ReKi !< PLExp [-] @@ -54,15 +54,18 @@ MODULE AeroDyn_Inflow_Types ! ========= ADI_IW_InputData ======= TYPE, PUBLIC :: ADI_IW_InputData Character(1024) :: InputFile !< Name of InfloWind input file [-] - INTEGER(IntKi) :: CompInflow = 0_IntKi !< 0=Steady Wind, 1=InflowWind [-] + INTEGER(IntKi) :: CompInflow = 0_IntKi !< 0=Steady Wind, 1=InflowWind, 2=External IfW (ADI c-bind only) [-] REAL(ReKi) :: HWindSpeed = 0.0_ReKi !< RefHeight Wind speed [-] REAL(ReKi) :: RefHt = 0.0_ReKi !< RefHeight [-] REAL(ReKi) :: PLExp = 0.0_ReKi !< PLExp [-] INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] INTEGER(IntKi) :: FilePassingMethod = 0 !< Should we read everthing from an input file (0), passed in as a FileInfoType structure (1), or passed as the IfW_InputFile structure (2) [-] TYPE(FileInfoType) :: PassedFileInfo !< If we don't use the input file, pass everything through this as a FileInfo structure [-] TYPE(InflowWind_InputFile) :: PassedFileData !< If we don't use the input file, pass everything through this as an IfW InputFile structure [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] + LOGICAL :: OutputAccel = .FALSE. !< Flag to output wind acceleration [-] END TYPE ADI_IW_InputData ! ======================= ! ========= ADI_InitInputType ======= @@ -74,6 +77,7 @@ MODULE AeroDyn_Inflow_Types INTEGER(IntKi) :: WrVTK = 0 !< 0= no vtk, 1=init only, 2=animation [-] INTEGER(IntKi) :: WrVTK_Type = 1 !< Flag for VTK output type (1=surface, 2=line, 3=both) [-] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Pointer of InflowWinds flow field data type (from external IfW instance -- used with c-binding) [-] END TYPE ADI_InitInputType ! ======================= ! ========= ADI_InitOutputType ======= @@ -301,6 +305,8 @@ subroutine ADI_CopyIW_InputData(SrcIW_InputDataData, DstIW_InputDataData, CtrlCo DstIW_InputDataData%RefHt = SrcIW_InputDataData%RefHt DstIW_InputDataData%PLExp = SrcIW_InputDataData%PLExp DstIW_InputDataData%MHK = SrcIW_InputDataData%MHK + DstIW_InputDataData%WtrDpth = SrcIW_InputDataData%WtrDpth + DstIW_InputDataData%MSL2SWL = SrcIW_InputDataData%MSL2SWL DstIW_InputDataData%FilePassingMethod = SrcIW_InputDataData%FilePassingMethod call NWTC_Library_CopyFileInfoType(SrcIW_InputDataData%PassedFileInfo, DstIW_InputDataData%PassedFileInfo, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -309,6 +315,7 @@ subroutine ADI_CopyIW_InputData(SrcIW_InputDataData, DstIW_InputDataData, CtrlCo call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstIW_InputDataData%Linearize = SrcIW_InputDataData%Linearize + DstIW_InputDataData%OutputAccel = SrcIW_InputDataData%OutputAccel end subroutine subroutine ADI_DestroyIW_InputData(IW_InputDataData, ErrStat, ErrMsg) @@ -337,10 +344,13 @@ subroutine ADI_PackIW_InputData(RF, Indata) call RegPack(RF, InData%RefHt) call RegPack(RF, InData%PLExp) call RegPack(RF, InData%MHK) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%MSL2SWL) call RegPack(RF, InData%FilePassingMethod) call NWTC_Library_PackFileInfoType(RF, InData%PassedFileInfo) call InflowWind_PackInputFile(RF, InData%PassedFileData) call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%OutputAccel) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -355,10 +365,13 @@ subroutine ADI_UnPackIW_InputData(RF, OutData) call RegUnpack(RF, OutData%RefHt); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%PLExp); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%FilePassingMethod); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedFileInfo) ! PassedFileInfo call InflowWind_UnpackInputFile(RF, OutData%PassedFileData) ! PassedFileData call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutputAccel); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ADI_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -367,6 +380,7 @@ subroutine ADI_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(0), UB(0) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_CopyInitInput' @@ -383,6 +397,7 @@ subroutine ADI_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%WrVTK = SrcInitInputData%WrVTK DstInitInputData%WrVTK_Type = SrcInitInputData%WrVTK_Type DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%FlowField => SrcInitInputData%FlowField end subroutine subroutine ADI_DestroyInitInput(InitInputData, ErrStat, ErrMsg) @@ -398,12 +413,14 @@ subroutine ADI_DestroyInitInput(InitInputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call ADI_DestroyIW_InputData(InitInputData%IW_InitInp, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitInputData%FlowField) end subroutine subroutine ADI_PackInitInput(RF, Indata) type(RegFile), intent(inout) :: RF type(ADI_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackInitInput' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call AD_PackInitInput(RF, InData%AD) call ADI_PackIW_InputData(RF, InData%IW_InitInp) @@ -412,6 +429,13 @@ subroutine ADI_PackInitInput(RF, Indata) call RegPack(RF, InData%WrVTK) call RegPack(RF, InData%WrVTK_Type) call RegPack(RF, InData%WtrDpth) + call RegPack(RF, associated(InData%FlowField)) + if (associated(InData%FlowField)) then + call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) + end if + end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -419,6 +443,11 @@ subroutine ADI_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(ADI_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackInitInput' + integer(B4Ki) :: LB(0), UB(0) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call AD_UnpackInitInput(RF, OutData%AD) ! AD call ADI_UnpackIW_InputData(RF, OutData%IW_InitInp) ! IW_InitInp @@ -427,6 +456,24 @@ subroutine ADI_UnPackInitInput(RF, OutData) call RegUnpack(RF, OutData%WrVTK); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%WrVTK_Type); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%FlowField)) deallocate(OutData%FlowField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%FlowField) + else + allocate(OutData%FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField + end if + else + OutData%FlowField => null() + end if end subroutine subroutine ADI_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 9060a08859..d88fcb9473 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -253,7 +253,6 @@ typedef ^ AD_InputFile RotInputFile rotors {:} - - "Rotor (blades and tower # ..... States .................................................................................................................... # Define continuous (differentiable) states here: typedef ^ RotContinuousStateType BEMT_ContinuousStateType BEMT - - - "Continuous states from the BEMT module" - -typedef ^ RotContinuousStateType AA_ContinuousStateType AA - - - "Continuous states from the AA module" - typedef ^ ContinuousStateType RotContinuousStateType rotors {:} - - "Continuous states for each rotor" - typedef ^ ContinuousStateType FVW_ContinuousStateType FVW - - - "Continuous states from the FVW module" - @@ -268,7 +267,6 @@ typedef ^ DiscreteStateType FVW_DiscreteStateType FVW - - - "Discrete states fro # Define constraint states here: typedef ^ RotConstraintStateType BEMT_ConstraintStateType BEMT - - - "Constraint states from the BEMT module" - -typedef ^ RotConstraintStateType AA_ConstraintStateType AA - - - "Constraint states from the AA module" - typedef ^ ConstraintStateType RotConstraintStateType rotors {:} - - "Constraint states for each rotor" - typedef ^ ConstraintStateType FVW_ConstraintStateType FVW - - - "Constraint states from the FVW module" - diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 68cc48710c..19a004baa0 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -273,7 +273,6 @@ MODULE AeroDyn_Types ! ========= RotContinuousStateType ======= TYPE, PUBLIC :: RotContinuousStateType TYPE(BEMT_ContinuousStateType) :: BEMT !< Continuous states from the BEMT module [-] - TYPE(AA_ContinuousStateType) :: AA !< Continuous states from the AA module [-] END TYPE RotContinuousStateType ! ======================= ! ========= AD_ContinuousStateType ======= @@ -297,7 +296,6 @@ MODULE AeroDyn_Types ! ========= RotConstraintStateType ======= TYPE, PUBLIC :: RotConstraintStateType TYPE(BEMT_ConstraintStateType) :: BEMT !< Constraint states from the BEMT module [-] - TYPE(AA_ConstraintStateType) :: AA !< Constraint states from the AA module [-] END TYPE RotConstraintStateType ! ======================= ! ========= AD_ConstraintStateType ======= @@ -2446,9 +2444,6 @@ subroutine AD_CopyRotContinuousStateType(SrcRotContinuousStateTypeData, DstRotCo call BEMT_CopyContState(SrcRotContinuousStateTypeData%BEMT, DstRotContinuousStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call AA_CopyContState(SrcRotContinuousStateTypeData%AA, DstRotContinuousStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end subroutine subroutine AD_DestroyRotContinuousStateType(RotContinuousStateTypeData, ErrStat, ErrMsg) @@ -2462,8 +2457,6 @@ subroutine AD_DestroyRotContinuousStateType(RotContinuousStateTypeData, ErrStat, ErrMsg = '' call BEMT_DestroyContState(RotContinuousStateTypeData%BEMT, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AA_DestroyContState(RotContinuousStateTypeData%AA, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_PackRotContinuousStateType(RF, Indata) @@ -2472,7 +2465,6 @@ subroutine AD_PackRotContinuousStateType(RF, Indata) character(*), parameter :: RoutineName = 'AD_PackRotContinuousStateType' if (RF%ErrStat >= AbortErrLev) return call BEMT_PackContState(RF, InData%BEMT) - call AA_PackContState(RF, InData%AA) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -2482,7 +2474,6 @@ subroutine AD_UnPackRotContinuousStateType(RF, OutData) character(*), parameter :: RoutineName = 'AD_UnPackRotContinuousStateType' if (RF%ErrStat /= ErrID_None) return call BEMT_UnpackContState(RF, OutData%BEMT) ! BEMT - call AA_UnpackContState(RF, OutData%AA) ! AA end subroutine subroutine AD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -2758,9 +2749,6 @@ subroutine AD_CopyRotConstraintStateType(SrcRotConstraintStateTypeData, DstRotCo call BEMT_CopyConstrState(SrcRotConstraintStateTypeData%BEMT, DstRotConstraintStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call AA_CopyConstrState(SrcRotConstraintStateTypeData%AA, DstRotConstraintStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end subroutine subroutine AD_DestroyRotConstraintStateType(RotConstraintStateTypeData, ErrStat, ErrMsg) @@ -2774,8 +2762,6 @@ subroutine AD_DestroyRotConstraintStateType(RotConstraintStateTypeData, ErrStat, ErrMsg = '' call BEMT_DestroyConstrState(RotConstraintStateTypeData%BEMT, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AA_DestroyConstrState(RotConstraintStateTypeData%AA, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_PackRotConstraintStateType(RF, Indata) @@ -2784,7 +2770,6 @@ subroutine AD_PackRotConstraintStateType(RF, Indata) character(*), parameter :: RoutineName = 'AD_PackRotConstraintStateType' if (RF%ErrStat >= AbortErrLev) return call BEMT_PackConstrState(RF, InData%BEMT) - call AA_PackConstrState(RF, InData%AA) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -2794,7 +2779,6 @@ subroutine AD_UnPackRotConstraintStateType(RF, OutData) character(*), parameter :: RoutineName = 'AD_UnPackRotConstraintStateType' if (RF%ErrStat /= ErrID_None) return call BEMT_UnpackConstrState(RF, OutData%BEMT) ! BEMT - call AA_UnpackConstrState(RF, OutData%AA) ! AA end subroutine subroutine AD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/aerodyn/src/AirfoilInfo.f90 b/modules/aerodyn/src/AirfoilInfo.f90 index b00886b7da..bd4409c627 100644 --- a/modules/aerodyn/src/AirfoilInfo.f90 +++ b/modules/aerodyn/src/AirfoilInfo.f90 @@ -1745,12 +1745,7 @@ subroutine AFI_ComputeAirfoilCoefs1D( AOA, p, AFI_interp, errStat, errMsg, Table ! Spline interpolation of lower table based on requested AOA - - IntAFCoefs(1:s1) = CubicSplineInterpM( Alpha & - , p%Table(iTab)%Alpha & - , p%Table(iTab)%Coefs & - , p%Table(iTab)%SplineCoefs & - , ErrStat, ErrMsg ) + CALL CubicSplineInterpM( Alpha, p%Table(iTab)%Alpha, p%Table(iTab)%Coefs, p%Table(iTab)%SplineCoefs, IntAFCoefs(1:s1) ) end if AFI_interp%Cl = IntAFCoefs(p%ColCl) diff --git a/modules/awae/src/AWAE.f90 b/modules/awae/src/AWAE.f90 index f8b4b5d791..d2a77cd576 100644 --- a/modules/awae/src/AWAE.f90 +++ b/modules/awae/src/AWAE.f90 @@ -380,6 +380,7 @@ subroutine LowResGridCalcOutput(n, u, p, xd, y, m, errStat, errMsg) integer(IntKi) :: maxN_wake integer(IntKi) :: WAT_iT,WAT_iY,WAT_iZ !< indexes for WAT point (Time interchangeable with X) integer(IntKi) :: errStat2 + character(ErrMsgLen):: errMsg2 character(*), parameter :: RoutineName = 'LowResGridCalcOutput' logical :: within real(ReKi) :: yHat_plane(3), zHat_plane(3) @@ -507,15 +508,6 @@ subroutine LowResGridCalcOutput(n, u, p, xd, y, m, errStat, errMsg) ELSE ! All subsequent calls to AWAE_CalcOutput - ! Warn our kind users if wake planes leave the low-resolution domain: - if ( u%p_plane(1,np,nt) < p%Grid_Low(1, 1) ) call SetErrStat(ErrID_Warn, 'The center of wake plane #'//trim(num2lstr(np))//' for turbine #'//trim(num2lstr(nt))//' has passed the lowest-most X boundary of the low-resolution domain.', errStat, errMsg, RoutineName) - if ( u%p_plane(1,np,nt) > p%Grid_Low(1,p%NumGrid_low) ) call SetErrStat(ErrID_Warn, 'The center of wake plane #'//trim(num2lstr(np))//' for turbine #'//trim(num2lstr(nt))//' has passed the upper-most X boundary of the low-resolution domain.' , errStat, errMsg, RoutineName) - if ( u%p_plane(2,np,nt) < p%Grid_Low(2, 1) ) call SetErrStat(ErrID_Warn, 'The center of wake plane #'//trim(num2lstr(np))//' for turbine #'//trim(num2lstr(nt))//' has passed the lowest-most Y boundary of the low-resolution domain.', errStat, errMsg, RoutineName) - if ( u%p_plane(2,np,nt) > p%Grid_Low(2,p%NumGrid_low) ) call SetErrStat(ErrID_Warn, 'The center of wake plane #'//trim(num2lstr(np))//' for turbine #'//trim(num2lstr(nt))//' has passed the upper-most Y boundary of the low-resolution domain.' , errStat, errMsg, RoutineName) - if ( u%p_plane(3,np,nt) < p%Grid_Low(3, 1) ) call SetErrStat(ErrID_Warn, 'The center of wake plane #'//trim(num2lstr(np))//' for turbine #'//trim(num2lstr(nt))//' has passed the lowest-most Z boundary of the low-resolution domain.', errStat, errMsg, RoutineName) - if ( u%p_plane(3,np,nt) > p%Grid_Low(3,p%NumGrid_low) ) call SetErrStat(ErrID_Warn, 'The center of wake plane #'//trim(num2lstr(np))//' for turbine #'//trim(num2lstr(nt))//' has passed the upper-most Z boundary of the low-resolution domain.' , errStat, errMsg, RoutineName) - - xplane_sq = u%xhat_plane(1,np,nt)**2.0_ReKi yplane_sq = u%xhat_plane(2,np,nt)**2.0_ReKi xysq_Z = (/0.0_ReKi, 0.0_ReKi, xplane_sq+yplane_sq/) @@ -587,6 +579,14 @@ subroutine LowResGridCalcOutput(n, u, p, xd, y, m, errStat, errMsg) wsum_tmp = 0.0_ReKi n_r_polar = FLOOR((p%C_ScaleDiam*u%D_wake(np,nt))/p%dpol) + ! if a wake plane exits domain, velocity is set differently, so skip remaining velocity logic after this + ! - no messages if inside bounds, so put error handling inside if + call PlaneOutOfDomain(u%D_wake(np,nt),u%p_plane(:,np,nt),y%V_plane(:,np,nt),m%planeDomainExit(np,nt),ErrStat2,ErrMsg2) + if (m%planeDomainExit(np,nt) /= 0_IntKi) then + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + cycle + endif + do nr = 0, n_r_polar r_polar = REAL(nr,ReKi)*p%dpol @@ -631,6 +631,103 @@ subroutine LowResGridCalcOutput(n, u, p, xd, y, m, errStat, errMsg) if (allocated(wk_V)) deallocate(wk_V) if (allocated(wk_WAT_k)) deallocate(wk_WAT_k) +contains + + !> Check if the center of this wwake plane has left the domain. + !! If a plane exits the domain, or previously exited the domain: + !! - Set warning about first time this plane leaves. + !! - Set component perpendicular to plane exit direction to kick it outside the domain entirely + !! - Target distance outside boundary = D. Use a quadratic asymptotic distance per step to approach target distance. + !! - Add background flow in X or Y to keep the plane moving with others parallel to boundary it crossed (only using X and Y velocity) + !! NOTE: using m%planeDomainExit to track which boundary a plane crossed. + !! 0: Still in domain + !! +/-1: +/-X + !! +/-2: +/-Y + !! +/-3: +/-Z + !! To understand intent, consider 2 cases for mean velocity in +X direction: + !! plane exits +Y boundary: + !! 1. plane with get a kick towards one wake diameter outside +Y boundary + !! 2. overall farm velocity added to keep plane drifting in +X following the target Y location (some jitter due to farm level Y velocity term) + !! plane exits +X boundary (travels beyond domain end in direction of overall flow) + !! 1. plane will get a kick outside the end of the domain towards +X boundary plus wake diameter + !! 2. farm velocity added will keep trying to push this plane further downstream, but step 1. will try to force it back. + !! --> effectively 1. and 2. will constant be working against each other to hold the plane somewhere near the target location beyond +X boundary, + !! but this shouldn't really matter as the plane will get dropped at some point. Even if multiple planes end up there, it shouldn't affect + !! any planes still in bounds -- so we really don't care if it jitters around at all + subroutine PlaneOutOfDomain(D_Wake,p_plane,V_plane,planeDomainExit,ErrStat3,ErrMsg3) + real(ReKi), intent(in ) :: D_wake !< u%D_wake(np,nt) + real(ReKi), intent(in ) :: p_plane(3) !< u%p_plane(:,np,nt) + real(ReKi), intent(inout) :: V_plane(3) !< y%V_plane(:,np,nt) + integer(IntKi), intent(inout) :: planeDomainExit !< m%planeDomainExit(np,nt) + integer(IntKi), intent( out) :: ErrStat3 !< Error status of the operation + character(ErrMsgLen), intent( out) :: ErrMsg3 !< Error message if errStat /= ErrID_None + character(12) :: tmpStr12 !< for constructing error message + real(ReKi) :: D_tgt !< target distance outside bounds + ! Step 1: did a plane that was in the low res domain just cross out? + ! If plane crossed boundary, set message and tracking of it + if (planeDomainExit == 0_IntKi) then + if (p_plane(1) < p%Grid_Low(1,1) ) then ! lower x boundary + ErrStat3 = ErrID_Warn + tmpStr12 = 'lower-most X' + planeDomainExit = -1 + elseif ( p_plane(1) > p%Grid_Low(1,p%NumGrid_low) ) then ! upper x boundary + ErrStat3 = ErrID_Warn + tmpStr12 = 'upper-most X' + planeDomainExit = 1 + elseif ( p_plane(2) < p%Grid_Low(2,1) ) then ! lower y boundary + ErrStat3 = ErrID_Warn + tmpStr12 = 'lower-most Y' + planeDomainExit = -2 + elseif ( p_plane(2) > p%Grid_Low(2,p%NumGrid_low) ) then ! upper y boundary + ErrStat3 = ErrID_Warn + tmpStr12 = 'upper-most Y' + planeDomainExit = 2 + elseif ( p_plane(3) < p%Grid_Low(3,1) ) then ! lower z boundary + ErrStat3 = ErrID_Warn + tmpStr12 = 'lower-most Z' + planeDomainExit = -3 + elseif ( p_plane(3) > p%Grid_Low(3,p%NumGrid_low) ) then ! upper z boundary + ErrStat3 = ErrID_Warn + tmpStr12 = 'upper-most Z' + planeDomainExit = 3 + endif + if (errStat3 == ErrID_Warn) then + ErrMsg3 = 'The center of wake plane #'//trim(num2lstr(np))//' for turbine #'//trim(num2lstr(nt))//' has passed the ' & + //tmpStr12//' boundary of the low-resolution domain. Further warnings are suppressed.' + endif + endif + + ! Step 2: for planes outside boundary (including one that just crossed outside) set velocity component to approach target offset. + ! asymptotically approach a distance D_wake away from the boundary (quadratic approach) + ! example: V at -Y boundary: + ! Vy = (Y_target - Y_pos) / (2 * DT) + select case (planeDomainExit) + case (0_IntKi) + return + case (-1_IntKi) ! Crossed -X + D_tgt = p%Grid_Low(1,1) - D_wake + V_plane(1) = (D_tgt - p_plane(1)) / (2.0_ReKi * real(p%dt_low,ReKi)) ! push towards (-X_bound - D_wake) + case ( 1_IntKi) ! Crossed +X + D_tgt = p%Grid_Low(1,p%NumGrid_low) + D_wake + V_plane(1) = (D_tgt - p_plane(1)) / (2.0_ReKi * real(p%dt_low,ReKi)) ! push towards (+X_bound + D_wake) + case (-2_IntKi) ! Crossed -Y + D_tgt = p%Grid_Low(2,1) - D_wake + V_plane(2) = (D_tgt - p_plane(2)) / (2.0_ReKi * real(p%dt_low,ReKi)) ! push towards (-Y_bound - D_wake) + case ( 2_IntKi) ! Crossed +Y + D_tgt = p%Grid_Low(2,p%NumGrid_low) + D_wake + V_plane(2) = (D_tgt - p_plane(2)) / (2.0_ReKi * real(p%dt_low,ReKi)) ! push towards (-Y_bound - D_wake) + case (-3_IntKi) ! Crossed -Z + D_tgt = p%Grid_Low(3,1) - D_wake + V_plane(3) = (D_tgt - p_plane(3)) / (2.0_ReKi * real(p%dt_low,ReKi)) ! push towards (-Z_bound - D_wake) + case ( 3_IntKi) ! Crossed +Z + D_tgt = p%Grid_Low(3,p%NumGrid_low) + D_wake + V_plane(3) = (D_tgt - p_plane(3)) / (2.0_ReKi * real(p%dt_low,ReKi)) ! push towards (+Z_bound + D_wake) + end select + + ! Step 3: add background XYZ flow to keep plane drifting (will have already returned on any planes still in bounds) + V_plane(1:3) = V_plane(1:3) + xd%Ufarm(1:3) + + end subroutine PlaneOutOfDomain end subroutine LowResGridCalcOutput !---------------------------------------------------------------------------------------------------------------------------------- @@ -1004,26 +1101,35 @@ subroutine AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO ! Test the request output wind locations against grid information ! XY plane slices + call AllocAry(p%OutDisWindZvalid,p%NOutDisWindXY,'p%OutDisWindZvalid', ErrStat2, ErrMsg2); if(Failed()) return; + p%OutDisWindZvalid = .true. do i = 1,p%NOutDisWindXY gridLoc = (p%OutDisWindZ(i) - p%Z0_low) / p%dZ_low if ( ( gridLoc < 0.0_ReKi ) .or. ( gridLoc > real(p%nZ_low-1, ReKi) ) ) then - call SetErrStat(ErrID_Fatal, "The requested low-resolution XY output slice location, Z="//TRIM(Num2LStr(p%OutDisWindZ(i)))//", is outside of the low-resolution grid.", errStat, errMsg, RoutineName ) + call SetErrStat(ErrID_Warn, "The requested low-resolution XY output slice location, Z="//TRIM(Num2LStr(p%OutDisWindZ(i)))//", is outside of the low-resolution grid. Ignoring this slice.", errStat, errMsg, RoutineName ) + p%OutDisWindZvalid(i) = .false. end if end do ! XZ plane slices + call AllocAry(p%OutDisWindYvalid,p%NOutDisWindXZ,'p%OutDisWindYvalid', ErrStat2, ErrMsg2); if(Failed()) return; + p%OutDisWindYvalid = .true. do i = 1,p%NOutDisWindXZ gridLoc = (p%OutDisWindY(i) - p%Y0_low) / p%dY_low if ( ( gridLoc < 0.0_ReKi ) .or. ( gridLoc > real(p%nY_low-1, ReKi) ) ) then - call SetErrStat(ErrID_Fatal, "The requested low-resolution XZ output slice location, Y="//TRIM(Num2LStr(p%OutDisWindY(i)))//", is outside of the low-resolution grid.", errStat, errMsg, RoutineName ) + call SetErrStat(ErrID_Warn, "The requested low-resolution XZ output slice location, Y="//TRIM(Num2LStr(p%OutDisWindY(i)))//", is outside of the low-resolution grid. Ignoring this slice.", errStat, errMsg, RoutineName ) + p%OutDisWindYvalid(i) = .false. end if end do - ! XZ plane slices + ! YZ plane slices + call AllocAry(p%OutDisWindXvalid,p%NOutDisWindYZ,'p%OutDisWindXvalid', ErrStat2, ErrMsg2); if(Failed()) return; + p%OutDisWindXvalid = .true. do i = 1,p%NOutDisWindYZ gridLoc = (p%OutDisWindX(i) - p%X0_low) / p%dX_low if ( ( gridLoc < 0.0_ReKi ) .or. ( gridLoc > real(p%nX_low-1, ReKi) ) ) then - call SetErrStat(ErrID_Fatal, "The requested low-resolution YZ output slice location, X="//TRIM(Num2LStr(p%OutDisWindX(i)))//", is outside of the low-resolution grid.", errStat, errMsg, RoutineName ) + call SetErrStat(ErrID_Warn, "The requested low-resolution YZ output slice location, X="//TRIM(Num2LStr(p%OutDisWindX(i)))//", is outside of the low-resolution grid. Ignoring this slice.", errStat, errMsg, RoutineName ) + p%OutDisWindXvalid(i) = .false. end if end do if (errStat >= AbortErrLev) return @@ -1108,6 +1214,11 @@ subroutine AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO call AllocAry(m%V_amb_low_disk,3,p%NumTurbines,'m%V_amb_low_disk', ErrStat2, ErrMsg2); if(Failed()) return; m%V_amb_low_disk=0.0_ReKi ! IMPORTANT ALLOCATION. This misc var is not set before a low res calcoutput + ! track if a plan has left the domain (all planes start in domain). + ! Value indicates edge number (+/-1: +/-X, +/-2: +/-Y, +/-3: +/-Z) the plane crossed + allocate(m%planeDomainExit(0:p%NumPlanes-1,1:p%NumTurbines), STAT=ErrStat2); if (Failed0('m%planeDomainExit.')) return; + m%planeDomainExit = 0_IntKi + ! Read-in the ambient wind data for the initial calculate output call AWAE_UpdateStates( 0.0_DbKi, -1, u, p, x, xd, z, OtherState, m, errStat2, errMsg2 ); if(Failed()) return; @@ -1464,6 +1575,7 @@ subroutine AWAE_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, errStat, errMsg ! XY plane slices do k = 1,p%NOutDisWindXY + if (.not. p%OutDisWindZvalid(k)) cycle ! skip if invalid write(PlaneNumStr, '(i3.3)') k call ExtractSlice( XYSlice, p%OutDisWindZ(k), p%Z0_low, p%nZ_low, p%nX_low, p%nY_low, p%dZ_low, m%Vdist_low_full, m%outVizXYPlane(:,:,:,1)) ! Create the output vtk file with naming /Low/DisXY.t.vtk @@ -1474,6 +1586,7 @@ subroutine AWAE_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, errStat, errMsg ! YZ plane slices do k = 1,p%NOutDisWindYZ + if (.not. p%OutDisWindXvalid(k)) cycle ! skip if invalid write(PlaneNumStr, '(i3.3)') k call ExtractSlice( YZSlice, p%OutDisWindX(k), p%X0_low, p%nX_low, p%nY_low, p%nZ_low, p%dX_low, m%Vdist_low_full, m%outVizYZPlane(:,:,:,1)) ! Create the output vtk file with naming /Low/DisYZ.t.vtk @@ -1484,6 +1597,7 @@ subroutine AWAE_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, errStat, errMsg ! XZ plane slices do k = 1,p%NOutDisWindXZ + if (.not. p%OutDisWindYvalid(k)) cycle ! skip if invalid write(PlaneNumStr, '(i3.3)') k call ExtractSlice( XZSlice, p%OutDisWindY(k), p%Y0_low, p%nY_low, p%nX_low, p%nZ_low, p%dY_low, m%Vdist_low_full, m%outVizXZPlane(:,:,:,1)) ! Create the output vtk file with naming /Low/DisXZ.t.vtk diff --git a/modules/awae/src/AWAE_Registry.txt b/modules/awae/src/AWAE_Registry.txt index 33f909be29..e6afddb9d0 100644 --- a/modules/awae/src/AWAE_Registry.txt +++ b/modules/awae/src/AWAE_Registry.txt @@ -149,6 +149,7 @@ typedef ^ MiscVarType InflowWind_OutputType y_IfW_High - - - "InflowWin #wake added turbulence typedef ^ MiscVarType ReKi V_amb_low_disk {:}{:} - - "Rotor averaged ambiend wind speed for each wind turbine (3 x nWT)" m/s +typedef ^ MiscVarType IntKi planeDomainExit {:}{:} 0 - "Value indicates edge number (0: still in domain, +/-1: +/-X, +/-2: +/-Y, +/-3: +/-Z) the plane crossed" - # ..... Parameters ................................................................................................................ @@ -201,10 +202,13 @@ typedef ^ ParameterType IntKi WrDisSkp1 - - - "Number typedef ^ ParameterType LOGICAL WrDisWind - - - "Write disturbed wind data to /Low/Dis.t.vtk etc.?" - typedef ^ ParameterType IntKi NOutDisWindXY - - - "Number of XY planes for output of disturbed wind data across the low-resolution domain to /Low/DisXY..t.vtk [0 to 9]" - typedef ^ ParameterType ReKi OutDisWindZ {:} - - "Z coordinates of XY planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXY]" meters +typedef ^ ParameterType LOGICAL OutDisWindZvalid {:} - - "Valid XY planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXY]" - typedef ^ ParameterType IntKi NOutDisWindYZ - - - "Number of YZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisYZ..t.vtk [0 to 9]" - typedef ^ ParameterType ReKi OutDisWindX {:} - - "X coordinates of YZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindYZ]" meters +typedef ^ ParameterType LOGICAL OutDisWindXvalid {:} - - "Valid YZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindYZ]" - typedef ^ ParameterType IntKi NOutDisWindXZ - - - "Number of XZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisXZ..t.vtk [0 to 9]" - typedef ^ ParameterType ReKi OutDisWindY {:} - - "Y coordinates of XZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXZ]" meters +typedef ^ ParameterType LOGICAL OutDisWindYvalid {:} - - "Valid XZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXZ]" - typedef ^ ParameterType CHARACTER(1024) OutFileRoot - - - "The root name derived from the primary FAST.Farm input file" - typedef ^ ParameterType CHARACTER(1024) OutFileVTKRoot - - - "The root name for VTK outputs" - typedef ^ ParameterType IntKi VTK_tWidth - - - "Number of characters for VTK timestamp outputs" - diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index 06e9a5b90a..fbd5bde33a 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -173,6 +173,7 @@ MODULE AWAE_Types TYPE(InflowWind_OutputType) :: y_IfW_Low !< InflowWind module outputs for the low-resolution grid [-] TYPE(InflowWind_OutputType) :: y_IfW_High !< InflowWind module outputs for the high-resolution grid [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: V_amb_low_disk !< Rotor averaged ambiend wind speed for each wind turbine (3 x nWT) [m/s] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: planeDomainExit !< Value indicates edge number (0: still in domain, +/-1: +/-X, +/-2: +/-Y, +/-3: +/-Z) the plane crossed [-] END TYPE AWAE_MiscVarType ! ======================= ! ========= AWAE_ParameterType ======= @@ -222,10 +223,13 @@ MODULE AWAE_Types LOGICAL :: WrDisWind = .false. !< Write disturbed wind data to /Low/Dis.t.vtk etc.? [-] INTEGER(IntKi) :: NOutDisWindXY = 0_IntKi !< Number of XY planes for output of disturbed wind data across the low-resolution domain to /Low/DisXY..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindZ !< Z coordinates of XY planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXY] [meters] + LOGICAL , DIMENSION(:), ALLOCATABLE :: OutDisWindZvalid !< Valid XY planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXY] [-] INTEGER(IntKi) :: NOutDisWindYZ = 0_IntKi !< Number of YZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisYZ..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindX !< X coordinates of YZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindYZ] [meters] + LOGICAL , DIMENSION(:), ALLOCATABLE :: OutDisWindXvalid !< Valid YZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindYZ] [-] INTEGER(IntKi) :: NOutDisWindXZ = 0_IntKi !< Number of XZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisXZ..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindY !< Y coordinates of XZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXZ] [meters] + LOGICAL , DIMENSION(:), ALLOCATABLE :: OutDisWindYvalid !< Valid XZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXZ] [-] CHARACTER(1024) :: OutFileRoot !< The root name derived from the primary FAST.Farm input file [-] CHARACTER(1024) :: OutFileVTKRoot !< The root name for VTK outputs [-] INTEGER(IntKi) :: VTK_tWidth = 0_IntKi !< Number of characters for VTK timestamp outputs [-] @@ -1622,6 +1626,18 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%V_amb_low_disk = SrcMiscData%V_amb_low_disk end if + if (allocated(SrcMiscData%planeDomainExit)) then + LB(1:2) = lbound(SrcMiscData%planeDomainExit) + UB(1:2) = ubound(SrcMiscData%planeDomainExit) + if (.not. allocated(DstMiscData%planeDomainExit)) then + allocate(DstMiscData%planeDomainExit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%planeDomainExit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%planeDomainExit = SrcMiscData%planeDomainExit + end if end subroutine subroutine AWAE_DestroyMisc(MiscData, ErrStat, ErrMsg) @@ -1706,6 +1722,9 @@ subroutine AWAE_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%V_amb_low_disk)) then deallocate(MiscData%V_amb_low_disk) end if + if (allocated(MiscData%planeDomainExit)) then + deallocate(MiscData%planeDomainExit) + end if end subroutine subroutine AWAE_PackMisc(RF, Indata) @@ -1752,6 +1771,7 @@ subroutine AWAE_PackMisc(RF, Indata) call InflowWind_PackOutput(RF, InData%y_IfW_Low) call InflowWind_PackOutput(RF, InData%y_IfW_High) call RegPackAlloc(RF, InData%V_amb_low_disk) + call RegPackAlloc(RF, InData%planeDomainExit) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1809,6 +1829,7 @@ subroutine AWAE_UnPackMisc(RF, OutData) call InflowWind_UnpackOutput(RF, OutData%y_IfW_Low) ! y_IfW_Low call InflowWind_UnpackOutput(RF, OutData%y_IfW_High) ! y_IfW_High call RegUnpackAlloc(RF, OutData%V_amb_low_disk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%planeDomainExit); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -2016,6 +2037,18 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%OutDisWindZ = SrcParamData%OutDisWindZ end if + if (allocated(SrcParamData%OutDisWindZvalid)) then + LB(1:1) = lbound(SrcParamData%OutDisWindZvalid) + UB(1:1) = ubound(SrcParamData%OutDisWindZvalid) + if (.not. allocated(DstParamData%OutDisWindZvalid)) then + allocate(DstParamData%OutDisWindZvalid(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDisWindZvalid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutDisWindZvalid = SrcParamData%OutDisWindZvalid + end if DstParamData%NOutDisWindYZ = SrcParamData%NOutDisWindYZ if (allocated(SrcParamData%OutDisWindX)) then LB(1:1) = lbound(SrcParamData%OutDisWindX) @@ -2029,6 +2062,18 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%OutDisWindX = SrcParamData%OutDisWindX end if + if (allocated(SrcParamData%OutDisWindXvalid)) then + LB(1:1) = lbound(SrcParamData%OutDisWindXvalid) + UB(1:1) = ubound(SrcParamData%OutDisWindXvalid) + if (.not. allocated(DstParamData%OutDisWindXvalid)) then + allocate(DstParamData%OutDisWindXvalid(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDisWindXvalid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutDisWindXvalid = SrcParamData%OutDisWindXvalid + end if DstParamData%NOutDisWindXZ = SrcParamData%NOutDisWindXZ if (allocated(SrcParamData%OutDisWindY)) then LB(1:1) = lbound(SrcParamData%OutDisWindY) @@ -2042,6 +2087,18 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%OutDisWindY = SrcParamData%OutDisWindY end if + if (allocated(SrcParamData%OutDisWindYvalid)) then + LB(1:1) = lbound(SrcParamData%OutDisWindYvalid) + UB(1:1) = ubound(SrcParamData%OutDisWindYvalid) + if (.not. allocated(DstParamData%OutDisWindYvalid)) then + allocate(DstParamData%OutDisWindYvalid(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDisWindYvalid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutDisWindYvalid = SrcParamData%OutDisWindYvalid + end if DstParamData%OutFileRoot = SrcParamData%OutFileRoot DstParamData%OutFileVTKRoot = SrcParamData%OutFileVTKRoot DstParamData%VTK_tWidth = SrcParamData%VTK_tWidth @@ -2105,12 +2162,21 @@ subroutine AWAE_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%OutDisWindZ)) then deallocate(ParamData%OutDisWindZ) end if + if (allocated(ParamData%OutDisWindZvalid)) then + deallocate(ParamData%OutDisWindZvalid) + end if if (allocated(ParamData%OutDisWindX)) then deallocate(ParamData%OutDisWindX) end if + if (allocated(ParamData%OutDisWindXvalid)) then + deallocate(ParamData%OutDisWindXvalid) + end if if (allocated(ParamData%OutDisWindY)) then deallocate(ParamData%OutDisWindY) end if + if (allocated(ParamData%OutDisWindYvalid)) then + deallocate(ParamData%OutDisWindYvalid) + end if nullify(ParamData%WAT_FlowField) end subroutine @@ -2175,10 +2241,13 @@ subroutine AWAE_PackParam(RF, Indata) call RegPack(RF, InData%WrDisWind) call RegPack(RF, InData%NOutDisWindXY) call RegPackAlloc(RF, InData%OutDisWindZ) + call RegPackAlloc(RF, InData%OutDisWindZvalid) call RegPack(RF, InData%NOutDisWindYZ) call RegPackAlloc(RF, InData%OutDisWindX) + call RegPackAlloc(RF, InData%OutDisWindXvalid) call RegPack(RF, InData%NOutDisWindXZ) call RegPackAlloc(RF, InData%OutDisWindY) + call RegPackAlloc(RF, InData%OutDisWindYvalid) call RegPack(RF, InData%OutFileRoot) call RegPack(RF, InData%OutFileVTKRoot) call RegPack(RF, InData%VTK_tWidth) @@ -2261,10 +2330,13 @@ subroutine AWAE_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%WrDisWind); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NOutDisWindXY); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%OutDisWindZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutDisWindZvalid); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NOutDisWindYZ); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%OutDisWindX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutDisWindXvalid); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NOutDisWindXZ); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%OutDisWindY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutDisWindYvalid); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%OutFileRoot); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%OutFileVTKRoot); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%VTK_tWidth); if (RegCheckErr(RF, RoutineName)) return diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 486dfc3c18..a14c174504 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -3023,7 +3023,7 @@ SUBROUTINE SetTowerParameters( p, InputFileData, ErrStat, ErrMsg ) ! Local variables: REAL(ReKi) :: x ! Fractional location between two points in linear interpolation - INTEGER(IntKi ) :: J ! Index for the node arrays + INTEGER(IntKi) :: I, J ! Index for the node arrays INTEGER(IntKi) :: InterpInd ! Index for the interpolation routine @@ -3074,7 +3074,23 @@ SUBROUTINE SetTowerParameters( p, InputFileData, ErrStat, ErrMsg ) p%MassT (J) = InterpStp( p%HNodesNorm(J), InputFileData%HtFract, InputFileData%TMassDen, InterpInd, InputFileData%NTwInpSt ) p%StiffTFA (J) = InterpStp( p%HNodesNorm(J), InputFileData%HtFract, InputFileData%TwFAStif, InterpInd, InputFileData%NTwInpSt ) p%StiffTSS (J) = InterpStp( p%HNodesNorm(J), InputFileData%HtFract, InputFileData%TwSSStif, InterpInd, InputFileData%NTwInpSt ) + END DO ! J + + DO J=1,InputFileData%NTwCMass + + ! Add contributions from concentrated masses. Find the tower element on which the concentrated mass is located. + DO I=1,p%TwrNodes + IF ( (p%HNodesNorm(I)+0.5*p%DHNodes(I)/p%TwrFlexL) >= InputFileData%TwCMassHtFract(J) ) THEN + EXIT + END IF + END DO + + ! Modify the linear density of the tower element by adding the contribution from the concentrated mass. + p%MassT(I) = p%MassT(I) + InputFileData%TwCMass(J) / p%DHNodes(I) + + END DO ! J + p%MassT = abs(p%MassT) p%StiffTFA = abs(p%StiffTFA) p%StiffTSS = abs(p%StiffTSS) @@ -3254,6 +3270,7 @@ SUBROUTINE SetPrimaryParameters( InitInp, p, InputFileData, ErrStat, ErrMsg ) !p%Twr2Shft = InputFileData%Twr2Shft !p%HubIner = InputFileData%HubIner + !p%HubIner_Teeter = InputFileData%HubIner_Teeter !p%NacYIner = InputFileData%NacYIner @@ -4522,7 +4539,7 @@ END SUBROUTINE SetOutParam !> This routine is used to compute rotor (blade and hub) properties: !! KBF(), KBE(), CBF(), CBE(), FreqBF(), FreqBE(), AxRedBld(), !! TwistedSF(), BldMass(), FirstMom(), SecondMom(), BldCG(), -!! RotMass, RotIner, Hubg1Iner, Hubg2Iner, rSAerCenn1(), and +!! RotMass, RotIner, Hubf1Iner, Hubf2Iner, rSAerCenn1(), and !! rSAerCenn2(), BElmtMass() !! tower properties: !! KTFA(), KTSS(), CTFA(), CTSS(), FreqTFA(), FreqTSS(), @@ -4649,28 +4666,32 @@ SUBROUTINE Coeff(p,InputFileData, ErrStat, ErrMsg) END IF ! Calculate hub inertia about its centerline passing through its c.g.. - ! This calculation assumes that the hub for a 2-blader is essentially - ! a uniform cylinder whose centerline is transverse through the cylinder - ! passing through its c.g.. That is, for a 2-blader, Hubg1Iner = - ! Hubg2Iner is the inertia of the hub about both the g1- and g2- axes. For - ! 3-bladers, Hubg1Iner is simply equal to HubIner and Hubg2Iner is zero. + ! For a 2-bladed turbine: + ! - Hub interia about the rotor axis: Hubf1Iner is equal to HubIner + ! - Hub inertia about the teeter axis: Hubf2Iner is obtained by applying + ! parallel-axis theorem to HubIner_Teeter + ! Note that f-axes are used and therefore, inertias are not corrected + ! for the delta-3 angle + ! For a 3-bladed turbine: + ! - Hub interia about the rotor axis: Hubf1Iner is equal to HubIner + ! - Hub inertia about the teeter axis: Hubf2Iner is zero ! Also, Initialize RotMass and RotIner to associated hub properties: IF ( p%NumBl == 2 ) THEN ! 2-blader - p%Hubg1Iner = ( InputFileData%HubIner - p%HubMass*( ( p%UndSling - p%HubCM )**2 ) )/( p%CosDel3**2 ) - p%Hubg2Iner = p%Hubg1Iner - IF ( p%Hubg1Iner < 0.0 ) THEN + p%Hubf1Iner = InputFileData%HubIner + p%Hubf2Iner = InputFileData%HubIner_Teeter - p%HubMass*( ( p%UndSling - p%HubCM )**2 ) + IF ( p%Hubf1Iner < 0.0 ) THEN ErrStat = ErrID_Fatal - ErrMsg = ' HubIner must not be less than HubMass*( UndSling - HubCM )^2 for 2-blader.' + ErrMsg = ' HubIner_Teeter must not be less than HubMass*( UndSling - HubCM )^2 for 2-blader.' RETURN END IF ELSE ! 3-blader - p%Hubg1Iner = InputFileData%HubIner - p%Hubg2Iner = 0.0 + p%Hubf1Iner = InputFileData%HubIner + p%Hubf2Iner = 0.0 ENDIF p%RotMass = p%HubMass - p%RotIner = p%Hubg1Iner + p%RotIner = p%Hubf1Iner !............................................................................................................................... @@ -7564,8 +7585,8 @@ SUBROUTINE CalculateForcesMoments( p, x, CoordSys, u, RtHSdat ) TmpVec2 = CROSS_PRODUCT( RtHSdat%rPC, TmpVec1 ) ! The portion of PMomLPRot associated with the HubMass RtHSdat%PFrcPRot (:,p%DOFs%PCE(I)) = TmpVec1 - RtHSdat%PMomLPRot(:,p%DOFs%PCE(I)) = TmpVec2 - p%Hubg1Iner*CoordSys%g1*DOT_PRODUCT( CoordSys%g1, RtHSdat%PAngVelEH(p%DOFs%PCE(I),0,:) ) & - - p%Hubg2Iner*CoordSys%g2*DOT_PRODUCT( CoordSys%g2, RtHSdat%PAngVelEH(p%DOFs%PCE(I),0,:) ) + RtHSdat%PMomLPRot(:,p%DOFs%PCE(I)) = TmpVec2 - p%Hubf1Iner*CoordSys%f1*DOT_PRODUCT( CoordSys%f1, RtHSdat%PAngVelEH(p%DOFs%PCE(I),0,:) ) & + - p%Hubf2Iner*CoordSys%f2*DOT_PRODUCT( CoordSys%f2, RtHSdat%PAngVelEH(p%DOFs%PCE(I),0,:) ) ENDDO ! I - All active (enabled) DOFs that contribute to the QD2T-related linear accelerations of the hub center of mass (point C) @@ -7598,16 +7619,16 @@ SUBROUTINE CalculateForcesMoments( p, x, CoordSys, u, RtHSdat ) TmpVec1 = -p%HubMass*( p%Gravity*CoordSys%z2 + RtHSdat%LinAccECt ) ! The portion of FrcPRott associated with the HubMass TmpVec2 = CROSS_PRODUCT( RtHSdat%rPC, TmpVec1 ) ! The portion of MomLPRott associated with the HubMass - TmpVec = p%Hubg1Iner*CoordSys%g1*DOT_PRODUCT( CoordSys%g1, RtHSdat%AngVelEH ) & ! = ( Hub inertia dyadic ) dot ( angular velocity of hub in the inertia frame ) - + p%Hubg2Iner*CoordSys%g2*DOT_PRODUCT( CoordSys%g2, RtHSdat%AngVelEH ) + TmpVec = p%Hubf1Iner*CoordSys%f1*DOT_PRODUCT( CoordSys%f1, RtHSdat%AngVelEH ) & ! = ( Hub inertia dyadic ) dot ( angular velocity of hub in the inertia frame ) + + p%Hubf2Iner*CoordSys%f2*DOT_PRODUCT( CoordSys%f2, RtHSdat%AngVelEH ) TmpVec3 = CROSS_PRODUCT( -RtHSdat%AngVelEH, TmpVec ) ! = ( -angular velocity of hub in the inertia frame ) cross ( TmpVec ) RtHSdat%FrcPRott(1) = TmpVec1(1) + u%HubPtLoad%Force(1,1) RtHSdat%FrcPRott(2) = TmpVec1(2) + u%HubPtLoad%Force(3,1) RtHSdat%FrcPRott(3) = TmpVec1(3) - u%HubPtLoad%Force(2,1) - RtHSdat%MomLPRott = TmpVec2 + TmpVec3 - p%Hubg1Iner*CoordSys%g1*DOT_PRODUCT( CoordSys%g1, RtHSdat%AngAccEHt ) & - - p%Hubg2Iner*CoordSys%g2*DOT_PRODUCT( CoordSys%g2, RtHSdat%AngAccEHt ) + RtHSdat%MomLPRott = TmpVec2 + TmpVec3 - p%Hubf1Iner*CoordSys%f1*DOT_PRODUCT( CoordSys%f1, RtHSdat%AngAccEHt ) & + - p%Hubf2Iner*CoordSys%f2*DOT_PRODUCT( CoordSys%f2, RtHSdat%AngAccEHt ) RtHSdat%MomLPRott(1) = RtHSdat%MomLPRott(1) + u%HubPtLoad%Moment(1,1) RtHSdat%MomLPRott(2) = RtHSdat%MomLPRott(2) + u%HubPtLoad%Moment(3,1) diff --git a/modules/elastodyn/src/ElastoDyn_IO.f90 b/modules/elastodyn/src/ElastoDyn_IO.f90 index 8f235f033c..bd41a97ca9 100644 --- a/modules/elastodyn/src/ElastoDyn_IO.f90 +++ b/modules/elastodyn/src/ElastoDyn_IO.f90 @@ -2354,6 +2354,70 @@ SUBROUTINE ReadTowerFile( TwrFile, InputFileData, UnEc, ErrStat, ErrMsg ) END IF + ! -------------- TOWER CONCENTRATED MASSES (Optional) ------------------------------------- + InputFileData%NTwCMass = 0_IntKi ! Default to no concentrated mass + + CALL ReadCom ( UnIn, TwrFile, 'heading for tower concentrated masses', ErrStat2, ErrMsg2, UnEc ) + ! Don't set error since this section is optional + IF ( ErrStat2 /= ErrID_None ) THEN + CALL Cleanup() + RETURN + END IF + + ! NTwCMass - Number of tower concentrated masses. + + CALL ReadVar ( UnIn, TwrFile, InputFileData%NTwCMass, 'NTwCMass', 'Number of tower concentrated masses', ErrStat2, ErrMsg2, UnEc ) + ! Don't set error since this section is optional + IF ( ErrStat2 /= ErrID_None ) THEN + CALL Cleanup() + RETURN + END IF + + IF ( InputFileData%NTwCMass > 0_IntKi ) THEN ! Tower CMass section present. Must have the correct format going forward. + + ! Allocate the input arrays based on this NTwCMass input + CALL Alloc_TowerCMassList( InputFileData, ErrStat, ErrMsg ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + CALL ReadCom ( UnIn, TwrFile, 'Tower concentrated mass parameter names', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + CALL ReadCom ( UnIn, TwrFile, 'Tower concentrated mass parameter units', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + ! Read the table. + + NInputCols = 2 + + DO I=1,InputFileData%NTwCMass + + CALL ReadAry( UnIn, TwrFile, TmpRAry, NInputCols, 'Line'//TRIM(Num2LStr(I)), 'Tower concentrated mass table', & + ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + InputFileData%TwCMassHtFract( I) = TmpRAry(1) + InputFileData%TwCMass(I) = TmpRAry(2) + + END DO ! I + + END IF + ! Close the tower file. CALL Cleanup() @@ -3060,8 +3124,16 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile RETURN END IF - ! HubIner - Hub inertia about teeter axis (2-blader) or rotor axis (3-blader) (kg m^2): - CALL ReadVar( UnIn, InputFile, InputFileData%HubIner, "HubIner", "Hub inertia about teeter axis (2-blader) or rotor axis (3-blader) (kg m^2)", ErrStat2, ErrMsg2, UnEc) + ! HubIner - Hub inertia about rotor axis (2 or 3-blader) (kg m^2): + CALL ReadVar( UnIn, InputFile, InputFileData%HubIner, "HubIner", "Hub inertia about rotor axis (2 or 3-blader) (kg m^2)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + ! HubIner_teeter - Hub inertia about teeter axis (2-blader) (kg m^2): + CALL ReadVar( UnIn, InputFile, InputFileData%HubIner_Teeter, "HubIner_Teeter", "Hub inertia about teeter axis (2-blader) (kg m^2)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() @@ -3750,6 +3822,30 @@ SUBROUTINE Alloc_TowerInputProperties( InputFileData, ErrStat, ErrMsg ) END SUBROUTINE Alloc_TowerInputProperties !---------------------------------------------------------------------------------------------------------------------------------- +!> This routine allocates arrays for the tower concentrated masses from the input file. +SUBROUTINE Alloc_TowerCMassList( InputFileData, ErrStat, ErrMsg ) +!.................................................................................................................................. + + TYPE(ED_InputFile), INTENT(INOUT) :: InputFileData !< All the data in the ElastoDyn input file + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message + + + IF ( InputFileData%NTwCMass < 1 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating arrays for tower concentrated masses: NTwCMass must be at least 1.' + RETURN + END IF + + ! Allocate the arrays. + + CALL AllocAry ( InputFileData%TwCMassHtFract, InputFileData%NTwCMass, 'TwCMassHtFract' , ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) RETURN + CALL AllocAry ( InputFileData%TwCMass, InputFileData%NTwCMass, 'TwCMass' , ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) RETURN + +END SUBROUTINE Alloc_TowerCMassList +!---------------------------------------------------------------------------------------------------------------------------------- !> This routine checks the blade file input data for errors. SUBROUTINE ValidateBladeData ( BladeKInputFileData, ErrStat, ErrMsg ) !.................................................................................................................................. @@ -3958,6 +4054,24 @@ SUBROUTINE ValidateTowerData ( InputFileData, ErrStat, ErrMsg ) CALL ValidateModeShapeCoeffs( InputFileData%TwSSM2Sh, 'tower side-to-side mode 2', ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Validate list of concentrated masses + IF ( InputFileData%NTwCMass < 0_IntKi ) CALL SetErrStat( ErrID_Fatal, 'NTwCMass must be equal to or greater than zero.', ErrStat, ErrMsg, RoutineName) + + ! Check the input arrays: + + DO I = 1,InputFileData%NTwCMass + IF ( InputFileData%TwCMassHtFract(I) < 0.0_ReKi ) THEN + CALL SetErrStat( ErrID_Fatal, 'Tower concentrated mass HtFract must be equal to or greater than zero.', ErrStat, ErrMsg, RoutineName) + END IF + IF ( InputFileData%TwCMassHtFract(I) > 1.0_ReKi ) THEN + CALL SetErrStat( ErrID_Fatal, 'Tower concentrated mass HtFract must be equal to or less than one.', ErrStat, ErrMsg, RoutineName) + END IF + IF ( InputFileData%TwCMass(I) < 0.0_ReKi ) THEN + CALL SetErrStat( ErrID_Fatal, 'TwCMass must be equal to or greater than zero.', ErrStat, ErrMsg, RoutineName) + END IF + END DO + END SUBROUTINE ValidateTowerData !---------------------------------------------------------------------------------------------------------------------------------- !> This routine validates the furling inputs. @@ -4191,6 +4305,9 @@ SUBROUTINE ValidatePrimaryData( InputFileData, BD4Blades, Linearize, MHK, ErrSta IF ( InputFileData%NacYIner < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'NacYIner must not be negative.',ErrStat,ErrMsg,RoutineName) IF ( InputFileData%GenIner < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'GenIner must not be negative.',ErrStat,ErrMsg,RoutineName) IF ( InputFileData%HubIner < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'HubIner must not be negative.',ErrStat,ErrMsg,RoutineName) + IF ( InputFileData%NumBl == 2 ) THEN + IF ( InputFileData%HubIner_Teeter < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'HubIner_Teeter must not be negative.',ErrStat,ErrMsg,RoutineName) + ENDIF ! Check that TowerHt is in the range [0,inf): IF ( MHK /= MHK_Floating ) THEN diff --git a/modules/elastodyn/src/ElastoDyn_Registry.txt b/modules/elastodyn/src/ElastoDyn_Registry.txt index 2210e9b573..48bfc6321b 100644 --- a/modules/elastodyn/src/ElastoDyn_Registry.txt +++ b/modules/elastodyn/src/ElastoDyn_Registry.txt @@ -144,7 +144,8 @@ typedef ^ ED_InputFile ReKi PtfmCMzt - - - "Vertical distance from the ground le typedef ^ ED_InputFile ReKi PtfmRefzt - - - "Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point" meters typedef ^ ED_InputFile ReKi TipMass {:} - - "Tip-brake masses" kg typedef ^ ED_InputFile ReKi HubMass - - - "Hub mass" kg -typedef ^ ED_InputFile ReKi HubIner - - - "Hub inertia about teeter axis (2-blader) or rotor axis (3-blader)" "kg m^2" +typedef ^ ED_InputFile ReKi HubIner - - - "Hub inertia about rotor axis (2 or 3-blader)" "kg m^2" +typedef ^ ED_InputFile ReKi HubIner_Teeter - - - "Hub inertia about teeter axis (2-blader)" "kg m^2" typedef ^ ED_InputFile ReKi GenIner - - - "Generator inertia about HSS" "kg m^2" typedef ^ ED_InputFile ReKi NacMass - - - "Nacelle mass" kg typedef ^ ED_InputFile ReKi NacYIner - - - "Nacelle yaw inertia" "kg m^2" @@ -211,6 +212,9 @@ typedef ^ ED_InputFile ReKi TwFAM1Sh {:} - - "Tower fore-aft mode-1 shape coeffi typedef ^ ED_InputFile ReKi TwFAM2Sh {:} - - "Tower fore-aft mode-2 shape coefficients" - typedef ^ ED_InputFile ReKi TwSSM1Sh {:} - - "Tower side-to-side mode-1 shape coefficients" - typedef ^ ED_InputFile ReKi TwSSM2Sh {:} - - "Tower side-to-side mode-2 shape coefficients" - +typedef ^ ED_InputFile IntKi NTwCMass - - - "Number of tower concentrated masses" - +typedef ^ ED_InputFile ReKi TwCMassHtFract {:} - - "Fractional heights of tower concentrated masses" - +typedef ^ ED_InputFile ReKi TwCMass {:} - - "List of concentrated masses on the tower" kg # ..... Furling Input file data ........................................................................................................... typedef ^ ED_InputFile LOGICAL RFrlDOF - - - "Rotor-furl DOF" - typedef ^ ED_InputFile LOGICAL TFrlDOF - - - "Tail-furl DOF" - @@ -679,8 +683,8 @@ typedef ^ ParameterType ReKi BldMass {:} - - "Blade masses" typedef ^ ParameterType ReKi BoomMass - - - "Tail boom mass" typedef ^ ParameterType ReKi FirstMom {:} - - "First mass moment of inertia of blades wrt the root" typedef ^ ParameterType ReKi GenIner - - - "Generator inertia about HSS" -typedef ^ ParameterType ReKi Hubg1Iner - - - "Inertia of hub about g1-axis (rotor centerline)" -typedef ^ ParameterType ReKi Hubg2Iner - - - "Inertia of hub about g2-axis (transverse to the cyclinder and passing through its c.g.)" +typedef ^ ParameterType ReKi Hubf1Iner - - - "Inertia of hub about f1-axis (rotor centerline)" +typedef ^ ParameterType ReKi Hubf2Iner - - - "Inertia of hub about f2-axis (teeter axis)" typedef ^ ParameterType ReKi HubMass - - - "Hub mass" typedef ^ ParameterType ReKi Nacd2Iner - - - "Inertia of nacelle about the d2-axis whose origin is the nacelle center of mass" typedef ^ ParameterType ReKi NacMass - - - "Nacelle mass" diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index adc0c3f8c8..aaaf95a422 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -166,7 +166,8 @@ MODULE ElastoDyn_Types REAL(ReKi) :: PtfmRefzt = 0.0_ReKi !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TipMass !< Tip-brake masses [kg] REAL(ReKi) :: HubMass = 0.0_ReKi !< Hub mass [kg] - REAL(ReKi) :: HubIner = 0.0_ReKi !< Hub inertia about teeter axis (2-blader) or rotor axis (3-blader) [kg m^2] + REAL(ReKi) :: HubIner = 0.0_ReKi !< Hub inertia about rotor axis (2 or 3-blader) [kg m^2] + REAL(ReKi) :: HubIner_Teeter = 0.0_ReKi !< Hub inertia about teeter axis (2-blader) [kg m^2] REAL(ReKi) :: GenIner = 0.0_ReKi !< Generator inertia about HSS [kg m^2] REAL(ReKi) :: NacMass = 0.0_ReKi !< Nacelle mass [kg] REAL(ReKi) :: NacYIner = 0.0_ReKi !< Nacelle yaw inertia [kg m^2] @@ -230,6 +231,9 @@ MODULE ElastoDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwFAM2Sh !< Tower fore-aft mode-2 shape coefficients [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwSSM1Sh !< Tower side-to-side mode-1 shape coefficients [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwSSM2Sh !< Tower side-to-side mode-2 shape coefficients [-] + INTEGER(IntKi) :: NTwCMass = 0_IntKi !< Number of tower concentrated masses [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwCMassHtFract !< Fractional heights of tower concentrated masses [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwCMass !< List of concentrated masses on the tower [kg] LOGICAL :: RFrlDOF = .false. !< Rotor-furl DOF [-] LOGICAL :: TFrlDOF = .false. !< Tail-furl DOF [-] REAL(ReKi) :: RotFurl = 0.0_ReKi !< Initial or fixed rotor-furl angle [radians] @@ -695,8 +699,8 @@ MODULE ElastoDyn_Types REAL(ReKi) :: BoomMass = 0.0_ReKi !< Tail boom mass [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FirstMom !< First mass moment of inertia of blades wrt the root [-] REAL(ReKi) :: GenIner = 0.0_ReKi !< Generator inertia about HSS [-] - REAL(ReKi) :: Hubg1Iner = 0.0_ReKi !< Inertia of hub about g1-axis (rotor centerline) [-] - REAL(ReKi) :: Hubg2Iner = 0.0_ReKi !< Inertia of hub about g2-axis (transverse to the cyclinder and passing through its c.g.) [-] + REAL(ReKi) :: Hubf1Iner = 0.0_ReKi !< Inertia of hub about f1-axis (rotor centerline) [-] + REAL(ReKi) :: Hubf2Iner = 0.0_ReKi !< Inertia of hub about f2-axis (teeter axis) [-] REAL(ReKi) :: HubMass = 0.0_ReKi !< Hub mass [-] REAL(ReKi) :: Nacd2Iner = 0.0_ReKi !< Inertia of nacelle about the d2-axis whose origin is the nacelle center of mass [-] REAL(ReKi) :: NacMass = 0.0_ReKi !< Nacelle mass [-] @@ -1668,6 +1672,7 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if DstInputFileData%HubMass = SrcInputFileData%HubMass DstInputFileData%HubIner = SrcInputFileData%HubIner + DstInputFileData%HubIner_Teeter = SrcInputFileData%HubIner_Teeter DstInputFileData%GenIner = SrcInputFileData%GenIner DstInputFileData%NacMass = SrcInputFileData%NacMass DstInputFileData%NacYIner = SrcInputFileData%NacYIner @@ -1860,6 +1865,31 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if DstInputFileData%TwSSM2Sh = SrcInputFileData%TwSSM2Sh end if + DstInputFileData%NTwCMass = SrcInputFileData%NTwCMass + if (allocated(SrcInputFileData%TwCMassHtFract)) then + LB(1:1) = lbound(SrcInputFileData%TwCMassHtFract) + UB(1:1) = ubound(SrcInputFileData%TwCMassHtFract) + if (.not. allocated(DstInputFileData%TwCMassHtFract)) then + allocate(DstInputFileData%TwCMassHtFract(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwCMassHtFract.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TwCMassHtFract = SrcInputFileData%TwCMassHtFract + end if + if (allocated(SrcInputFileData%TwCMass)) then + LB(1:1) = lbound(SrcInputFileData%TwCMass) + UB(1:1) = ubound(SrcInputFileData%TwCMass) + if (.not. allocated(DstInputFileData%TwCMass)) then + allocate(DstInputFileData%TwCMass(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwCMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TwCMass = SrcInputFileData%TwCMass + end if DstInputFileData%RFrlDOF = SrcInputFileData%RFrlDOF DstInputFileData%TFrlDOF = SrcInputFileData%TFrlDOF DstInputFileData%RotFurl = SrcInputFileData%RotFurl @@ -1985,6 +2015,12 @@ subroutine ED_DestroyInputFile(InputFileData, ErrStat, ErrMsg) if (allocated(InputFileData%TwSSM2Sh)) then deallocate(InputFileData%TwSSM2Sh) end if + if (allocated(InputFileData%TwCMassHtFract)) then + deallocate(InputFileData%TwCMassHtFract) + end if + if (allocated(InputFileData%TwCMass)) then + deallocate(InputFileData%TwCMass) + end if if (allocated(InputFileData%BldNd_OutList)) then deallocate(InputFileData%BldNd_OutList) end if @@ -2057,6 +2093,7 @@ subroutine ED_PackInputFile(RF, Indata) call RegPackAlloc(RF, InData%TipMass) call RegPack(RF, InData%HubMass) call RegPack(RF, InData%HubIner) + call RegPack(RF, InData%HubIner_Teeter) call RegPack(RF, InData%GenIner) call RegPack(RF, InData%NacMass) call RegPack(RF, InData%NacYIner) @@ -2136,6 +2173,9 @@ subroutine ED_PackInputFile(RF, Indata) call RegPackAlloc(RF, InData%TwFAM2Sh) call RegPackAlloc(RF, InData%TwSSM1Sh) call RegPackAlloc(RF, InData%TwSSM2Sh) + call RegPack(RF, InData%NTwCMass) + call RegPackAlloc(RF, InData%TwCMassHtFract) + call RegPackAlloc(RF, InData%TwCMass) call RegPack(RF, InData%RFrlDOF) call RegPack(RF, InData%TFrlDOF) call RegPack(RF, InData%RotFurl) @@ -2255,6 +2295,7 @@ subroutine ED_UnPackInputFile(RF, OutData) call RegUnpackAlloc(RF, OutData%TipMass); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%HubMass); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%HubIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubIner_Teeter); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%GenIner); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NacMass); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NacYIner); if (RegCheckErr(RF, RoutineName)) return @@ -2342,6 +2383,9 @@ subroutine ED_UnPackInputFile(RF, OutData) call RegUnpackAlloc(RF, OutData%TwFAM2Sh); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%TwSSM1Sh); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%TwSSM2Sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NTwCMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwCMassHtFract); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwCMass); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%RFrlDOF); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%TFrlDOF); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%RotFurl); if (RegCheckErr(RF, RoutineName)) return @@ -5538,8 +5582,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%FirstMom = SrcParamData%FirstMom end if DstParamData%GenIner = SrcParamData%GenIner - DstParamData%Hubg1Iner = SrcParamData%Hubg1Iner - DstParamData%Hubg2Iner = SrcParamData%Hubg2Iner + DstParamData%Hubf1Iner = SrcParamData%Hubf1Iner + DstParamData%Hubf2Iner = SrcParamData%Hubf2Iner DstParamData%HubMass = SrcParamData%HubMass DstParamData%Nacd2Iner = SrcParamData%Nacd2Iner DstParamData%NacMass = SrcParamData%NacMass @@ -6425,8 +6469,8 @@ subroutine ED_PackParam(RF, Indata) call RegPack(RF, InData%BoomMass) call RegPackAlloc(RF, InData%FirstMom) call RegPack(RF, InData%GenIner) - call RegPack(RF, InData%Hubg1Iner) - call RegPack(RF, InData%Hubg2Iner) + call RegPack(RF, InData%Hubf1Iner) + call RegPack(RF, InData%Hubf2Iner) call RegPack(RF, InData%HubMass) call RegPack(RF, InData%Nacd2Iner) call RegPack(RF, InData%NacMass) @@ -6696,8 +6740,8 @@ subroutine ED_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%BoomMass); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%FirstMom); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%GenIner); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Hubg1Iner); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Hubg2Iner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Hubf1Iner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Hubf2Iner); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%HubMass); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Nacd2Iner); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NacMass); if (RegCheckErr(RF, RoutineName)) return diff --git a/modules/externalinflow/src/ExternalInflow_Types.f90 b/modules/externalinflow/src/ExternalInflow_Types.f90 index aeac2adf98..963b0a9b46 100644 --- a/modules/externalinflow/src/ExternalInflow_Types.f90 +++ b/modules/externalinflow/src/ExternalInflow_Types.f90 @@ -288,11 +288,6 @@ subroutine ExtInfw_PackInitInput(RF, Indata) character(*), parameter :: RoutineName = 'ExtInfw_PackInitInput' logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - if (c_associated(InData%C_obj%object)) then - RF%ErrStat = ErrID_Fatal - RF%ErrMsg = RoutineName//': C_obj%object cannot be packed.' - return - end if call RegPack(RF, InData%NumActForcePtsBlade) call RegPack(RF, InData%NumActForcePtsTower) call RegPackPtr(RF, InData%StructBldRNodes) @@ -494,11 +489,6 @@ subroutine ExtInfw_PackInitOutput(RF, Indata) character(*), parameter :: RoutineName = 'ExtInfw_PackInitOutput' logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - if (c_associated(InData%C_obj%object)) then - RF%ErrStat = ErrID_Fatal - RF%ErrMsg = RoutineName//': C_obj%object cannot be packed.' - return - end if call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) @@ -733,11 +723,6 @@ subroutine ExtInfw_PackMisc(RF, Indata) integer(B4Ki) :: LB(1), UB(1) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - if (c_associated(InData%C_obj%object)) then - RF%ErrStat = ErrID_Fatal - RF%ErrMsg = RoutineName//': C_obj%object cannot be packed.' - return - end if call RegPack(RF, allocated(InData%ActForceMotionsPoints)) if (allocated(InData%ActForceMotionsPoints)) then call RegPackBounds(RF, 1, lbound(InData%ActForceMotionsPoints), ubound(InData%ActForceMotionsPoints)) @@ -993,11 +978,6 @@ subroutine ExtInfw_PackParam(RF, Indata) character(*), parameter :: RoutineName = 'ExtInfw_PackParam' logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - if (c_associated(InData%C_obj%object)) then - RF%ErrStat = ErrID_Fatal - RF%ErrMsg = RoutineName//': C_obj%object cannot be packed.' - return - end if call RegPack(RF, InData%AirDens) call RegPack(RF, InData%NumBl) call RegPack(RF, InData%NMappings) @@ -1541,11 +1521,6 @@ subroutine ExtInfw_PackInput(RF, Indata) character(*), parameter :: RoutineName = 'ExtInfw_PackInput' logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - if (c_associated(InData%C_obj%object)) then - RF%ErrStat = ErrID_Fatal - RF%ErrMsg = RoutineName//': C_obj%object cannot be packed.' - return - end if call RegPackPtr(RF, InData%pxVel) call RegPackPtr(RF, InData%pyVel) call RegPackPtr(RF, InData%pzVel) @@ -2160,11 +2135,6 @@ subroutine ExtInfw_PackOutput(RF, Indata) character(*), parameter :: RoutineName = 'ExtInfw_PackOutput' logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - if (c_associated(InData%C_obj%object)) then - RF%ErrStat = ErrID_Fatal - RF%ErrMsg = RoutineName//': C_obj%object cannot be packed.' - return - end if call RegPackPtr(RF, InData%u) call RegPackPtr(RF, InData%v) call RegPackPtr(RF, InData%w) diff --git a/modules/extloads/src/ExtLoadsDX_Types.f90 b/modules/extloads/src/ExtLoadsDX_Types.f90 index de838113c6..f1c3ddcf92 100644 --- a/modules/extloads/src/ExtLoadsDX_Types.f90 +++ b/modules/extloads/src/ExtLoadsDX_Types.f90 @@ -273,11 +273,6 @@ subroutine ExtLdDX_PackInput(RF, Indata) character(*), parameter :: RoutineName = 'ExtLdDX_PackInput' logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - if (c_associated(InData%C_obj%object)) then - RF%ErrStat = ErrID_Fatal - RF%ErrMsg = RoutineName//': C_obj%object cannot be packed.' - return - end if call RegPackPtr(RF, InData%twrDef) call RegPackPtr(RF, InData%bldDef) call RegPackPtr(RF, InData%hubDef) @@ -769,11 +764,6 @@ subroutine ExtLdDX_PackParam(RF, Indata) character(*), parameter :: RoutineName = 'ExtLdDX_PackParam' logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - if (c_associated(InData%C_obj%object)) then - RF%ErrStat = ErrID_Fatal - RF%ErrMsg = RoutineName//': C_obj%object cannot be packed.' - return - end if call RegPackPtr(RF, InData%nBlades) call RegPackPtr(RF, InData%nBladeNodes) call RegPackPtr(RF, InData%nTowerNodes) @@ -1217,11 +1207,6 @@ subroutine ExtLdDX_PackOutput(RF, Indata) character(*), parameter :: RoutineName = 'ExtLdDX_PackOutput' logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - if (c_associated(InData%C_obj%object)) then - RF%ErrStat = ErrID_Fatal - RF%ErrMsg = RoutineName//': C_obj%object cannot be packed.' - return - end if call RegPackPtr(RF, InData%twrLd) call RegPackPtr(RF, InData%bldLd) if (RegCheckErr(RF, RoutineName)) return diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 25afdd70e9..2412cacfa5 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -1228,8 +1228,7 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, REAL(ReKi), PARAMETER :: LrgAngle = 0.261799387799149 ! Threshold for platform roll and pitch rotation (15 deg). This is consistent with the ElastoDyn check. LOGICAL, SAVE :: FrstWarn_LrgY = .TRUE. - ! Initialize ErrStat - + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1240,7 +1239,7 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, IF ( (p%OutSwtch == 1 .OR. p%OutSwtch == 3) .AND. ( Time > m%LastOutTime ) ) THEN CALL HDOut_WriteOutputs( m%LastOutTime, y, p, m%Decimate, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (Failed()) return END IF m%LastOutTime = Time ! time associated with the next values of y%WriteOutput @@ -1260,8 +1259,8 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, IF ( (ABS( WrapToPi(PRPRotation(3)-PtfmRefY) ) > LrgAngle) .AND. FrstWarn_LrgY ) THEN ErrStat2 = ErrID_Severe ErrMsg2 = 'Yaw angle at PRP relative to the reference yaw position (PtfmRefY) violated the small angle assumption. The solution might be inaccurate. Consider using PtfmYMod=1 and adjust PtfmYCutoff. Simulation continuing, but future warnings will be suppressed.' - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FrstWarn_LrgY = .FALSE. + if (Failed()) return END IF !------------------------------------------------------------------- @@ -1270,16 +1269,15 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, !------------------------------------------------------------------- - if ( p%PotMod == 1 ) then ! Transformation matrices between global and PRP frame - ALLOCATE(RRb2g(6*p%NBody,6*p%NBody),STAT=ErrStat2) - ALLOCATE(RRg2b(6*p%NBody,6*p%NBody),STAT=ErrStat2) + ALLOCATE(RRb2g(6*p%NBody,6*p%NBody),STAT=ErrStat2); if (Failed0("RRb2g")) return; + ALLOCATE(RRg2b(6*p%NBody,6*p%NBody),STAT=ErrStat2); if (Failed0("RRg2b")) return; RRg2b(:,:) = 0.0_ReKi do iBody = 1, p%NBody ! Determine the rotational angles from the direction-cosine matrix ! rotdisp = GetRotAngs ( u%PtfmRefY, u%WAMITMesh%Orientation(:,:,iBody), ErrStat2, ErrMsg2 ) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! if (Failed()) return rotdisp = EulerExtractZYX(u%WAMITMesh%Orientation(:,:,iBody)) indxStart = (iBody-1)*6+1 indxEnd = indxStart+5 @@ -1294,9 +1292,7 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, end do RRb2g = transpose(RRg2b) - !FIXME: Error handling appears to be broken here. if ( p%NBodyMod == 1 ) then - ! Compute the load contirbution from user-supplied added stiffness and damping m%F_PtfmAdd = p%AddF0(:,1) - matmul(p%AddCLin(:,:,1), q) & - matmul( matmul(RRb2g,p%AddBLin(:,:,1) ), matmul(RRg2b,qdot) ) & @@ -1334,14 +1330,13 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, if ( p%NBodyMod == 1 .or. p%NBody == 1 ) then ! Copy the inputs from the HD mesh into the WAMIT mesh call MeshCopy( u%WAMITMesh, m%u_WAMIT(1)%Mesh, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if ( ErrStat >= AbortErrLev ) return + if (Failed()) return ! m%u_WAMIT(1)%PtfmRefY = u%PtfmRefY m%u_WAMIT(1)%PtfmRefY = PtfmRefY call WAMIT_CalcOutput( Time, m%u_WAMIT(1), p%WAMIT(1), x%WAMIT(1), xd%WAMIT(1), & z%WAMIT, OtherState%WAMIT(1), y%WAMIT(1), m%WAMIT(1), ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (Failed()) return do iBody=1,p%NBody y%WAMITMesh%Force (:,iBody) = y%WAMITMesh%Force (:,iBody) + y%WAMIT(1)%Mesh%Force (:,iBody) y%WAMITMesh%Moment(:,iBody) = y%WAMITMesh%Moment(:,iBody) + y%WAMIT(1)%Mesh%Moment(:,iBody) @@ -1363,7 +1358,7 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, m%u_WAMIT(iBody)%PtfmRefY = PtfmRefY call WAMIT_CalcOutput( Time, m%u_WAMIT(iBody), p%WAMIT(iBody), x%WAMIT(iBody), xd%WAMIT(iBody), & z%WAMIT, OtherState%WAMIT(iBody), y%WAMIT(iBody), m%WAMIT(iBody), ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (Failed()) return y%WAMITMesh%Force (:,iBody) = y%WAMITMesh%Force (:,iBody) + y%WAMIT(iBody)%Mesh%Force (:,1) y%WAMITMesh%Moment(:,iBody) = y%WAMITMesh%Moment(:,iBody) + y%WAMIT(iBody)%Mesh%Moment(:,1) @@ -1383,7 +1378,7 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, if ( p%NBodyMod == 1 .or. p%NBody == 1 ) then call WAMIT2_CalcOutput( Time, PtfmRefY, p%WaveField, p%WAMIT2(1), y%WAMIT2(1), m%WAMIT2(1), ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (Failed()) return do iBody=1,p%NBody y%WAMITMesh%Force (:,iBody) = y%WAMITMesh%Force (:,iBody) + y%WAMIT2(1)%Mesh%Force (:,iBody) y%WAMITMesh%Moment(:,iBody) = y%WAMITMesh%Moment(:,iBody) + y%WAMIT2(1)%Mesh%Moment(:,iBody) @@ -1394,7 +1389,7 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, do iBody=1,p%NBody call WAMIT2_CalcOutput( Time, PtfmRefY, p%WaveField, p%WAMIT2(iBody), y%WAMIT2(iBody), m%WAMIT2(iBody), ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (Failed()) return y%WAMITMesh%Force (:,iBody) = y%WAMITMesh%Force (:,iBody) + y%WAMIT2(iBody)%Mesh%Force (:,1) y%WAMITMesh%Moment(:,iBody) = y%WAMITMesh%Moment(:,iBody) + y%WAMIT2(iBody)%Mesh%Moment(:,1) @@ -1414,6 +1409,7 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Inputs_FIT%si_t(:) = u%WAMITMesh%TranslationDisp(:,1) Inputs_FIT%vel_t(:) = u%WAMITMesh%TranslationVel (:,1) CALL FIT_CalcOutput( Time, Inputs_FIT, p%FIT, FIT_x, xd%FIT, FIT_z, OtherState%FIT, y%FIT, ErrStat2, ErrMsg2 ) + if (Failed()) return ! Add FIT forces to the HydroDyn output mesh y%WAMITMesh%Force (:,1) = y%WAMITMesh%Force (:,1) + y%FIT%F(:) @@ -1428,16 +1424,16 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, u%Morison%PtfmRefY = PtfmRefY CALL Morison_CalcOutput( Time, u%Morison, p%Morison, x%Morison, xd%Morison, & z%Morison, OtherState%Morison, y%Morison, m%Morison, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (Failed()) return END IF ! Integrate all the mesh loads onto the platfrom reference Point (PRP) at (0,0,0) m%F_Hydro = CalcLoadsAtWRP( y, u, m%AllHdroOrigin, m%HD_MeshMap, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (Failed()) return ! Map calculated results into the first p%NumOuts values of the y%WriteOutput Array CALL HDOut_MapOutputs( p, y, m%WAMIT, m%WAMIT2, m%F_PtfmAdd, m%F_Waves, m%F_Hydro, u%PRPMesh, PtfmRefY, q, qdot, qdotdot, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (Failed()) return ! Aggregate the sub-module outputs IF (p%Morison%NumOuts > 0) THEN @@ -1453,6 +1449,21 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, IF (ALLOCATED(RRb2g)) DEALLOCATE(RRb2g) IF (ALLOCATED(RRg2b)) DEALLOCATE(RRg2b) +contains + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + Failed = errStat >= AbortErrLev + end function Failed + ! check for failed where /= 0 is fatal + logical function Failed0(txt) + character(*), intent(in) :: txt + if (ErrStat2 /= 0) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Could not allocate "//trim(txt) + call SetErrStat(ErrStat2, ErrMsg2, errStat, errMsg, RoutineName) + endif + Failed0 = ErrStat >= AbortErrLev + end function Failed0 END SUBROUTINE HydroDyn_CalcOutput @@ -1567,6 +1578,9 @@ function CalcLoadsAtWRP( y, u, AllHdroOrigin, MeshMapData, ErrStat, ErrMsg ) integer(IntKi) :: ErrStat2 ! temporary Error status of the operation character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + ErrStat = ErrID_None + ErrMsg = "" + CalcLoadsAtWRP = 0.0_ReKi if ( y%WAMITMesh%Committed ) then diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 44d3a48264..4e8d8ae192 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -71,7 +71,7 @@ typedef HydroDyn/HydroDyn InitInputType CHARACTER(1 typedef ^ ^ LOGICAL UseInputFile - .TRUE. - "Supplied by Driver: .TRUE. if using a input file, .FALSE. if all inputs are being passed in by the caller" - typedef ^ ^ FileInfoType PassedFileData - - - "If we don't use the input file, pass everything through this" - typedef ^ ^ CHARACTER(1024) OutRootName - - - "Supplied by Driver: The name of the root file (without extension) including the full path" - -typedef ^ ^ Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - +typedef ^ ^ Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - typedef ^ ^ ReKi Gravity - - - "Supplied by Driver: Gravitational acceleration" "(m/s^2)" typedef ^ ^ DbKi TMax - - - "Supplied by Driver: The total simulation time" "(sec)" typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - diff --git a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 index 4c7c5bc4dd..efa64402d1 100644 --- a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 +++ b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 @@ -31,6 +31,7 @@ MODULE HydroDyn_C_BINDING PUBLIC :: HydroDyn_C_Init PUBLIC :: HydroDyn_C_CalcOutput + PUBLIC :: HydroDyn_C_CalcOutput_and_AddedMass PUBLIC :: HydroDyn_C_UpdateStates PUBLIC :: HydroDyn_C_End @@ -304,6 +305,7 @@ SUBROUTINE HydroDyn_C_Init( call AllocAry( tmpNodeVel, 6, NumNodePts, "tmpNodeVel", ErrStat2, ErrMsg2 ); if (Failed()) return call AllocAry( tmpNodeAcc, 6, NumNodePts, "tmpNodeAcc", ErrStat2, ErrMsg2 ); if (Failed()) return call AllocAry( tmpNodeFrc, 6, NumNodePts, "tmpNodeFrc", ErrStat2, ErrMsg2 ); if (Failed()) return + ! structural mesh reference position tmpNodePos(1:6,1:NumNodePts) = reshape( real(InitNodePositions_C(1:6*NumNodePts),ReKi), (/6,NumNodePts/) ) !---------------------------------------------------- @@ -441,6 +443,10 @@ SUBROUTINE HydroDyn_C_Init( HD%InitInp%Gravity = REAL(Gravity_C, ReKi) HD%InitInp%TMax = REAL(TMax_C, DbKi) +!FIXME: initial platform position does not work!!! + ! Initial platform position +! HD%InitInp%PlatformPos = (/ REAL(PtfmRefPtPositionX_C, ReKi), REAL(PtfmRefPtPositionX_C, ReKi), 0 /) + ! Transfer data from SeaState ! Need to set up other module's InitInput data here because we will also need to clean up SeaState data and would rather not defer that cleanup HD%InitInp%InvalidWithSSExctn = SeaSt%InitOutData%InvalidWithSSExctn @@ -500,6 +506,7 @@ SUBROUTINE HydroDyn_C_Init( !-------------------------------------------------------------------------------------------------------------------------------- ! Set the interface meshes and outputs + ! -- uses the InitNodePositions_C location/orientation to set the structural mesh reference location !-------------------------------------------------------------------------------------------------------------------------------- call SetMotionLoadsInterfaceMeshes(ErrStat2,ErrMsg2); if (Failed()) return @@ -684,6 +691,11 @@ end subroutine SetMotionLoadsInterfaceMeshes !! If more than one input node was passed in, but only a single HD node !! exits (single Morison or single WAMIT), then give error that too many !! nodes passed. + !! More than one node is passed in (NumNodePts>1) indicates that the structure + !! is modeled as flexible. This requires more than one destination node on + !! either the Morison or WAMIT meshes. Note that some nodes may be + !! co-located, so checking that the total number of nodes is the same does + !! not work. subroutine CheckNodes(ErrStat3,ErrMsg3) integer(IntKi), intent( out) :: ErrStat3 !< temporary error status character(ErrMsgLen), intent( out) :: ErrMsg3 !< temporary error message @@ -691,19 +703,19 @@ subroutine CheckNodes(ErrStat3,ErrMsg3) ErrMsg3 = "" if ( NumNodePts > 1 ) then if ( HD%u(1)%Morison%Mesh%Committed .and. HD%u(1)%WAMITMesh%Committed ) then - if ( (HD%u(1)%Morison%Mesh%Nnodes + HD%u(1)%WAMITMesh%Nnodes) < NumNodePts ) then + if ( (HD%u(1)%Morison%Mesh%Nnodes + HD%u(1)%WAMITMesh%Nnodes) < 2_IntKi) then ErrStat3 = ErrID_Fatal - ErrMsg3 = "More nodes passed into library than exist in HydroDyn model" + ErrMsg3 = "More than one node passed into library, but only one HydroDyn node exists." endif elseif ( HD%u(1)%Morison%Mesh%Committed ) then ! No WAMIT - if ( HD%u(1)%Morison%Mesh%Nnodes < NumNodePts ) then + if ( HD%u(1)%Morison%Mesh%Nnodes < 2_IntKi ) then ErrStat3 = ErrID_Fatal - ErrMsg3 = "More nodes passed into library than exist in HydroDyn model Morison mesh" + ErrMsg3 = "More than one node passed into library, but only one HydroDyn node exists on Morison mesh." endif elseif ( HD%u(1)%WAMITMesh%Committed ) then ! No Morison - if ( HD%u(1)%WAMITMesh%Nnodes < NumNodePts ) then + if ( HD%u(1)%WAMITMesh%Nnodes < 2_IntKi ) then ErrStat3 = ErrID_Fatal - ErrMsg3 = "More nodes passed into library than exist in HydroDyn model WAMIT mesh" + ErrMsg3 = "More than one node passed into library, but only one HydroDyn node exists on the WAMIT mesh." endif endif endif @@ -842,8 +854,11 @@ logical function Failed() end function Failed END SUBROUTINE HydroDyn_C_CalcOutput + !=============================================================================================================== !-------------------------------------- HydroDyn CalcOutput_and_AddedMass -------------------------------------- +!> This routine is similar to the HydroDyn_C_CalcOutput, but splits the forces returned from HydroDyn_CalcOutput +!! into the hydrodynamic forces without added mass, and a separate added mass matrix. !=============================================================================================================== SUBROUTINE HydroDyn_C_CalcOutput_and_AddedMass(Time_C, NumNodePts_C, NodePos_C, NodeVel_C, & diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index d9960ed40b..8cf72660e5 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -915,18 +915,51 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, FileInfo_In, InputFi DO I = 1,InputFileData%Morison%NMembers ! We can't use the ParseAry here since PropPot is a logical Line = FileInfo_In%Lines(CurLine) + READ(Line,*,IOSTAT=ErrStat2) InputFileData%Morison%InpMembers(I)%MemberID, InputFileData%Morison%InpMembers(I)%MJointID1, & InputFileData%Morison%InpMembers(I)%MJointID2, InputFileData%Morison%InpMembers(I)%MPropSetID1, & InputFileData%Morison%InpMembers(I)%MPropSetID2, InputFileData%Morison%InpMembers(I)%MSecGeom, & InputFileData%Morison%InpMembers(I)%MSpinOrient, InputFileData%Morison%InpMembers(I)%MDivSize, & InputFileData%Morison%InpMembers(I)%MCoefMod, InputFileData%Morison%InpMembers(I)%MHstLMod, & - InputFileData%Morison%InpMembers(I)%PropPot + InputFileData%Morison%InpMembers(I)%PropPot, InputFileData%Morison%InpMembers(I)%FDMod, & + InputFileData%Morison%InpMembers(I)%VnCOffA, InputFileData%Morison%InpMembers(I)%VnCOffB, & + InputFileData%Morison%InpMembers(I)%FDLoFScA, InputFileData%Morison%InpMembers(I)%FDLoFScB IF ( ErrStat2 /= 0 ) THEN - ErrStat2 = ErrID_Fatal - ErrMsg2 = 'Error reading members table row '//trim( Int2LStr(I))//', line ' & - //trim( Int2LStr(FileInfo_In%FileLine(CurLine)))//' of file '//trim(FileInfo_In%FileList(FileInfo_In%FileIndx(CurLine))) - if (Failed()) return; + READ(Line,*,IOSTAT=ErrStat2) InputFileData%Morison%InpMembers(I)%MemberID, InputFileData%Morison%InpMembers(I)%MJointID1, & + InputFileData%Morison%InpMembers(I)%MJointID2, InputFileData%Morison%InpMembers(I)%MPropSetID1, & + InputFileData%Morison%InpMembers(I)%MPropSetID2, InputFileData%Morison%InpMembers(I)%MSecGeom, & + InputFileData%Morison%InpMembers(I)%MSpinOrient, InputFileData%Morison%InpMembers(I)%MDivSize, & + InputFileData%Morison%InpMembers(I)%MCoefMod, InputFileData%Morison%InpMembers(I)%MHstLMod, & + InputFileData%Morison%InpMembers(I)%PropPot + IF ( ErrStat2 /= 0 ) THEN + ErrStat2 = ErrID_Fatal + ErrMsg2 = 'Error reading members table row '//trim( Int2LStr(I))//', line ' & + //trim( Int2LStr(FileInfo_In%FileLine(CurLine)))//' of file '//trim(FileInfo_In%FileList(FileInfo_In%FileIndx(CurLine))) + if (Failed()) return; + ELSE + InputFileData%Morison%InpMembers(I)%FDMod = 0_IntKi + InputFileData%Morison%InpMembers(I)%VnCOffA = -1.0_ReKi + InputFileData%Morison%InpMembers(I)%VnCOffB = -1.0_ReKi + InputFileData%Morison%InpMembers(I)%FDLoFScA = 1.0_ReKi + InputFileData%Morison%InpMembers(I)%FDLoFScB = 1.0_ReKi + END IF + ELSE + IF ( InputFileData%Morison%InpMembers(I)%MSecGeom /= MSecGeom_Rec ) THEN + call WrScr('HydroDyn Warning: The optional member inputs FDMod, VnCOffA, VnCOffB, FDLoFScA, and FDLoFScB are only applicable to members with rectangular sections. These will be ignored for Member ID '//TRIM(num2Lstr(InputFileData%Morison%InpMembers(I)%MemberID))//'. ') + InputFileData%Morison%InpMembers(I)%FDMod = 0_IntKi + InputFileData%Morison%InpMembers(I)%VnCOffA = -1.0_ReKi + InputFileData%Morison%InpMembers(I)%VnCOffB = -1.0_ReKi + InputFileData%Morison%InpMembers(I)%FDLoFScA = 1.0_ReKi + InputFileData%Morison%InpMembers(I)%FDLoFScB = 1.0_ReKi + ELSE IF ( InputFileData%Morison%InpMembers(I)%FDMod == 0_IntKi ) THEN + call WrScr('HydroDyn Warning: Velocity filtering for rectangular-member transverse drag force is only available with FDMod = 1 or 2. The optional member inputs VnCOffA, VnCOffB, FDLoFScA, and FDLoFScB will be ignored for Member ID '//TRIM(num2Lstr(InputFileData%Morison%InpMembers(I)%MemberID))//'. ') + InputFileData%Morison%InpMembers(I)%VnCOffA = -1.0_ReKi + InputFileData%Morison%InpMembers(I)%VnCOffB = -1.0_ReKi + InputFileData%Morison%InpMembers(I)%FDLoFScA = 1.0_ReKi + InputFileData%Morison%InpMembers(I)%FDLoFScB = 1.0_ReKi + END IF END IF + InputFileData%Morison%InpMembers(I)%MSpinOrient = InputFileData%Morison%InpMembers(I)%MSpinOrient * D2R if ( InputFileData%Echo ) WRITE(UnEc, '(A)') trim(FileInfo_In%Lines(CurLine)) ! Echo this line @@ -2482,8 +2515,8 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS RETURN END IF - IF ( InputFileData%Morison%InpMembers(I)%MSecGeom == MSecGeom_Rec .AND. InputFileData%Morison%InpMembers(I)%MHstLMod /= 2 ) THEN - CALL SetErrStat( ErrID_Fatal,'MHstLMod must be 2 for rectangular members.',ErrStat,ErrMsg,RoutineName) + IF ( InputFileData%Morison%InpMembers(I)%MSecGeom == MSecGeom_Rec .AND. InputFileData%Morison%InpMembers(I)%MHstLMod /= 0 .AND. InputFileData%Morison%InpMembers(I)%MHstLMod /= 2 ) THEN + CALL SetErrStat( ErrID_Fatal,'MHstLMod must be 0 or 2 for rectangular members.',ErrStat,ErrMsg,RoutineName) RETURN END IF @@ -2492,6 +2525,22 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS RETURN END IF + ! Optional member inputs for rectangular members + IF ( InputFileData%Morison%InpMembers(I)%FDMod /= 0_IntKi .AND. InputFileData%Morison%InpMembers(I)%FDMod /= 1_IntKi .AND. InputFileData%Morison%InpMembers(I)%FDMod /= 2_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,'FDMod must be 0 (centerline-based drag), 1 (face-based drag), or 2 (face-based suction-side-only drag) for rectangular members.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + + IF ( InputFileData%Morison%InpMembers(I)%FDLoFScA < 0.0_ReKi .OR. InputFileData%Morison%InpMembers(I)%FDLoFScA > 1.0_ReKi ) THEN + CALL SetErrStat( ErrID_Fatal,'FDLoFScA and FDLoFScB for rectangular members must be between 0 and 1 inclusive.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + + IF ( InputFileData%Morison%InpMembers(I)%FDLoFScB < 0.0_ReKi .OR. InputFileData%Morison%InpMembers(I)%FDLoFScB > 1.0_ReKi ) THEN + CALL SetErrStat( ErrID_Fatal,'FDLoFScA and FDLoFScB for rectangular members must be between 0 and 1 inclusive.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + END DO END IF diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 434f77989f..b18a68a66d 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -153,6 +153,80 @@ SUBROUTINE Morison_DirCosMtrx_noSpin( pos0, pos1, DirCos ) END SUBROUTINE Morison_DirCosMtrx_noSpin + +SUBROUTINE GetDisplacedNodePosition( u, p, forceDisplaced, pos ) + TYPE(Morison_InputType), INTENT(IN ) :: u !< Inputs at Time + TYPE(Morison_ParameterType), INTENT(IN ) :: p !< Parameters + LOGICAL, INTENT(IN ) :: forceDisplaced ! Set to true to return the exact displaced position no matter WaveDisp or WaveStMod + REAL(ReKi), INTENT( OUT) :: pos(:,:) ! Displaced node positions + + REAL(ReKi) :: Orient(3,3) + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + ! Undisplaced node position + pos = u%Mesh%Position + pos(3,:) = pos(3,:) - p%WaveField%MSL2SWL ! Z position measured from the SWL + IF ( (p%WaveDisp /= 0) .OR. forceDisplaced ) THEN + ! Use displaced X and Y position + pos(1,:) = pos(1,:) + u%Mesh%TranslationDisp(1,:) + pos(2,:) = pos(2,:) + u%Mesh%TranslationDisp(2,:) + IF ( (p%WaveField%WaveStMod > 0) .OR. forceDisplaced ) THEN + ! Use displaced Z position only when wave stretching is enabled + pos(3,:) = pos(3,:) + u%Mesh%TranslationDisp(3,:) + END IF + ELSE ! p%WaveDisp=0 implies PtfmYMod=0 + ! Rotate the structure based on PtfmRefY (constant) + call GetPtfmRefYOrient(u%PtfmRefY, Orient, ErrStat2, ErrMsg2) + pos = matmul(transpose(Orient),pos) + END IF + +END SUBROUTINE GetDisplacedNodePosition + + +SUBROUTINE YawMember(member, PtfmRefY, ErrStat, ErrMsg) + Type(Morison_MemberType), intent(inout) :: member + Real(ReKi), intent(in ) :: PtfmRefY + Integer(IntKi), intent( out) :: ErrStat + Character(*), intent( out) :: ErrMsg + + Real(ReKi) :: k(3), x_hat(3), y_hat(3) + Real(ReKi) :: kkt(3,3) + Real(ReKi) :: Ak(3,3) + Integer(IntKi) :: ErrStat2 + Character(ErrMsgLen) :: ErrMsg2 + + Character(*), parameter :: RoutineName = 'YawMember' + + ErrStat = ErrID_None + ErrMsg = '' + + call hiFrameTransform(h2i,PtfmRefY,member%k,k,ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + member%k = k + + call hiFrameTransform(h2i,PtfmRefY,member%kkt,kkt,ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + member%kkt = kkt + + call hiFrameTransform(h2i,PtfmRefY,member%Ak,Ak,ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + member%Ak = Ak + + IF (member%MSecGeom == MSecGeom_Rec) THEN + + call hiFrameTransform(h2i,PtfmRefY,member%x_hat,x_hat,ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + member%x_hat = x_hat + + call hiFrameTransform(h2i,PtfmRefY,member%y_hat,y_hat,ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + member%y_hat = y_hat + + END IF + +END SUBROUTINE YawMember + !==================================================================================================== SUBROUTINE GetDistance ( a, b, l ) ! This private subroutine computes the distance between points a and b. @@ -1326,21 +1400,21 @@ SUBROUTINE SetDepthBasedCoefs_Cyl( z, tMG, NCoefDpth, CoefDpths, Cd, Ca, Cp, AxC s = ( CoefDpths(indx1)%Dpth - z ) / dd END IF if ( tMG > 0.0_ReKi ) then - Cd = CoefDpths(indx1)%DpthCdMG*(1-s) + CoefDpths(indx2)%DpthCdMG*s - Ca = CoefDpths(indx1)%DpthCaMG*(1-s) + CoefDpths(indx2)%DpthCaMG*s - Cp = CoefDpths(indx1)%DpthCpMG*(1-s) + CoefDpths(indx2)%DpthCpMG*s - AxCd = CoefDpths(indx1)%DpthAxCdMG*(1-s) + CoefDpths(indx2)%DpthAxCdMG*s - AxCa = CoefDpths(indx1)%DpthAxCaMG*(1-s) + CoefDpths(indx2)%DpthAxCaMG*s - AxCp = CoefDpths(indx1)%DpthAxCpMG*(1-s) + CoefDpths(indx2)%DpthAxCpMG*s - Cb = CoefDpths(indx1)%DpthCbMG*(1-s) + CoefDpths(indx2)%DpthCbMG*s + Cd = CoefDpths(indx1)%DpthCdMG *(1.0-s) + CoefDpths(indx2)%DpthCdMG *s + Ca = CoefDpths(indx1)%DpthCaMG *(1.0-s) + CoefDpths(indx2)%DpthCaMG *s + Cp = CoefDpths(indx1)%DpthCpMG *(1.0-s) + CoefDpths(indx2)%DpthCpMG *s + AxCd = CoefDpths(indx1)%DpthAxCdMG *(1.0-s) + CoefDpths(indx2)%DpthAxCdMG *s + AxCa = CoefDpths(indx1)%DpthAxCaMG *(1.0-s) + CoefDpths(indx2)%DpthAxCaMG *s + AxCp = CoefDpths(indx1)%DpthAxCpMG *(1.0-s) + CoefDpths(indx2)%DpthAxCpMG *s + Cb = CoefDpths(indx1)%DpthCbMG *(1.0-s) + CoefDpths(indx2)%DpthCbMG *s else - Cd = CoefDpths(indx1)%DpthCd*(1-s) + CoefDpths(indx2)%DpthCd*s - Ca = CoefDpths(indx1)%DpthCa*(1-s) + CoefDpths(indx2)%DpthCa*s - Cp = CoefDpths(indx1)%DpthCp*(1-s) + CoefDpths(indx2)%DpthCp*s - AxCd = CoefDpths(indx1)%DpthAxCd*(1-s) + CoefDpths(indx2)%DpthAxCd*s - AxCa = CoefDpths(indx1)%DpthAxCa*(1-s) + CoefDpths(indx2)%DpthAxCa*s - AxCp = CoefDpths(indx1)%DpthAxCp*(1-s) + CoefDpths(indx2)%DpthAxCp*s - Cb = CoefDpths(indx1)%DpthCb*(1-s) + CoefDpths(indx2)%DpthCb*s + Cd = CoefDpths(indx1)%DpthCd *(1.0-s) + CoefDpths(indx2)%DpthCd *s + Ca = CoefDpths(indx1)%DpthCa *(1.0-s) + CoefDpths(indx2)%DpthCa *s + Cp = CoefDpths(indx1)%DpthCp *(1.0-s) + CoefDpths(indx2)%DpthCp *s + AxCd = CoefDpths(indx1)%DpthAxCd *(1.0-s) + CoefDpths(indx2)%DpthAxCd *s + AxCa = CoefDpths(indx1)%DpthAxCa *(1.0-s) + CoefDpths(indx2)%DpthAxCa *s + AxCp = CoefDpths(indx1)%DpthAxCp *(1.0-s) + CoefDpths(indx2)%DpthAxCp *s + Cb = CoefDpths(indx1)%DpthCb *(1.0-s) + CoefDpths(indx2)%DpthCb *s end if @@ -1400,25 +1474,25 @@ SUBROUTINE SetDepthBasedCoefs_Rec( z, tMG, NCoefDpth, CoefDpths, CdA, CdB, CaA, s = ( CoefDpths(indx1)%Dpth - z ) / dd END IF if ( tMG > 0.0_ReKi ) then - CdA = CoefDpths(indx1)%DpthCdAMG*(1-s) + CoefDpths(indx2)%DpthCdAMG*s - CdB = CoefDpths(indx1)%DpthCdBMG*(1-s) + CoefDpths(indx2)%DpthCdBMG*s - CaA = CoefDpths(indx1)%DpthCaAMG*(1-s) + CoefDpths(indx2)%DpthCaAMG*s - CaB = CoefDpths(indx1)%DpthCaBMG*(1-s) + CoefDpths(indx2)%DpthCaBMG*s - Cp = CoefDpths(indx1)%DpthCpMG*(1-s) + CoefDpths(indx2)%DpthCpMG*s - AxCd = CoefDpths(indx1)%DpthAxCdMG*(1-s) + CoefDpths(indx2)%DpthAxCdMG*s - AxCa = CoefDpths(indx1)%DpthAxCaMG*(1-s) + CoefDpths(indx2)%DpthAxCaMG*s - AxCp = CoefDpths(indx1)%DpthAxCpMG*(1-s) + CoefDpths(indx2)%DpthAxCpMG*s - Cb = CoefDpths(indx1)%DpthCbMG*(1-s) + CoefDpths(indx2)%DpthCbMG*s + CdA = CoefDpths(indx1)%DpthCdAMG *(1.0-s) + CoefDpths(indx2)%DpthCdAMG *s + CdB = CoefDpths(indx1)%DpthCdBMG *(1.0-s) + CoefDpths(indx2)%DpthCdBMG *s + CaA = CoefDpths(indx1)%DpthCaAMG *(1.0-s) + CoefDpths(indx2)%DpthCaAMG *s + CaB = CoefDpths(indx1)%DpthCaBMG *(1.0-s) + CoefDpths(indx2)%DpthCaBMG *s + Cp = CoefDpths(indx1)%DpthCpMG *(1.0-s) + CoefDpths(indx2)%DpthCpMG *s + AxCd = CoefDpths(indx1)%DpthAxCdMG *(1.0-s) + CoefDpths(indx2)%DpthAxCdMG *s + AxCa = CoefDpths(indx1)%DpthAxCaMG *(1.0-s) + CoefDpths(indx2)%DpthAxCaMG *s + AxCp = CoefDpths(indx1)%DpthAxCpMG *(1.0-s) + CoefDpths(indx2)%DpthAxCpMG *s + Cb = CoefDpths(indx1)%DpthCbMG *(1.0-s) + CoefDpths(indx2)%DpthCbMG *s else - CdA = CoefDpths(indx1)%DpthCdA*(1-s) + CoefDpths(indx2)%DpthCdA*s - CdB = CoefDpths(indx1)%DpthCdB*(1-s) + CoefDpths(indx2)%DpthCdB*s - CaA = CoefDpths(indx1)%DpthCaA*(1-s) + CoefDpths(indx2)%DpthCaA*s - CaB = CoefDpths(indx1)%DpthCaB*(1-s) + CoefDpths(indx2)%DpthCaB*s - Cp = CoefDpths(indx1)%DpthCp*(1-s) + CoefDpths(indx2)%DpthCp*s - AxCd = CoefDpths(indx1)%DpthAxCd*(1-s) + CoefDpths(indx2)%DpthAxCd*s - AxCa = CoefDpths(indx1)%DpthAxCa*(1-s) + CoefDpths(indx2)%DpthAxCa*s - AxCp = CoefDpths(indx1)%DpthAxCp*(1-s) + CoefDpths(indx2)%DpthAxCp*s - Cb = CoefDpths(indx1)%DpthCb*(1-s) + CoefDpths(indx2)%DpthCb*s + CdA = CoefDpths(indx1)%DpthCdA *(1.0-s) + CoefDpths(indx2)%DpthCdA *s + CdB = CoefDpths(indx1)%DpthCdB *(1.0-s) + CoefDpths(indx2)%DpthCdB *s + CaA = CoefDpths(indx1)%DpthCaA *(1.0-s) + CoefDpths(indx2)%DpthCaA *s + CaB = CoefDpths(indx1)%DpthCaB *(1.0-s) + CoefDpths(indx2)%DpthCaB *s + Cp = CoefDpths(indx1)%DpthCp *(1.0-s) + CoefDpths(indx2)%DpthCp *s + AxCd = CoefDpths(indx1)%DpthAxCd *(1.0-s) + CoefDpths(indx2)%DpthAxCd *s + AxCa = CoefDpths(indx1)%DpthAxCa *(1.0-s) + CoefDpths(indx2)%DpthAxCa *s + AxCp = CoefDpths(indx1)%DpthAxCp *(1.0-s) + CoefDpths(indx2)%DpthAxCp *s + Cb = CoefDpths(indx1)%DpthCb *(1.0-s) + CoefDpths(indx2)%DpthCb *s end if @@ -1493,22 +1567,23 @@ SUBROUTINE SetExternalHydroCoefs_Cyl( MSL2SWL, MCoefMod, MmbrCoefIDIndx, SimplC do i = 1, member%NElements + 1 ! Pull member end-node data from the tables and then linearly interpolate it onto the interior member nodes s = (real(i,ReKi)-1.0) / real(member%NElements,ReKi) + if (member%flipped) s = 1.0-s if ( member%tMG(i) > 0.0_ReKi ) then - member%Cd (i) = CoefMembers(MmbrCoefIDIndx)%MemberCdMG1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCdMG2 *s - member%Ca (i) = CoefMembers(MmbrCoefIDIndx)%MemberCaMG1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCaMG2 *s - member%Cp (i) = CoefMembers(MmbrCoefIDIndx)%MemberCpMG1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCpMG2 *s - member%Cb (i) = CoefMembers(MmbrCoefIDIndx)%MemberCbMG1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCbMG2 *s - member%AxCd (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCaMG1*(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCdMG2*s - member%AxCa (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCaMG1*(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCaMG2*s - member%AxCp (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCpMG1*(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCpMG2*s + member%Cd (i) = CoefMembers(MmbrCoefIDIndx)%MemberCdMG1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberCdMG2 *s + member%Ca (i) = CoefMembers(MmbrCoefIDIndx)%MemberCaMG1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberCaMG2 *s + member%Cp (i) = CoefMembers(MmbrCoefIDIndx)%MemberCpMG1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberCpMG2 *s + member%Cb (i) = CoefMembers(MmbrCoefIDIndx)%MemberCbMG1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberCbMG2 *s + member%AxCd (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCdMG1*(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCdMG2*s + member%AxCa (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCaMG1*(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCaMG2*s + member%AxCp (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCpMG1*(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCpMG2*s else - member%Cd (i) = CoefMembers(MmbrCoefIDIndx)%MemberCd1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCd2 *s - member%Ca (i) = CoefMembers(MmbrCoefIDIndx)%MemberCa1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCa2 *s - member%Cp (i) = CoefMembers(MmbrCoefIDIndx)%MemberCp1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCp2 *s - member%Cb (i) = CoefMembers(MmbrCoefIDIndx)%MemberCb1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCb2 *s - member%AxCd (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCd1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCd2 *s - member%AxCa (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCa1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCa2 *s - member%AxCp (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCp1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCp2 *s + member%Cd (i) = CoefMembers(MmbrCoefIDIndx)%MemberCd1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberCd2 *s + member%Ca (i) = CoefMembers(MmbrCoefIDIndx)%MemberCa1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberCa2 *s + member%Cp (i) = CoefMembers(MmbrCoefIDIndx)%MemberCp1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberCp2 *s + member%Cb (i) = CoefMembers(MmbrCoefIDIndx)%MemberCb1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberCb2 *s + member%AxCd (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCd1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCd2 *s + member%AxCa (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCa1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCa2 *s + member%AxCp (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCp1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCp2 *s end if end do member%propMCF = CoefMembers(MmbrCoefIDIndx)%MemberMCF @@ -1591,26 +1666,27 @@ SUBROUTINE SetExternalHydroCoefs_Rec( MSL2SWL, MCoefMod, MmbrCoefIDIndx, SimplC do i = 1, member%NElements + 1 ! Pull member end-node data from the tables and then linearly interpolate it onto the interior member nodes s = (real(i,ReKi)-1.0) / real(member%NElements,ReKi) + if (member%flipped) s = 1.0-s if ( member%tMG(i) > 0.0_ReKi ) then - member%CdA (i) = CoefMembers(MmbrCoefIDIndx)%MemberCdAMG1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCdAMG2 *s - member%CdB (i) = CoefMembers(MmbrCoefIDIndx)%MemberCdBMG1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCdBMG2 *s - member%CaA (i) = CoefMembers(MmbrCoefIDIndx)%MemberCaAMG1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCaAMG2 *s - member%CaB (i) = CoefMembers(MmbrCoefIDIndx)%MemberCaBMG1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCaBMG2 *s - member%Cp (i) = CoefMembers(MmbrCoefIDIndx)%MemberCpMG1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCpMG2 *s - member%Cb (i) = CoefMembers(MmbrCoefIDIndx)%MemberCbMG1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCbMG2 *s - member%AxCd (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCaMG1*(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCdMG2*s - member%AxCa (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCaMG1*(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCaMG2*s - member%AxCp (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCpMG1*(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCpMG2*s + member%CdA (i) = CoefMembers(MmbrCoefIDIndx)%MemberCdAMG1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberCdAMG2 *s + member%CdB (i) = CoefMembers(MmbrCoefIDIndx)%MemberCdBMG1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberCdBMG2 *s + member%CaA (i) = CoefMembers(MmbrCoefIDIndx)%MemberCaAMG1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberCaAMG2 *s + member%CaB (i) = CoefMembers(MmbrCoefIDIndx)%MemberCaBMG1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberCaBMG2 *s + member%Cp (i) = CoefMembers(MmbrCoefIDIndx)%MemberCpMG1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberCpMG2 *s + member%Cb (i) = CoefMembers(MmbrCoefIDIndx)%MemberCbMG1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberCbMG2 *s + member%AxCd (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCdMG1*(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCdMG2*s + member%AxCa (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCaMG1*(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCaMG2*s + member%AxCp (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCpMG1*(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCpMG2*s else - member%CdA (i) = CoefMembers(MmbrCoefIDIndx)%MemberCdA1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCdA2 *s - member%CdB (i) = CoefMembers(MmbrCoefIDIndx)%MemberCdB1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCdB2 *s - member%CaA (i) = CoefMembers(MmbrCoefIDIndx)%MemberCaA1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCaA2 *s - member%CaB (i) = CoefMembers(MmbrCoefIDIndx)%MemberCaB1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCaB2 *s - member%Cp (i) = CoefMembers(MmbrCoefIDIndx)%MemberCp1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCp2 *s - member%Cb (i) = CoefMembers(MmbrCoefIDIndx)%MemberCb1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCb2 *s - member%AxCd (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCd1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCd2 *s - member%AxCa (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCa1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCa2 *s - member%AxCp (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCp1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCp2 *s + member%CdA (i) = CoefMembers(MmbrCoefIDIndx)%MemberCdA1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberCdA2 *s + member%CdB (i) = CoefMembers(MmbrCoefIDIndx)%MemberCdB1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberCdB2 *s + member%CaA (i) = CoefMembers(MmbrCoefIDIndx)%MemberCaA1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberCaA2 *s + member%CaB (i) = CoefMembers(MmbrCoefIDIndx)%MemberCaB1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberCaB2 *s + member%Cp (i) = CoefMembers(MmbrCoefIDIndx)%MemberCp1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberCp2 *s + member%Cb (i) = CoefMembers(MmbrCoefIDIndx)%MemberCb1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberCb2 *s + member%AxCd (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCd1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCd2 *s + member%AxCa (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCa1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCa2 *s + member%AxCp (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCp1 *(1.0-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCp2 *s end if end do member%propMCF = CoefMembers(MmbrCoefIDIndx)%MemberMCF @@ -2635,7 +2711,22 @@ subroutine SetupMembers( InitInp, p, m, errStat, errMsg ) p%Members(i)%MHstLMod = InitInp%InpMembers(i)%MHstLMod p%Members(i)%MSecGeom = InitInp%InpMembers(i)%MSecGeom p%Members(i)%MSpinOrient = InitInp%InpMembers(i)%MSpinOrient - + p%Members(i)%FDMod = InitInp%InpMembers(i)%FDMod + IF (InitInp%InpMembers(i)%VnCOffA .LE. 0.0_ReKi) THEN + p%Members(i)%VRelNFiltConstA = 1.0_ReKi + p%Members(i)%DragLoFScA = 1.0_ReKi + ELSE + p%Members(i)%VRelNFiltConstA = exp(-2.0*Pi*InitInp%InpMembers(i)%VnCOffA * p%DT) + p%Members(i)%DragLoFScA = InitInp%InpMembers(i)%FDLoFScA + END IF + IF (InitInp%InpMembers(i)%VnCOffB .LE. 0.0_ReKi) THEN + p%Members(i)%VRelNFiltConstB = 1.0_ReKi + p%Members(i)%DragLoFScB = 1.0_ReKi + ELSE + p%Members(i)%VRelNFiltConstB = exp(-2.0*Pi*InitInp%InpMembers(i)%VnCOffB * p%DT) + p%Members(i)%DragLoFScB = InitInp%InpMembers(i)%FDLoFScB + END IF + call AllocateMemberDataArrays(p%Members(i), m%MemberLoads(i), errStat2, errMsg2) call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'SetupMembers') if (ErrStat >= AbortErrLev) return @@ -2865,7 +2956,7 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In ! Define initial system states here: x%DummyContState = 0 - !xd%DummyDiscState = 0 + ALLOCATE ( xd%V_rel_n_FiltStat(p%NJoints), STAT = ErrStat ) IF ( ErrStat /= ErrID_None ) THEN ErrMsg = ' Error allocating space for V_rel_n_FiltStat array.' @@ -2874,6 +2965,14 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In END IF xd%V_rel_n_FiltStat = 0.0_ReKi + ALLOCATE ( xd%MV_rel_n_FiltStat(4,p%NNodes), STAT = ErrStat ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating space for MV_rel_n_FiltStat array.' + ErrStat = ErrID_Fatal + RETURN + END IF + xd%MV_rel_n_FiltStat = 0.0_ReKi + z%DummyConstrState = 0 OtherState%DummyOtherState = 0 @@ -3383,7 +3482,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, REAL(ReKi) :: sinBeta, sinBeta1, sinBeta2 REAL(ReKi) :: cosBeta, cosBeta1, cosBeta2 REAL(ReKi) :: CMatrix(3,3), CMatrix1(3,3), CMatrix2(3,3), CTrans(3,3) ! Direction cosine matrix for element, and its transpose - REAL(ReKi) :: l, z1, z2, zMid, r1, r2, r1b, r2b, r1In, r2In, rMidIn, rn, rn1, rn2, z_hi, zFillGroup + REAL(ReKi) :: l, z1, z2, zMid, r1, r2, r1b, r2b, r1In, r2In, rMidIn, z_hi, zFillGroup REAL(ReKi) :: Sa1, Sa2, Sa1b, Sa2b, SaMidb, Sa1In, Sa2In, SaMidIn REAL(ReKi) :: Sb1, Sb2, Sb1b, Sb2b, SbMidb, Sb1In, Sb2In, SbMidIn REAL(ReKi) :: dRdl_mg, dSadl_mg, dSbdl_mg ! shorthand for taper including marine growth of element i @@ -3433,6 +3532,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, REAL(ReKi) :: FDynPFSInt REAL(ReKi) :: vrelFSInt(3) REAL(ReKi) :: FAMCFFSInt(3) + REAL(ReKi) :: CdFSInt, CdAFSInt, CdBFSInt, AxCdFSInt, CaFSInt, CaAFSInt, CaBFSInt, AxCaFSInt, CpFSInt, AxCpFSInt INTEGER(IntKi) :: MemSubStat, NumFSX REAL(DbKi) :: theta1, theta2 REAL(ReKi) :: x_hat(3), x_hat1(3), x_hat2(3), y_hat(3), y_hat1(3), y_hat2(3), z_hat(3), posMid(3), zetaMid, FSPt(3) @@ -3449,8 +3549,8 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, !=============================================================================================== ! Get displaced positions of the hydrodynamic nodes - CALL GetDisplacedNodePosition( .FALSE., m%DispNodePosHdn ) ! For hydrodynamic loads; depends on WaveDisp and WaveStMod - CALL GetDisplacedNodePosition( .TRUE. , m%DispNodePosHst ) ! For hydrostatic loads; always use actual displaced position + CALL GetDisplacedNodePosition( u, p, .FALSE., m%DispNodePosHdn ) ! For hydrodynamic loads; depends on WaveDisp and WaveStMod + CALL GetDisplacedNodePosition( u, p, .TRUE. , m%DispNodePosHst ) ! For hydrostatic loads; always use actual displaced position !=============================================================================================== ! Calculate the fluid kinematics at all mesh nodes and store for use in the equations below @@ -3679,16 +3779,10 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ELSE IF (mem%MHstLMod == 2) THEN ! Alternative hydrostatic load calculation ! Get free surface elevation and normal at the element midpoint (both assumed constant over the element) posMid = 0.5 * (pos1+pos2) - ! rn is only used to estimate free surface normal numerically - IF (mem%MSecGeom == MSecGeom_Cyl) THEN - rn = 0.5 * (r1b +r2b ) - ELSE IF (mem%MSecGeom == MSecGeom_Rec) THEN - rn = MAX( 0.5*(Sa1b+Sa2b), 0.5*(Sb1b+Sb2b) ) - END IF IF (p%WaveField%WaveStMod > 0) THEN CALL GetTotalWaveElev( Time, posMid, ZetaMid, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL GetFreeSurfaceNormal( Time, posMid, rn, n_hat, ErrStat2, ErrMsg2 ) + CALL GetFreeSurfaceNormal( Time, posMid, n_hat, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FSPt = (/posMid(1),posMid(2),ZetaMid/) ! Reference point on the free surface ELSE @@ -3941,10 +4035,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, 0.5*mem%AxCd(i)*p%WaveField%WtrDens * pi*mem%RMG(i)*dRdl_p * & ! axial part abs(dot_product( mem%k, m%vrel(:,mem%NodeIndx(i)) )) * matmul( mem%kkt, m%vrel(:,mem%NodeIndx(i)) ) ! axial part cont'd ELSE IF (mem%MSecGeom==MSecGeom_Rec) THEN - f_hydro = 0.5*mem%CdB(i)*p%WaveField%WtrDens*mem%SbMG(i)*TwoNorm(vec)*Dot_Product(vec,mem%x_hat)*mem%x_hat + & ! local x-direction - 0.5*mem%CdA(i)*p%WaveField%WtrDens*mem%SaMG(i)*TwoNorm(vec)*Dot_Product(vec,mem%y_hat)*mem%y_hat + & ! local z-direction - 0.25*mem%AxCd(i)*p%WaveField%WtrDens * (dSadl_p*mem%SbMG(i) + dSbdl_p*mem%SaMG(i)) * & ! axial part - abs(dot_product( mem%k, m%vrel(:,mem%NodeIndx(i)) )) * matmul( mem%kkt, m%vrel(:,mem%NodeIndx(i)) ) ! axial part cont'd + Call GetDistDrag_Rec(Time,mem,i,dSadl_p,dSbdl_p,f_hydro,ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF CALL LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%memberLoads(im)%F_D(:, i) ) y%Mesh%Force (:,mem%NodeIndx(i)) = y%Mesh%Force (:,mem%NodeIndx(i)) + m%memberLoads(im)%F_D(1:3, i) @@ -4049,11 +4140,17 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, IF (mem%MSecGeom==MSecGeom_Cyl) THEN dRdl_p = abs(mem%dRdl_mg(FSElem)) dRdl_pp = mem%dRdl_mg(FSElem) - RMGFSInt = SubRatio * mem%RMG(FSElem+1) + (1.0-SubRatio) * mem%RMG(FSElem) + RMGFSInt = SubRatio * mem%RMG( FSElem+1) + (1.0-SubRatio) * mem%RMG( FSElem) + CdFSInt = SubRatio * mem%Cd( FSElem+1) + (1.0-SubRatio) * mem%Cd( FSElem) + AxCdFSInt = SubRatio * mem%AxCd(FSElem+1) + (1.0-SubRatio) * mem%AxCd(FSElem) + CaFSInt = SubRatio * mem%Ca( FSElem+1) + (1.0-SubRatio) * mem%Ca( FSElem) + AxCaFSInt = SubRatio * mem%AxCa(FSElem+1) + (1.0-SubRatio) * mem%AxCa(FSElem) + CpFSInt = SubRatio * mem%Cp( FSElem+1) + (1.0-SubRatio) * mem%Cp( FSElem) + AxCpFSInt = SubRatio * mem%AxCp(FSElem+1) + (1.0-SubRatio) * mem%AxCp(FSElem) vec = matmul( mem%Ak,vrelFSInt ) - F_DS = mem%Cd(FSElem)*p%WaveField%WtrDens*RMGFSInt*TwoNorm(vec)*vec + & - 0.5*mem%AxCd(FSElem)*p%WaveField%WtrDens*pi*RMGFSInt*dRdl_p * & + F_DS = CdFSInt*p%WaveField%WtrDens*RMGFSInt*TwoNorm(vec)*vec + & + 0.5*AxCdFSInt*p%WaveField%WtrDens*pi*RMGFSInt*dRdl_p * & abs(dot_product( mem%k, vrelFSInt )) * matmul( mem%kkt, vrelFSInt ) ! Hydrodynamic added mass and inertia loads @@ -4061,22 +4158,20 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! ------------------- hydrodynamic added mass loads: sides: Section 7.1.3 ------------------------ IF (p%AMMod > 0_IntKi) THEN - Am = mem%Ca(FSElem)*p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt*mem%Ak + & - 2.0*mem%AxCa(FSElem)*p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt*dRdl_p*mem%kkt - F_AS = -matmul( Am, & - SubRatio * u%Mesh%TranslationAcc(:,mem%NodeIndx(FSElem+1)) + & - (1.0-SubRatio) * u%Mesh%TranslationAcc(:,mem%NodeIndx(FSElem )) ) + Am = CaFSInt*p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt*mem%Ak + & + 2.0*AxCaFSInt*p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt*dRdl_p*mem%kkt + F_AS = -matmul( Am, SAFSInt ) END IF ! ------------------- hydrodynamic inertia loads: sides: Section 7.1.4 ------------------------ IF ( mem%PropMCF) THEN - F_IS= p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt * matmul( mem%Ak, FAMCFFSInt ) + & - 2.0*mem%AxCa(FSElem)*p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt*dRdl_p * matmul( mem%kkt, FAFSInt ) + & - 2.0*mem%AxCp(FSElem) *pi*RMGFSInt *dRdl_pp * FDynPFSInt*mem%k + F_IS= p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt * matmul( mem%Ak, FAMCFFSInt ) + & + 2.0*AxCaFSInt*p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt*dRdl_p * matmul( mem%kkt, FAFSInt ) + & + 2.0*AxCpFSInt *pi*RMGFSInt *dRdl_pp * FDynPFSInt*mem%k ELSE - F_IS=(mem%Ca(FSElem)+mem%Cp(FSElem))*p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt * matmul( mem%Ak, FAFSInt ) + & - 2.0*mem%AxCa(FSElem)*p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt*dRdl_p * matmul( mem%kkt, FAFSInt ) + & - 2.0*mem%AxCp(FSElem) *pi*RMGFSInt *dRdl_pp * FDynPFSInt*mem%k + F_IS=(CaFSInt+CpFSInt)*p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt * matmul( mem%Ak, FAFSInt ) + & + 2.0*AxCaFSInt*p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt*dRdl_p * matmul( mem%kkt, FAFSInt ) + & + 2.0*AxCpFSInt *pi*RMGFSInt *dRdl_pp * FDynPFSInt*mem%k END IF END IF ELSE IF (mem%MSecGeom==MSecGeom_Rec) THEN @@ -4086,30 +4181,34 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, dSbdl_pp = mem%dSbdl_mg(FSElem) SaMGFSInt = SubRatio * mem%SaMG(FSElem+1) + (1.0-SubRatio) * mem%SaMG(FSElem) SbMGFSInt = SubRatio * mem%SbMG(FSElem+1) + (1.0-SubRatio) * mem%SbMG(FSElem) + ! CdAFSInt = SubRatio * mem%CdA( FSElem+1) + (1.0-SubRatio) * mem%CdA( FSElem) + ! CdBFSInt = SubRatio * mem%CdB( FSElem+1) + (1.0-SubRatio) * mem%CdB( FSElem) + ! AxCdFSInt = SubRatio * mem%AxCd(FSElem+1) + (1.0-SubRatio) * mem%AxCd(FSElem) + CaAFSInt = SubRatio * mem%CaA( FSElem+1) + (1.0-SubRatio) * mem%CaA( FSElem) + CaBFSInt = SubRatio * mem%CaB( FSElem+1) + (1.0-SubRatio) * mem%CaB( FSElem) + AxCaFSInt = SubRatio * mem%AxCa(FSElem+1) + (1.0-SubRatio) * mem%AxCa(FSElem) + CpFSInt = SubRatio * mem%Cp( FSElem+1) + (1.0-SubRatio) * mem%Cp( FSElem) + AxCpFSInt = SubRatio * mem%AxCp(FSElem+1) + (1.0-SubRatio) * mem%AxCp(FSElem) - vec = matmul( mem%Ak,vrelFSInt ) - F_DS = 0.5*mem%CdB(FSElem)*p%WaveField%WtrDens*SbMGFSInt*TwoNorm(vec)*Dot_Product(vec,mem%x_hat)*mem%x_hat + & ! local x-direction - 0.5*mem%CdA(FSElem)*p%WaveField%WtrDens*SaMGFSInt*TwoNorm(vec)*Dot_Product(vec,mem%y_hat)*mem%y_hat + & ! local z-direction - 0.25*mem%AxCd(FSElem)*p%WaveField%WtrDens * (dSadl_p*SbMGFSInt + dSbdl_p*SaMGFSInt) * & ! axial part - abs(dot_product( mem%k, vrelFSInt )) * matmul( mem%kkt, vrelFSInt ) ! axial part cont'd + Call GetDistDrag_Rec(Time,mem,FSElem,dSadl_p,dSbdl_p,F_DS,ErrStat2,ErrMsg2,SubRatio,vrelFSInt); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Hydrodynamic added mass and inertia loads IF ( .NOT. mem%PropPot ) THEN ! ------------------- hydrodynamic added mass loads: sides: Section 7.1.3 ------------------------ IF (p%AMMod > 0_IntKi) THEN - F_AS = -p%WaveField%WtrDens*mem%CaB(FSElem) * 0.25*pi*SbMGFSInt*SbMGFSInt * Dot_Product(SAFSInt,mem%x_hat)*mem%x_hat & - -p%WaveField%WtrDens*mem%CaA(FSElem) * 0.25*pi*SaMGFSInt*SaMGFSInt * Dot_Product(SAFSInt,mem%y_hat)*mem%y_hat & - -0.5*p%WaveField%WtrDens*mem%AxCa(FSElem) * (dSbdl_p*SaMGFSInt+dSadl_p*SbMGFSInt)*SQRT(SaMGFSInt*SbMGFSInt) * Dot_Product(SAFSInt,mem%k)*mem%k + F_AS = -p%WaveField%WtrDens*CaBFSInt * 0.25*pi*SbMGFSInt*SbMGFSInt * Dot_Product(SAFSInt,mem%x_hat)*mem%x_hat & + -p%WaveField%WtrDens*CaAFSInt * 0.25*pi*SaMGFSInt*SaMGFSInt * Dot_Product(SAFSInt,mem%y_hat)*mem%y_hat & + -0.5*p%WaveField%WtrDens*AxCaFSInt * (dSbdl_p*SaMGFSInt+dSadl_p*SbMGFSInt)*SQRT(SaMGFSInt*SbMGFSInt) * Dot_Product(SAFSInt,mem%k)*mem%k END IF ! ------------------- hydrodynamic inertia loads: sides: Section 7.1.4 ------------------------ - F_IS= mem%Cp(FSElem)*p%WaveField%WtrDens* SaMGFSInt*SbMGFSInt * matmul( mem%Ak, FAFSInt ) + & ! transver FK component - FDynPFSInt*mem%AxCp(FSElem)* (SaMGFSInt*dSbdl_pp+dSadl_pp*SbMGFSInt) *mem%k + & ! axial FK component - p%WaveField%WtrDens*mem%CaB(FSElem) * 0.25*pi*SbMGFSInt*SbMGFSInt * Dot_Product(FAFSInt,mem%x_hat)*mem%x_hat + & ! x-component of diffraction part - p%WaveField%WtrDens*mem%CaA(FSElem) * 0.25*pi*SaMGFSInt*SaMGFSInt * Dot_Product(FAFSInt,mem%y_hat)*mem%y_hat + & ! y-component of diffraction part - 0.5*p%WaveField%WtrDens*mem%AxCa(FSElem) * (dSbdl_p*SaMGFSInt+dSadl_p*SbMGFSInt)*SQRT(SaMGFSInt*SbMGFSInt) * & ! axial component of diffraction part - Dot_Product(FAFSInt,mem%k)*mem%k ! axial component of diffraction part cont'd + F_IS= CpFSInt*p%WaveField%WtrDens* SaMGFSInt*SbMGFSInt * matmul( mem%Ak, FAFSInt ) + & ! transver FK component + FDynPFSInt*AxCpFSInt* (SaMGFSInt*dSbdl_pp+dSadl_pp*SbMGFSInt) *mem%k + & ! axial FK component + p%WaveField%WtrDens*CaBFSInt * 0.25*pi*SbMGFSInt*SbMGFSInt * Dot_Product(FAFSInt,mem%x_hat)*mem%x_hat + & ! x-component of diffraction part + p%WaveField%WtrDens*CaAFSInt * 0.25*pi*SaMGFSInt*SaMGFSInt * Dot_Product(FAFSInt,mem%y_hat)*mem%y_hat + & ! y-component of diffraction part + 0.5*p%WaveField%WtrDens*AxCaFSInt * (dSbdl_p*SaMGFSInt+dSadl_p*SbMGFSInt)*SQRT(SaMGFSInt*SbMGFSInt) * & ! axial component of diffraction part + Dot_Product(FAFSInt,mem%k)*mem%k ! axial component of diffraction part cont'd END IF END IF @@ -4209,7 +4308,8 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ELSE IF ( MemSubStat .NE. 3_IntKi) THEN ! Skip members with centerline completely out of water !----------------------------No load smoothing----------------------------! DO i = mem%i_floor+1,N+1 ! loop through member nodes starting from the first node above seabed - z1 = m%DispNodePosHdn(3, mem%NodeIndx(i)) + z1 = m%DispNodePosHdn(3, mem%NodeIndx(i)) + pos1 = m%DispNodePosHdn(:, mem%NodeIndx(i)) !---------------------------------------------Compute deltal and h_c------------------------------------------! ! Cannot make any assumption about WaveStMod and member orientation IF ( m%NodeInWater(mem%NodeIndx(i)) .EQ. 0_IntKi ) THEN ! Node is out of water @@ -4301,10 +4401,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, 0.5*mem%AxCd(i)*p%WaveField%WtrDens*pi*mem%RMG(i)*dRdl_p * & ! axial part abs(dot_product( mem%k, m%vrel(:,mem%NodeIndx(i)) )) * matmul( mem%kkt, m%vrel(:,mem%NodeIndx(i)) ) ! axial part cont'd ELSE IF (mem%MSecGeom==MSecGeom_Rec) THEN - f_hydro = 0.5*mem%CdB(i)*p%WaveField%WtrDens*mem%SbMG(i)*TwoNorm(vec)*Dot_Product(vec,mem%x_hat)*mem%x_hat + & ! local x-direction - 0.5*mem%CdA(i)*p%WaveField%WtrDens*mem%SaMG(i)*TwoNorm(vec)*Dot_Product(vec,mem%y_hat)*mem%y_hat + & ! local z-direction - 0.25*mem%AxCd(i)*p%WaveField%WtrDens * (dSadl_p*mem%SbMG(i) + dSbdl_p*mem%SaMG(i)) * & ! axial part - abs(dot_product( mem%k, m%vrel(:,mem%NodeIndx(i)) )) * matmul( mem%kkt, m%vrel(:,mem%NodeIndx(i)) ) ! axial part cont'd + Call GetDistDrag_Rec(Time,mem,i,dSadl_p,dSbdl_p,f_hydro,ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF CALL LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%memberLoads(im)%F_D(:, i) ) y%Mesh%Force (:,mem%NodeIndx(i)) = y%Mesh%Force (:,mem%NodeIndx(i)) + m%memberLoads(im)%F_D(1:3, i) @@ -4460,22 +4557,18 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, if (mem%MSecGeom==MSecGeom_Cyl) then r1 = mem%RMGB( 1) r2 = mem%RMGB(N+1) - rn1 = r1 - rn2 = r2 else if (mem%MSecGeom==MSecGeom_Rec) then Sa1 = mem%SaMGB( 1) Sa2 = mem%SaMGB(N+1) Sb1 = mem%SbMGB( 1) Sb2 = mem%SbMGB(N+1) - rn1 = MAX(Sa1,Sb1) - rn2 = MAX(Sa2,Sb2) end if if (mem%i_floor == 0) then ! both ends above or at seabed ! Compute loads on the end plate of node 1 IF (p%WaveField%WaveStMod > 0) THEN CALL GetTotalWaveElev( Time, pos1, Zeta1, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL GetFreeSurfaceNormal( Time, pos1, rn1, n_hat, ErrStat2, ErrMsg2 ) + CALL GetFreeSurfaceNormal( Time, pos1, n_hat, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FSPt = (/pos1(1),pos1(2),Zeta1/) ! Reference point on the free surface ELSE @@ -4503,7 +4596,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, IF (p%WaveField%WaveStMod > 0) THEN CALL GetTotalWaveElev( Time, pos2, Zeta2, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL GetFreeSurfaceNormal( Time, pos2, rn2, n_hat, ErrStat2, ErrMsg2 ) + CALL GetFreeSurfaceNormal( Time, pos2, n_hat, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FSPt = (/pos2(1),pos2(2),Zeta2/) ! Reference point on the free surface ELSE @@ -4532,7 +4625,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, IF (p%WaveField%WaveStMod > 0) THEN CALL GetTotalWaveElev( Time, pos2, Zeta2, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL GetFreeSurfaceNormal( Time, pos2, rn2, n_hat, ErrStat2, ErrMsg2 ) + CALL GetFreeSurfaceNormal( Time, pos2, n_hat, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FSPt = (/pos2(1),pos2(2),Zeta2/) ! Reference point on the free surface ELSE @@ -4649,33 +4742,6 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, CONTAINS - SUBROUTINE GetDisplacedNodePosition( forceDisplaced, pos ) - LOGICAL, INTENT( IN ) :: forceDisplaced ! Set to true to return the exact displaced position no matter WaveDisp or WaveStMod - REAL(ReKi), INTENT( OUT ) :: pos(:,:) ! Displaced node positions - REAL(ReKi) :: Orient(3,3) - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - - ! Undisplaced node position - pos = u%Mesh%Position - pos(3,:) = pos(3,:) - p%WaveField%MSL2SWL ! Z position measured from the SWL - IF ( (p%WaveDisp /= 0) .OR. forceDisplaced ) THEN - ! Use displaced X and Y position - pos(1,:) = pos(1,:) + u%Mesh%TranslationDisp(1,:) - pos(2,:) = pos(2,:) + u%Mesh%TranslationDisp(2,:) - IF ( (p%WaveField%WaveStMod > 0) .OR. forceDisplaced ) THEN - ! Use displaced Z position only when wave stretching is enabled - pos(3,:) = pos(3,:) + u%Mesh%TranslationDisp(3,:) - END IF - ELSE ! p%WaveDisp=0 implies PtfmYMod=0 - ! Rotate the structure based on PtfmRefY (constant) - call GetPtfmRefYOrient(u%PtfmRefY, Orient, ErrStat2, ErrMsg2) - pos = matmul(transpose(Orient),pos) - END IF - - END SUBROUTINE GetDisplacedNodePosition - SUBROUTINE GetTotalWaveElev( Time, pos, Zeta, ErrStat, ErrMsg ) REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. @@ -4693,10 +4759,9 @@ SUBROUTINE GetTotalWaveElev( Time, pos, Zeta, ErrStat, ErrMsg ) END SUBROUTINE GetTotalWaveElev - SUBROUTINE GetFreeSurfaceNormal( Time, pos, r, n, ErrStat, ErrMsg) + SUBROUTINE GetFreeSurfaceNormal( Time, pos, n, ErrStat, ErrMsg) REAL(DbKi), INTENT( In ) :: Time REAL(ReKi), INTENT( In ) :: pos(*) ! Position at which free-surface normal is to be calculated. Third entry ignored if present. - REAL(ReKi), INTENT( In ) :: r ! Distance for central differencing REAL(ReKi), INTENT( OUT ) :: n(3) ! Free-surface normal vector INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None @@ -4706,7 +4771,7 @@ SUBROUTINE GetFreeSurfaceNormal( Time, pos, r, n, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = "" - CALL WaveField_GetNodeWaveNormal( p%WaveField, m%WaveField_m, Time, pos, r, n, ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveNormal( p%WaveField, m%WaveField_m, Time, pos, n, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END SUBROUTINE GetFreeSurfaceNormal @@ -4914,8 +4979,7 @@ SUBROUTINE GetSectionHstLds_Rec( origin, pos0, k_hat, x_hat, y_hat, Sa, Sb, dSad s2 = 0.0_DbKi; end if - dFdl(1:3) = dFdl(1:3) + & - -n(:,i) * ( z1*(s2-s1) + 0.5_DbKi*(z2-z1)/s*(s2*s2-s1*s1) ) + dFdl(1:3) = dFdl(1:3) -n(:,i) * ( z1*(s2-s1) + 0.5_DbKi*(z2-z1)/s*(s2*s2-s1*s1) ) C(1) = (z2-z1)*(x2-x1)/3.0_DbKi/(s*s)*(s2**3-s1**3) + 0.5_DbKi*((z2-z1)*(x1-x0)/s+(x2-x1)*z1/s)*(s2*s2-s1*s1) + z1*(x1-x0)*(s2-s1) C(2) = (z2-z1)*(y2-y1)/3.0_DbKi/(s*s)*(s2**3-s1**3) + 0.5_DbKi*((z2-z1)*(y1-y0)/s+(y2-y1)*z1/s)*(s2*s2-s1*s1) + z1*(y1-y0)*(s2-s1) C(3) = (z2-z1)*(z2-z1)/3.0_DbKi/(s*s)*(s2**3-s1**3) + 0.5_DbKi*((z2-z1)*(z1-z0)/s+(z2-z1)*z1/s)*(s2*s2-s1*s1) + z1*(z1-z0)*(s2-s1) @@ -5641,7 +5705,7 @@ SUBROUTINE getElementHstLds_Mod1( Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1, r2, rh = r1 + h0*dRdl ! Estimate the free-surface normal at the free-surface intersection, n_hat IF ( p%WaveField%WaveStMod > 0_IntKi ) THEN ! If wave stretching is enabled, compute free surface normal - CALL GetFreeSurfaceNormal( Time, FSInt, rh, n_hat, ErrStat2, ErrMsg2 ) + CALL GetFreeSurfaceNormal( Time, FSInt, n_hat, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE ! Without wave stretching, use the normal of the SWL n_hat = (/0.0_ReKi,0.0_ReKi,1.0_ReKi/) @@ -5728,49 +5792,6 @@ SUBROUTINE getElementHstLds_Mod1( Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1, r2, END IF END SUBROUTINE getElementHstLds_Mod1 - SUBROUTINE YawMember(member, PtfmRefY, ErrStat, ErrMsg) - Type(Morison_MemberType), intent(inout) :: member - Real(ReKi), intent(in ) :: PtfmRefY - Integer(IntKi), intent( out) :: ErrStat - Character(*), intent( out) :: ErrMsg - - Real(ReKi) :: k(3), x_hat(3), y_hat(3) - Real(ReKi) :: kkt(3,3) - Real(ReKi) :: Ak(3,3) - Integer(IntKi) :: ErrStat2 - Character(ErrMsgLen) :: ErrMsg2 - - Character(*), parameter :: RoutineName = 'YawMember' - - ErrStat = ErrID_None - ErrMsg = '' - - call hiFrameTransform(h2i,PtfmRefY,member%k,k,ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - member%k = k - - call hiFrameTransform(h2i,PtfmRefY,member%kkt,kkt,ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - member%kkt = kkt - - call hiFrameTransform(h2i,PtfmRefY,member%Ak,Ak,ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - member%Ak = Ak - - IF (member%MSecGeom == MSecGeom_Rec) THEN - - call hiFrameTransform(h2i,PtfmRefY,member%x_hat,x_hat,ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - member%x_hat = x_hat - - call hiFrameTransform(h2i,PtfmRefY,member%y_hat,y_hat,ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - member%y_hat = y_hat - - END IF - - END SUBROUTINE YawMember - SUBROUTINE YawJoint(JointNo,PtfmRefY,AM_End,An_End,DP_Const_End,I_MG_End,ErrStat,ErrMsg) Integer(IntKi), intent(in ) :: JointNo Real(ReKi), intent(in ) :: PtfmRefY @@ -5906,6 +5927,178 @@ SUBROUTINE getMemBallastHiPt(member,z_hi, ErrStat, ErrMsg) END IF END SUBROUTINE getMemBallastHiPt + + SUBROUTINE GetDistDrag_Rec(Time,mem,i,dSadl_p,dSbdl_p,f_hydro,ErrStat,ErrMsg,SubRatio,vrelFSInt) + ! Compute the distributed (axial and transverse) drag per unit length for rectangular sections + Real(DbKi) , intent(in ) :: Time !< Current simulation time in seconds + Type(Morison_MemberType), intent(in ) :: mem !< Current member + Integer(IntKi) , intent(in ) :: i !< Node number within the member (not the global node index) + Real(ReKi) , intent(in ) :: dSadl_p !< Slope of Side A due to tapering (absolute value) + Real(ReKi) , intent(in ) :: dSbdl_p !< Slope of Side B due to tapering (absolute value) + Real(ReKi), optional , intent(in ) :: SubRatio !< Optional input. If provided, drag force will be evaluated at the free-surface intersection. + ! SubRatio is the fraction of element i (between node i and node i+1) submerged in water. + Real(ReKi), optional , intent(in ) :: vrelFSInt(3) !< Optional input. Must be provided if SubRatio is specified. + ! vrelFSInt is the fluid velocity relative to the structure at the free-surface intersection. + Real(ReKi) , intent( out) :: f_hydro(3) !< Sectional drag force (per unit length) + Integer(IntKi) , intent( out) :: ErrStat + Character(*) , intent( out) :: ErrMsg + + ! Local variables for alternative rectangular member transverse drag calculation + Integer(IntKi) :: NodeID ! Global node id of the ith node of the current member + Integer(IntKi) :: NextNodeID ! Global node id of the (i+1)th node of the current member + Integer(IntKi) :: fNo ! Face number + Integer(IntKi) :: tmpNodeInWater + Real(ReKi) :: pos(3) ! Node (on member axis) position + Real(ReKi) :: rToFC(3,4) ! Vectors from node on member axis to the four face centers + Real(ReKi) :: n_hat(3,4) ! Normal vectors of the four faces + Real(ReKi) :: filtConst(4) ! Velocity high-pass filter constants for the four faces + Real(ReKi) :: DragLoFSc(4) ! Drag weighting factors for the four faces + Real(ReKi) :: Cd(4) ! Dimensional drag coefficients for the four faces + Real(ReKi) :: vec(3) ! Relative velocity vector (flow-structure) without the axial component + Real(ReKi) :: posFC(3) ! Position of face center + Real(ReKi) :: SVFC(3) ! Structure velocity at face center + Real(SiKi) :: FVFC(3) ! Flow velocity at face center + Real(SiKi) :: FAFC(3) ! Flow acceleration at face center + Real(ReKi) :: vrelFC ! Relative (flow-structure) velocity at face centers + Real(ReKi) :: vrelFCf ! High-pass filtered relative (flow-structure) velocity at face centers + Real(ReKi) :: STV(3) ! Structure translational velocity at the current node/free-surface intersection + Real(ReKi) :: STV1(3) ! STV at free surface intersection computed from Node i velocity + Real(ReKi) :: STV2(3) ! STV at free surface intersection computed from Node i+1 velocity + Real(ReKi) :: SRV(3) ! Structure rotational velocity at the current node/free-surface intersection + Real(ReKi) :: FiltStat(4) ! High-pass filter states for the four faces + Real(ReKi) :: SaMG, SbMG ! Section side lengths at the current node/free-surface intersection + Real(ReKi) :: CdA, CdB, AxCd ! Drag coefficients at the current node/free-surface intersection + Real(ReKi) :: vrel(3) ! Relative flow velocity at the current node/free-surface intersection + + Integer(IntKi) :: ErrStat2 + Character(ErrMsgLen) :: ErrMsg2 + Character(*), parameter :: RoutineName = 'GetDistDrag_Rec' + + ErrStat = ErrID_None + ErrMsg = '' + + NodeID = mem%NodeIndx(i) + + f_hydro = 0.0_ReKi + IF ( m%NodeInWater(NodeID) .EQ. 0_IntKi ) THEN ! Node out of water + Return + END IF + + ! Node in water + IF ( PRESENT(SubRatio) ) THEN + ! Linearly interpolate the relevant parameters at the free-surface intersection + NextNodeID = mem%NodeIndx(i+1) + SaMG = SubRatio * mem%SaMG(i+1) + (1.0-SubRatio) * mem%SaMG(i) + SbMG = SubRatio * mem%SbMG(i+1) + (1.0-SubRatio) * mem%SbMG(i) + CdA = SubRatio * mem%CdA( i+1) + (1.0-SubRatio) * mem%CdA( i) + CdB = SubRatio * mem%CdB( i+1) + (1.0-SubRatio) * mem%CdB( i) + AxCd = SubRatio * mem%AxCd(i+1) + (1.0-SubRatio) * mem%AxCd(i) + vrel = vrelFSInt + ELSE + ! Use the relevant parameters at node i + SaMG = mem%SaMG(i) + SbMG = mem%SbMG(i) + CdA = mem%CdA( i) + CdB = mem%CdB( i) + AxCd = mem%AxCd(i) + vrel = m%vrel(:,NodeID) + END IF + + ! Axial drag + f_hydro = 0.25 * AxCd * p%WaveField%WtrDens * (dSadl_p*SbMG + dSbdl_p*SaMG) * & ! axial part + abs(dot_product( mem%k, vrel )) * matmul( mem%kkt, vrel ) ! axial part cont'd + + ! Transverse drag + IF (mem%FDMod == 0_IntKi) THEN ! Centerline-based formulation + + vec = matmul( mem%Ak,vrel ) + f_hydro = f_hydro + & + 0.5*CdB*p%WaveField%WtrDens*SbMG*TwoNorm(vec)*Dot_Product(vec,mem%x_hat)*mem%x_hat + & ! local x-direction + 0.5*CdA*p%WaveField%WtrDens*SaMG*TwoNorm(vec)*Dot_Product(vec,mem%y_hat)*mem%y_hat ! local y-direction + + ELSE ! Face-based formulation + + ! Position of node on member axis + IF ( PRESENT(SubRatio) ) THEN + pos = SubRatio * m%DispNodePosHdn( :,NextNodeID) + (1.0-SubRatio) * m%DispNodePosHdn( :,NodeID) + STV1 = u%Mesh%TranslationVel(:, NodeID) + CROSS_PRODUCT( u%Mesh%RotationVel(:, NodeID) , mem%dl * SubRatio * mem%k ) + STV2 = u%Mesh%TranslationVel(:,NextNodeID) + CROSS_PRODUCT( u%Mesh%RotationVel(:,NextNodeID) , - mem%dl * (1.0-SubRatio) * mem%k ) + STV = SubRatio * STV2 + (1.0-SubRatio) * STV1 + SRV = SubRatio * u%Mesh%RotationVel( :,NextNodeID) + (1.0-SubRatio) * u%Mesh%RotationVel( :,NodeID) + FiltStat = SubRatio * xd%MV_rel_n_FiltStat(:,NextNodeID) + (1.0-SubRatio) * xd%MV_rel_n_FiltStat(:,NodeID) + ELSE + pos = m%DispNodePosHdn( :,NodeID) + STV = u%Mesh%TranslationVel(:,NodeID) + SRV = u%Mesh%RotationVel( :,NodeID) + FiltStat = xd%MV_rel_n_FiltStat( :,NodeID) + END IF + + ! Vector from node on member axis to face centers + rToFC(1:3,1) = mem%x_hat * 0.5 * SaMG ! Side B +x_hat side + rToFC(1:3,2) = - mem%x_hat * 0.5 * SaMG ! Side B -x_hat side + rToFC(1:3,3) = mem%y_hat * 0.5 * SbMG ! Side A +y_hat side + rToFC(1:3,4) = - mem%y_hat * 0.5 * SbMG ! Side A -y_hat side + + ! Face normal vectors + n_hat(1:3,1) = mem%x_hat + n_hat(1:3,2) = - mem%x_hat + n_hat(1:3,3) = mem%y_hat + n_hat(1:3,4) = - mem%y_hat + + ! High-pass filter constant for each face + filtConst(1) = mem%VRelNFiltConstB + filtConst(2) = mem%VRelNFiltConstB + filtConst(3) = mem%VRelNFiltConstA + filtConst(4) = mem%VRelNFiltConstA + + ! Weighting factor for each face + DragLoFSc(1) = mem%DragLoFScB + DragLoFSc(2) = mem%DragLoFScB + DragLoFSc(3) = mem%DragLoFScA + DragLoFSc(4) = mem%DragLoFScA + + ! Dimensional drag coefficient for each face + Cd(1) = CdB*p%WaveField%WtrDens*SbMG + Cd(2) = Cd(1) + Cd(3) = CdA*p%WaveField%WtrDens*SaMG + Cd(4) = Cd(3) + + ! Compute and sum the drag force on all four faces + DO fNo = 1,4 + + ! Positions of face center + posFC = pos + rToFC(1:3,fNo) + + ! Compute structure velocity at face center + SVFC = STV + cross_product( SRV, rToFC(1:3,fNo) ) + + ! Compute fluid velocity at face center + Call WaveField_GetNodeWaveVelAcc( p%WaveField, m%WaveField_m, Time, posFC, .TRUE., tmpNodeInWater, FVFC, FAFC, ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Note: We force each face center to also be wetted if the center node is wetted. Otherwise, the load-smoothing procedure might not work + + ! Compute the face-normal component of the relative fluid velocity (fluid-structure) at face center + vrelFC = dot_product( Real(FVFC,ReKi)-SVFC , n_hat(1:3,fNo) ) + ! High-pass-filtered face-center normal relative velocity + vrelFCf = filtConst(fNo) * (vrelFC + FiltStat(fNo)) + + ! Compute drag force based on selected formulation + IF ( mem%FDMod == 1_IntKi ) THEN ! Without suction-side-only formulation + f_hydro = f_hydro + n_hat(1:3,fNo) * ( & + (1.0_ReKi - DragLoFSc(fNo)) * 0.25*Cd(fNo)*abs(vrelFCf)*vrelFCf & + + DragLoFSc(fNo) * 0.25*Cd(fNo)*abs(vrelFC )*vrelFC ) + ELSE ! mem%FDMod == 2_IntKi With suction-side-only formulation + f_hydro = f_hydro + n_hat(1:3,fNo) * ( & + (1.0_ReKi - DragLoFSc(fNo)) * 0.50*Cd(fNo)*abs(vrelFCf)*max(vrelFCf,0.0_ReKi) & + + DragLoFSc(fNo) * 0.50*Cd(fNo)*abs(vrelFC )*max(vrelFC ,0.0_ReKi) ) + END IF + + END DO + + END IF + + END SUBROUTINE GetDistDrag_Rec + + logical function Failed() CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) Failed = ErrStat >= AbortErrLev @@ -5993,10 +6186,13 @@ SUBROUTINE Morison_UpdateDiscState( Time, u, p, x, xd, z, OtherState, m, errStat TYPE(Morison_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: errMsg !< Error message if errStat /= ErrID_None - INTEGER(IntKi) :: J - INTEGER(IntKi) :: nodeInWater + INTEGER(IntKi) :: I, J, im, N + INTEGER(IntKi) :: nodeInWater, tmpInt REAL(ReKi) :: pos(3), vrel(3), FV(3), vmag, vmagf, An_End(3) - REAL(SiKi) :: FVTmp(3) + REAL(ReKi) :: posFC(3), SVFC(3), vrelFC, vrelFCf + REAL(SiKi) :: FVTmp(3),FATmp(3) + TYPE(Morison_MemberType) :: mem !< Current member + INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UpdateDiscState' @@ -6005,27 +6201,17 @@ SUBROUTINE Morison_UpdateDiscState( Time, u, p, x, xd, z, OtherState, m, errStat errStat = ErrID_None errMsg = "" + + CALL GetDisplacedNodePosition( u, p, .FALSE., m%DispNodePosHdn ) ! For hydrodynamic loads; depends on WaveDisp and WaveStMod + ! Update state of the relative normal velocity high-pass filter at each joint DO J = 1, p%NJoints ! Get joint position - IF (p%WaveDisp == 0 ) THEN - ! use the initial X,Y location - pos(1) = u%Mesh%Position(1,J) - pos(2) = u%Mesh%Position(2,J) - ELSE - ! Use current X,Y location - pos(1) = u%Mesh%TranslationDisp(1,J) + u%Mesh%Position(1,J) - pos(2) = u%Mesh%TranslationDisp(2,J) + u%Mesh%Position(2,J) - END IF - IF (p%WaveField%WaveStMod > 0 .AND. p%WaveDisp /= 0) THEN ! Wave stretching enabled - pos(3) = u%Mesh%Position(3,J) + u%Mesh%TranslationDisp(3,J) - p%WaveField%MSL2SWL ! Use the current Z location. - ELSE ! Wave stretching disabled - pos(3) = u%Mesh%Position(3,J) - p%WaveField%MSL2SWL ! We are intentionally using the undisplaced Z position of the node. - END IF + pos = m%DispNodePosHdn(:,J) ! Get fluid velocity at the joint - CALL WaveField_GetNodeWaveVel( p%WaveField, m%WaveField_m, Time, pos, .FALSE., nodeInWater, FVTmp, ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveVelAcc( p%WaveField, m%WaveField_m, Time, pos, .FALSE., nodeInWater, FVTmp, FATmp, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FV = REAL(FVTmp, ReKi) vrel = ( FV - u%Mesh%TranslationVel(:,J) ) * nodeInWater @@ -6043,6 +6229,77 @@ SUBROUTINE Morison_UpdateDiscState( Time, u, p, x, xd, z, OtherState, m, errStat END DO ! J = 1, p%NJoints + ! Update state of the relative normal velocity high-pass filter for each rectangular member + DO im = 1, p%NMembers + IF ( (p%Members(im)%MSecGeom == MSecGeom_Rec) .and. (p%Members(im)%FDMod > 0_IntKi) ) THEN + + N = p%Members(im)%NElements + mem = p%Members(im) + call YawMember(mem, u%PtfmRefY, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + DO I = mem%i_floor+1, N+1 + + pos = m%DispNodePosHdn(:, mem%NodeIndx(I)) + CALL WaveField_GetNodeWaveVelAcc( p%WaveField, m%WaveField_m, Time, pos, .FALSE., nodeInWater, FVTmp, FATmp, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + IF (nodeInWater .EQ. 1_IntKi) THEN + + ! Note: We force each face center to also be wetted if the center node is wetted. Otherwise, the load-smoothing procedure might not work + ! Side B - +x_hat side + posFC = pos + mem%x_hat * 0.5 * mem%SaMG(i) + SVFC = u%Mesh%TranslationVel(:,mem%NodeIndx(i)) + cross_product( u%Mesh%RotationVel(:,mem%NodeIndx(i)), mem%x_hat * 0.5 * mem%SaMG(i) ) + call WaveField_GetNodeWaveVelAcc( p%WaveField, m%WaveField_m, Time, posFC, .TRUE., tmpInt, FVTmp, FATmp, ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + vrelFC = dot_product( REAL(FVTmp,ReKi) - SVFC, mem%x_hat ) + vrelFCf = mem%VRelNFiltConstB * ( vrelFC + xd%MV_rel_n_FiltStat(1,mem%NodeIndx(I)) ) + xd%MV_rel_n_FiltStat(1,mem%NodeIndx(I)) = vrelFCf - vrelFC + + ! Side B - -x_hat side + posFC = pos - mem%x_hat * 0.5 * mem%SaMG(i) + SVFC = u%Mesh%TranslationVel(:,mem%NodeIndx(i)) + cross_product( u%Mesh%RotationVel(:,mem%NodeIndx(i)), -mem%x_hat * 0.5 * mem%SaMG(i) ) + call WaveField_GetNodeWaveVelAcc( p%WaveField, m%WaveField_m, Time, posFC, .TRUE., tmpInt, FVTmp, FATmp, ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + vrelFC = dot_product( REAL(FVTmp,ReKi) - SVFC, -mem%x_hat ) + vrelFCf = mem%VRelNFiltConstB * ( vrelFC + xd%MV_rel_n_FiltStat(2,mem%NodeIndx(I)) ) + xd%MV_rel_n_FiltStat(2,mem%NodeIndx(I)) = vrelFCf - vrelFC + + ! Side A - +y_hat side + posFC = pos + mem%y_hat * 0.5 * mem%SbMG(i) + SVFC = u%Mesh%TranslationVel(:,mem%NodeIndx(i)) + cross_product( u%Mesh%RotationVel(:,mem%NodeIndx(i)), mem%y_hat * 0.5 * mem%SbMG(i) ) + call WaveField_GetNodeWaveVelAcc( p%WaveField, m%WaveField_m, Time, posFC, .TRUE., tmpInt, FVTmp, FATmp, ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + vrelFC = dot_product( REAL(FVTmp,ReKi) - SVFC, mem%y_hat ) + vrelFCf = mem%VRelNFiltConstA * ( vrelFC + xd%MV_rel_n_FiltStat(3,mem%NodeIndx(I)) ) + xd%MV_rel_n_FiltStat(3,mem%NodeIndx(I)) = vrelFCf - vrelFC + + ! Side A - -y_hat side + posFC = pos - mem%y_hat * 0.5 * mem%SbMG(i) + SVFC = u%Mesh%TranslationVel(:,mem%NodeIndx(i)) + cross_product( u%Mesh%RotationVel(:,mem%NodeIndx(i)), -mem%y_hat * 0.5 * mem%SbMG(i) ) + call WaveField_GetNodeWaveVelAcc( p%WaveField, m%WaveField_m, Time, posFC, .TRUE., tmpInt, FVTmp, FATmp, ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + vrelFC = dot_product( REAL(FVTmp,ReKi) - SVFC, -mem%y_hat ) + vrelFCf = mem%VRelNFiltConstA * ( vrelFC + xd%MV_rel_n_FiltStat(4,mem%NodeIndx(I)) ) + xd%MV_rel_n_FiltStat(4,mem%NodeIndx(I)) = vrelFCf - vrelFC + + ELSE + + vrelFC = 0.0_ReKi + + vrelFCf = mem%VRelNFiltConstB * ( vrelFC + xd%MV_rel_n_FiltStat(1,mem%NodeIndx(I)) ) + xd%MV_rel_n_FiltStat(1,mem%NodeIndx(I)) = vrelFCf - vrelFC + + vrelFCf = mem%VRelNFiltConstB * ( vrelFC + xd%MV_rel_n_FiltStat(2,mem%NodeIndx(I)) ) + xd%MV_rel_n_FiltStat(2,mem%NodeIndx(I)) = vrelFCf - vrelFC + + vrelFCf = mem%VRelNFiltConstA * ( vrelFC + xd%MV_rel_n_FiltStat(3,mem%NodeIndx(I)) ) + xd%MV_rel_n_FiltStat(3,mem%NodeIndx(I)) = vrelFCf - vrelFC + + vrelFCf = mem%VRelNFiltConstA * ( vrelFC + xd%MV_rel_n_FiltStat(4,mem%NodeIndx(I)) ) + xd%MV_rel_n_FiltStat(4,mem%NodeIndx(I)) = vrelFCf - vrelFC + + END IF + END DO ! Iterate through member nodes + END IF ! If rectangular member + END DO ! Iterate through members + END SUBROUTINE Morison_UpdateDiscState !---------------------------------------------------------------------------------------------------------------------------------- END MODULE Morison diff --git a/modules/hydrodyn/src/Morison.txt b/modules/hydrodyn/src/Morison.txt index a6b4a536a3..fe912f470c 100644 --- a/modules/hydrodyn/src/Morison.txt +++ b/modules/hydrodyn/src/Morison.txt @@ -101,6 +101,11 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER MmbrFilledIDIndx - - - "Index into the filled group table if this is a filled member" - typedef ^ ^ LOGICAL PropPot - - - "Flag T/F for whether the member is modeled with potential flow theory" - typedef ^ ^ LOGICAL PropMCF - - - "Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model" - +typedef ^ ^ INTEGER FDMod - - - "Rectangular member transverse drag model (0: simple centerline based; 1: face based; 2: face based with suction-side-only formulation" - +typedef ^ ^ ReKi VnCOffA - - - "Rectangular member transverse drag relative velocity high-pass filter cutoff frequency - normal to Side A" Hz +typedef ^ ^ ReKi VnCOffB - - - "Rectangular member transverse drag relative velocity high-pass filter cutoff frequency - normal to Side B" Hz +typedef ^ ^ ReKi FDLoFScA - - - "Rectangular member transverse drag weighting factor - normal to Side A" - +typedef ^ ^ ReKi FDLoFScB - - - "Rectangular member transverse drag weighting factor - normal to Side B" - typedef ^ ^ INTEGER NElements - - - "number of elements in this member" - typedef ^ ^ ReKi RefLength - - - "the reference total length for this member" m typedef ^ ^ ReKi dl - - - "the reference element length for this member (may be less than MDivSize to achieve uniform element lengths)" m @@ -182,6 +187,11 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi AxCa {:} - - "Member axial Ca at each node" - typedef ^ ^ ReKi AxCp {:} - - "Member axial Cp at each node" - typedef ^ ^ ReKi Cb {:} - - "Member Cb at each node" - +typedef ^ ^ IntKi FDMod - - - "Rectangular member transverse drag model (0: simple centerline based; 1: face based; 2: face based with suction-side-only formulation" - +typedef ^ ^ ReKi VRelNFiltConstA - - - "Rectangular member transverse drag relative velocity high-pass filter constant - normal to Side A" - +typedef ^ ^ ReKi VRelNFiltConstB - - - "Rectangular member transverse drag relative velocity high-pass filter constant - normal to Side B" - +typedef ^ ^ ReKi DragLoFScA - - - "Rectangular member transverse drag weighting factor - normal to Side A" - +typedef ^ ^ ReKi DragLoFScB - - - "Rectangular member transverse drag weighting factor - normal to Side B" - typedef ^ ^ ReKi m_fb_l {:} - - "mass of flooded ballast in lower portion of each element" kg typedef ^ ^ ReKi m_fb_u {:} - - "mass of flooded ballast in upper portion of each element" kg typedef ^ ^ ReKi h_cfb_l {:} - - "distance to flooded ballast centroid from node point in lower portion of each element" m @@ -416,6 +426,7 @@ typedef ^ ContinuousStateType SiKi # Define discrete (nondifferentiable) states here: # typedef ^ DiscreteStateType ReKi V_rel_n_FiltStat {:} - - "State of the high-pass filter for the joint relative normal velocity" m/s +typedef ^ DiscreteStateType ReKi MV_rel_n_FiltStat {:}{:} - - "State of the high-pass filter for the rectangular member relative normal velocity" m/s # # # Define constraint states here: @@ -451,7 +462,7 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi V_rel_n_HiPass {:} - - "High-pass filtered normal relative flow velocity at joints" m/s typedef ^ ^ ReKi zFillGroup {:} - - "Instantaneous highest point of each filled group" m typedef ^ ^ MeshMapType VisMeshMap - - - "Mesh mapping for visualization mesh" - -typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - +typedef ^ ^ GridInterp_MiscVarType WaveField_m - - - "misc var information from the Grid Interpolation module" - # ..... Parameters ................................................................................................................ # Define parameters here: diff --git a/modules/hydrodyn/src/Morison_Output.f90 b/modules/hydrodyn/src/Morison_Output.f90 index 4aa0d64dd6..642309b98c 100644 --- a/modules/hydrodyn/src/Morison_Output.f90 +++ b/modules/hydrodyn/src/Morison_Output.f90 @@ -8037,7 +8037,9 @@ SUBROUTINE MrsnOut_Init( InitInp, y, p, InitOut, ErrStat, ErrMsg ) ! Need to search mesh for the two markers which surround the requested output location and then store those marker indices and compute the ! scale factor based on how far they are from the requested output location. ! Since this is being done on markers and not nodes, the subroutine must be called after the Morison_Init() subroutine is called - + IF (p%Members(memberIndx)%Flipped) THEN + p%MOutLst(I)%NodeLocs(J) = 1.0 - p%MOutLst(I)%NodeLocs(J) + END IF CALL GetNeighboringNodes(p%Members(memberIndx), p%MOutLst(I)%NodeLocs(J), m1, m2, i1, i2, s, ErrStat, ErrMsg) p%MOutLst(I)%MeshIndx1(J) = m1 diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 0cbf7b76aa..166dc8f5dd 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -148,6 +148,11 @@ MODULE Morison_Types INTEGER(IntKi) :: MmbrFilledIDIndx = 0_IntKi !< Index into the filled group table if this is a filled member [-] LOGICAL :: PropPot = .false. !< Flag T/F for whether the member is modeled with potential flow theory [-] LOGICAL :: PropMCF = .false. !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] + INTEGER(IntKi) :: FDMod = 0_IntKi !< Rectangular member transverse drag model (0: simple centerline based; 1: face based; 2: face based with suction-side-only formulation [-] + REAL(ReKi) :: VnCOffA = 0.0_ReKi !< Rectangular member transverse drag relative velocity high-pass filter cutoff frequency - normal to Side A [Hz] + REAL(ReKi) :: VnCOffB = 0.0_ReKi !< Rectangular member transverse drag relative velocity high-pass filter cutoff frequency - normal to Side B [Hz] + REAL(ReKi) :: FDLoFScA = 0.0_ReKi !< Rectangular member transverse drag weighting factor - normal to Side A [-] + REAL(ReKi) :: FDLoFScB = 0.0_ReKi !< Rectangular member transverse drag weighting factor - normal to Side B [-] INTEGER(IntKi) :: NElements = 0_IntKi !< number of elements in this member [-] REAL(ReKi) :: RefLength = 0.0_ReKi !< the reference total length for this member [m] REAL(ReKi) :: dl = 0.0_ReKi !< the reference element length for this member (may be less than MDivSize to achieve uniform element lengths) [m] @@ -235,6 +240,11 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AxCa !< Member axial Ca at each node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AxCp !< Member axial Cp at each node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Cb !< Member Cb at each node [-] + INTEGER(IntKi) :: FDMod = 0_IntKi !< Rectangular member transverse drag model (0: simple centerline based; 1: face based; 2: face based with suction-side-only formulation [-] + REAL(ReKi) :: VRelNFiltConstA = 0.0_ReKi !< Rectangular member transverse drag relative velocity high-pass filter constant - normal to Side A [-] + REAL(ReKi) :: VRelNFiltConstB = 0.0_ReKi !< Rectangular member transverse drag relative velocity high-pass filter constant - normal to Side B [-] + REAL(ReKi) :: DragLoFScA = 0.0_ReKi !< Rectangular member transverse drag weighting factor - normal to Side A [-] + REAL(ReKi) :: DragLoFScB = 0.0_ReKi !< Rectangular member transverse drag weighting factor - normal to Side B [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: m_fb_l !< mass of flooded ballast in lower portion of each element [kg] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: m_fb_u !< mass of flooded ballast in upper portion of each element [kg] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: h_cfb_l !< distance to flooded ballast centroid from node point in lower portion of each element [m] @@ -483,6 +493,7 @@ MODULE Morison_Types ! ========= Morison_DiscreteStateType ======= TYPE, PUBLIC :: Morison_DiscreteStateType REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: V_rel_n_FiltStat !< State of the high-pass filter for the joint relative normal velocity [m/s] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MV_rel_n_FiltStat !< State of the high-pass filter for the rectangular member relative normal velocity [m/s] END TYPE Morison_DiscreteStateType ! ======================= ! ========= Morison_ConstraintStateType ======= @@ -519,7 +530,7 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: V_rel_n_HiPass !< High-pass filtered normal relative flow velocity at joints [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: zFillGroup !< Instantaneous highest point of each filled group [m] TYPE(MeshMapType) :: VisMeshMap !< Mesh mapping for visualization mesh [-] - TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] + TYPE(GridInterp_MiscVarType) :: WaveField_m !< misc var information from the Grid Interpolation module [-] END TYPE Morison_MiscVarType ! ======================= ! ========= Morison_ParameterType ======= @@ -1064,6 +1075,11 @@ subroutine Morison_CopyMemberInputType(SrcMemberInputTypeData, DstMemberInputTyp DstMemberInputTypeData%MmbrFilledIDIndx = SrcMemberInputTypeData%MmbrFilledIDIndx DstMemberInputTypeData%PropPot = SrcMemberInputTypeData%PropPot DstMemberInputTypeData%PropMCF = SrcMemberInputTypeData%PropMCF + DstMemberInputTypeData%FDMod = SrcMemberInputTypeData%FDMod + DstMemberInputTypeData%VnCOffA = SrcMemberInputTypeData%VnCOffA + DstMemberInputTypeData%VnCOffB = SrcMemberInputTypeData%VnCOffB + DstMemberInputTypeData%FDLoFScA = SrcMemberInputTypeData%FDLoFScA + DstMemberInputTypeData%FDLoFScB = SrcMemberInputTypeData%FDLoFScB DstMemberInputTypeData%NElements = SrcMemberInputTypeData%NElements DstMemberInputTypeData%RefLength = SrcMemberInputTypeData%RefLength DstMemberInputTypeData%dl = SrcMemberInputTypeData%dl @@ -1105,6 +1121,11 @@ subroutine Morison_PackMemberInputType(RF, Indata) call RegPack(RF, InData%MmbrFilledIDIndx) call RegPack(RF, InData%PropPot) call RegPack(RF, InData%PropMCF) + call RegPack(RF, InData%FDMod) + call RegPack(RF, InData%VnCOffA) + call RegPack(RF, InData%VnCOffB) + call RegPack(RF, InData%FDLoFScA) + call RegPack(RF, InData%FDLoFScB) call RegPack(RF, InData%NElements) call RegPack(RF, InData%RefLength) call RegPack(RF, InData%dl) @@ -1138,6 +1159,11 @@ subroutine Morison_UnPackMemberInputType(RF, OutData) call RegUnpack(RF, OutData%MmbrFilledIDIndx); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%PropPot); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%PropMCF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FDMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VnCOffA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VnCOffB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FDLoFScA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FDLoFScB); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NElements); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%RefLength); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%dl); if (RegCheckErr(RF, RoutineName)) return @@ -1724,6 +1750,11 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if DstMemberTypeData%Cb = SrcMemberTypeData%Cb end if + DstMemberTypeData%FDMod = SrcMemberTypeData%FDMod + DstMemberTypeData%VRelNFiltConstA = SrcMemberTypeData%VRelNFiltConstA + DstMemberTypeData%VRelNFiltConstB = SrcMemberTypeData%VRelNFiltConstB + DstMemberTypeData%DragLoFScA = SrcMemberTypeData%DragLoFScA + DstMemberTypeData%DragLoFScB = SrcMemberTypeData%DragLoFScB if (allocated(SrcMemberTypeData%m_fb_l)) then LB(1:1) = lbound(SrcMemberTypeData%m_fb_l) UB(1:1) = ubound(SrcMemberTypeData%m_fb_l) @@ -2291,6 +2322,11 @@ subroutine Morison_PackMemberType(RF, Indata) call RegPackAlloc(RF, InData%AxCa) call RegPackAlloc(RF, InData%AxCp) call RegPackAlloc(RF, InData%Cb) + call RegPack(RF, InData%FDMod) + call RegPack(RF, InData%VRelNFiltConstA) + call RegPack(RF, InData%VRelNFiltConstB) + call RegPack(RF, InData%DragLoFScA) + call RegPack(RF, InData%DragLoFScB) call RegPackAlloc(RF, InData%m_fb_l) call RegPackAlloc(RF, InData%m_fb_u) call RegPackAlloc(RF, InData%h_cfb_l) @@ -2400,6 +2436,11 @@ subroutine Morison_UnPackMemberType(RF, OutData) call RegUnpackAlloc(RF, OutData%AxCa); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%AxCp); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%Cb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FDMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VRelNFiltConstA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VRelNFiltConstB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DragLoFScA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DragLoFScB); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%m_fb_l); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%m_fb_u); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%h_cfb_l); if (RegCheckErr(RF, RoutineName)) return @@ -4236,7 +4277,7 @@ subroutine Morison_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyDiscState' ErrStat = ErrID_None @@ -4253,6 +4294,18 @@ subroutine Morison_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, E end if DstDiscStateData%V_rel_n_FiltStat = SrcDiscStateData%V_rel_n_FiltStat end if + if (allocated(SrcDiscStateData%MV_rel_n_FiltStat)) then + LB(1:2) = lbound(SrcDiscStateData%MV_rel_n_FiltStat) + UB(1:2) = ubound(SrcDiscStateData%MV_rel_n_FiltStat) + if (.not. allocated(DstDiscStateData%MV_rel_n_FiltStat)) then + allocate(DstDiscStateData%MV_rel_n_FiltStat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%MV_rel_n_FiltStat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%MV_rel_n_FiltStat = SrcDiscStateData%MV_rel_n_FiltStat + end if end subroutine subroutine Morison_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) @@ -4265,6 +4318,9 @@ subroutine Morison_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) if (allocated(DiscStateData%V_rel_n_FiltStat)) then deallocate(DiscStateData%V_rel_n_FiltStat) end if + if (allocated(DiscStateData%MV_rel_n_FiltStat)) then + deallocate(DiscStateData%MV_rel_n_FiltStat) + end if end subroutine subroutine Morison_PackDiscState(RF, Indata) @@ -4273,6 +4329,7 @@ subroutine Morison_PackDiscState(RF, Indata) character(*), parameter :: RoutineName = 'Morison_PackDiscState' if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%V_rel_n_FiltStat) + call RegPackAlloc(RF, InData%MV_rel_n_FiltStat) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -4280,11 +4337,12 @@ subroutine Morison_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackDiscState' - integer(B4Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%V_rel_n_FiltStat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MV_rel_n_FiltStat); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -4635,7 +4693,7 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call NWTC_Library_CopyMeshMapType(SrcMiscData%VisMeshMap, DstMiscData%VisMeshMap, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) + call GridInterp_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end subroutine @@ -4722,7 +4780,7 @@ subroutine Morison_DestroyMisc(MiscData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyMeshMapType(MiscData%VisMeshMap, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) + call GridInterp_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -4763,7 +4821,7 @@ subroutine Morison_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%V_rel_n_HiPass) call RegPackAlloc(RF, InData%zFillGroup) call NWTC_Library_PackMeshMapType(RF, InData%VisMeshMap) - call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) + call GridInterp_PackMisc(RF, InData%WaveField_m) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -4810,7 +4868,7 @@ subroutine Morison_UnPackMisc(RF, OutData) call RegUnpackAlloc(RF, OutData%V_rel_n_HiPass); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%zFillGroup); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackMeshMapType(RF, OutData%VisMeshMap) ! VisMeshMap - call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m + call GridInterp_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m end subroutine subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/hydrodyn/src/SS_Excitation.txt b/modules/hydrodyn/src/SS_Excitation.txt index 1372e9a823..01a573b589 100644 --- a/modules/hydrodyn/src/SS_Excitation.txt +++ b/modules/hydrodyn/src/SS_Excitation.txt @@ -43,7 +43,7 @@ typedef ^ ^ SS_Exc_ContinuousStateType # Define any data that are used only for efficiency purposes (these variables are not associated with time): # e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. typedef ^ MiscVarType INTEGER LastIndWave - 1 - "last used index in the WaveTime array" - -typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - +typedef ^ ^ GridInterp_MiscVarType WaveField_m - - - "misc var information from the Grid Interpolation module" - # ..... Parameters ......................... diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 22ba2cac7b..aa0d25a528 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -73,7 +73,7 @@ MODULE SS_Excitation_Types ! ========= SS_Exc_MiscVarType ======= TYPE, PUBLIC :: SS_Exc_MiscVarType INTEGER(IntKi) :: LastIndWave = 1 !< last used index in the WaveTime array [-] - TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] + TYPE(GridInterp_MiscVarType) :: WaveField_m !< misc var information from the Grid Interpolation module [-] END TYPE SS_Exc_MiscVarType ! ======================= ! ========= SS_Exc_ParameterType ======= @@ -494,7 +494,7 @@ subroutine SS_Exc_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = '' DstMiscData%LastIndWave = SrcMiscData%LastIndWave - call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) + call GridInterp_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end subroutine @@ -508,7 +508,7 @@ subroutine SS_Exc_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SS_Exc_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) + call GridInterp_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -518,7 +518,7 @@ subroutine SS_Exc_PackMisc(RF, Indata) character(*), parameter :: RoutineName = 'SS_Exc_PackMisc' if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%LastIndWave) - call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) + call GridInterp_PackMisc(RF, InData%WaveField_m) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -528,7 +528,7 @@ subroutine SS_Exc_UnPackMisc(RF, OutData) character(*), parameter :: RoutineName = 'SS_Exc_UnPackMisc' if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%LastIndWave); if (RegCheckErr(RF, RoutineName)) return - call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m + call GridInterp_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m end subroutine subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/hydrodyn/src/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index bf1260f4ca..5194aae156 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -241,7 +241,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! Set up wave excitation grid - Can no longer use the WaveField parameters due to different headings ! Copy WaveField grid parameters - call SeaSt_WaveField_CopyParam(p%WaveField%GridParams, p%ExctnGridParams, 0, ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call GridInterp_CopyParam(p%WaveField%VolGridParams, p%ExctnGridParams, 0, ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( p%ExctnDisp == 0 ) then p%ExctnGridParams%n(2:3) = 1_IntKi p%ExctnGridParams%delta(2:3) = 0.0_SiKi @@ -257,7 +257,6 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS p%ExctnGridParams%pZero(4) = -Pi end if p%ExctnGridParams%n(4) = p%NExctnHdg+1 - p%ExctnGridParams%Z_depth = -1.0 ! Set to Z_depth to a negative value to indicate uniform "z" grid for platform heading ! This module's implementation requires that if NBodyMod = 2 or 3, then there is one instance of a WAMIT module for each body, therefore, HydroDyn may have NBody > 1, but this WAMIT module will have NBody = 1 if ( (p%NBodyMod > 1) .and. (p%NBody > 1) ) then @@ -1101,16 +1100,18 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! Apply rotation only for NBodyMod = 1,3 do J = 1, NInpWvDir do I = 1, NInpFreq - - Ctmp1 = ( HdroExctn(I,J,1)*cos(InitInp%PtfmRefztRot(1)) ) - ( HdroExctn(I,J,2)*sin(InitInp%PtfmRefztRot(1)) ) - Ctmp2 = ( HdroExctn(I,J,1)*sin(InitInp%PtfmRefztRot(1)) ) + ( HdroExctn(I,J,2)*cos(InitInp%PtfmRefztRot(1)) ) - Ctmp4 = ( HdroExctn(I,J,4)*cos(InitInp%PtfmRefztRot(1)) ) - ( HdroExctn(I,J,5)*sin(InitInp%PtfmRefztRot(1)) ) - Ctmp5 = ( HdroExctn(I,J,4)*sin(InitInp%PtfmRefztRot(1)) ) + ( HdroExctn(I,J,5)*cos(InitInp%PtfmRefztRot(1)) ) - - HdroExctn(I,J,1) = Ctmp1 - HdroExctn(I,J,2) = Ctmp2 - HdroExctn(I,J,4) = Ctmp4 - HdroExctn(I,J,5) = Ctmp5 + do iBody = 1, p%NBody + K = 6*(iBody-1) + Ctmp1 = ( HdroExctn(I,J,K+1)*cos(InitInp%PtfmRefztRot(iBody)) ) - ( HdroExctn(I,J,K+2)*sin(InitInp%PtfmRefztRot(iBody)) ) + Ctmp2 = ( HdroExctn(I,J,K+1)*sin(InitInp%PtfmRefztRot(iBody)) ) + ( HdroExctn(I,J,K+2)*cos(InitInp%PtfmRefztRot(iBody)) ) + Ctmp4 = ( HdroExctn(I,J,K+4)*cos(InitInp%PtfmRefztRot(iBody)) ) - ( HdroExctn(I,J,K+5)*sin(InitInp%PtfmRefztRot(iBody)) ) + Ctmp5 = ( HdroExctn(I,J,K+4)*sin(InitInp%PtfmRefztRot(iBody)) ) + ( HdroExctn(I,J,K+5)*cos(InitInp%PtfmRefztRot(iBody)) ) + + HdroExctn(I,J,K+1) = Ctmp1 + HdroExctn(I,J,K+2) = Ctmp2 + HdroExctn(I,J,K+4) = Ctmp4 + HdroExctn(I,J,K+5) = Ctmp5 + end do end do end do diff --git a/modules/hydrodyn/src/WAMIT.txt b/modules/hydrodyn/src/WAMIT.txt index 0d07cfe542..f826ab565a 100644 --- a/modules/hydrodyn/src/WAMIT.txt +++ b/modules/hydrodyn/src/WAMIT.txt @@ -17,6 +17,7 @@ usefrom Conv_Radiation.txt usefrom SS_Radiation.txt usefrom SS_Excitation.txt usefrom SeaSt_WaveField.txt +usefrom GridInterp.txt typedef WAMIT/WAMIT InitInputType INTEGER NBody - - - "[>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6]" - typedef ^ ^ INTEGER NBodyMod - - - "Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1]" - @@ -95,7 +96,7 @@ typedef ^ ^ SS_Exc_Outp typedef ^ ^ Conv_Rdtn_MiscVarType Conv_Rdtn - - - "" - typedef ^ ^ Conv_Rdtn_InputType Conv_Rdtn_u - - - "" - typedef ^ ^ Conv_Rdtn_OutputType Conv_Rdtn_y - - - "" - -typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - +typedef ^ ^ GridInterp_MiscVarType WaveField_m - - - "misc var information from the Grid Interpolation module" - # ..... Parameters ................................................................................................................ # Define parameters here: @@ -120,7 +121,7 @@ typedef ^ ^ SS_Exc_Para typedef ^ ^ DbKi DT - - - "" - typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" typedef ^ ^ INTEGER PtfmYMod - - - "Large yaw model" - -typedef ^ ^ SeaSt_WaveField_ParameterType ExctnGridParams - - - "Parameters of WaveExctnGrid" - +typedef ^ ^ GridInterp_ParameterType ExctnGridParams - - - "Parameters of WaveExctnGrid" - # # # ..... Inputs .................................................................................................................... diff --git a/modules/hydrodyn/src/WAMIT2.f90 b/modules/hydrodyn/src/WAMIT2.f90 index 3c38462510..ef92fab0fa 100644 --- a/modules/hydrodyn/src/WAMIT2.f90 +++ b/modules/hydrodyn/src/WAMIT2.f90 @@ -2646,7 +2646,7 @@ SUBROUTINE CheckInitInput( InitInp, p, MnDriftData, NewmanAppData, DiffQTFData, ! Set up 2nd-order wave excitation grid ! Copy WaveField grid parameters - call SeaSt_WaveField_CopyParam(InitInp%WaveField%GridParams, p%Exctn2GridParams, 0, ErrStatTmp, ErrMsgTmp); CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) + call GridInterp_CopyParam(InitInp%WaveField%VolGridParams, p%Exctn2GridParams, 0, ErrStatTmp, ErrMsgTmp); CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) ! x and y grids are currently not used for second-order wave excitation p%Exctn2GridParams%n(2:3) = 1_IntKi p%Exctn2GridParams%delta(2:3) = 0.0_SiKi @@ -2662,7 +2662,6 @@ SUBROUTINE CheckInitInput( InitInp, p, MnDriftData, NewmanAppData, DiffQTFData, p%Exctn2GridParams%pZero(4) = -Pi end if p%Exctn2GridParams%n(4) = p%NExctnHdg+1 - p%Exctn2GridParams%Z_depth = -1.0 ! Set to Z_depth to a negative value to indicate uniform "z" grid for platform heading !> 1. Check that we only specified one of MnDrift, NewmanApp, or DiffQTF diff --git a/modules/hydrodyn/src/WAMIT2.txt b/modules/hydrodyn/src/WAMIT2.txt index ad3ec0d6f3..9fa2e20306 100644 --- a/modules/hydrodyn/src/WAMIT2.txt +++ b/modules/hydrodyn/src/WAMIT2.txt @@ -14,6 +14,7 @@ # make sure that the file name does not have any trailing white spaces! include Registry_NWTC_Library.txt usefrom SeaSt_WaveField.txt +usefrom GridInterp.txt param WAMIT2/WAMIT2 unused INTEGER MaxWAMIT2Outputs - 6 - "" - @@ -50,7 +51,7 @@ typedef ^ ^ LOGICAL SumQTFF # e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. typedef ^ MiscVarType INTEGER LastIndWave : - - "Index for last interpolation step of 2nd order forces" - typedef ^ ^ ReKi F_Waves2 {:} - - "2nd order force from this timestep" - -typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - +typedef ^ ^ GridInterp_MiscVarType WaveField_m - - - "misc var information from the Grid Interpolation module" - # ..... Parameters ................................................................................................................ # Define parameters here: @@ -61,7 +62,7 @@ typedef ^ ^ INTEGER NBodyMod #The 2nd order force time series grid typedef ^ ^ SiKi WaveExctn2Grid {:}{:}{:}{:}{:} - - "Grid of time series of the resulting 2nd order force (Index 1: Time, Index 2: x, Index 3: y, Index 4: platform heading, and Index 5: load component)" (N) -typedef ^ ^ SeaSt_WaveField_ParameterType Exctn2GridParams - - - "Parameters of WaveExctn2Grid" - +typedef ^ ^ GridInterp_ParameterType Exctn2GridParams - - - "Parameters of WaveExctn2Grid" - #Flags set for dimensions to use with each method (MnDrift, NewmanApp, etc). These are stored by method because .8 files that can be used in MnDrift or NewmanApp don't have some of the dimensions. typedef ^ ^ LOGICAL MnDriftDims {6} - - "Flags for which dimensions to calculate in MnDrift calculations" - diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index 5f928caa56..ba8b8c4490 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -65,7 +65,7 @@ MODULE WAMIT2_Types TYPE, PUBLIC :: WAMIT2_MiscVarType INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: LastIndWave !< Index for last interpolation step of 2nd order forces [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_Waves2 !< 2nd order force from this timestep [-] - TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] + TYPE(GridInterp_MiscVarType) :: WaveField_m !< misc var information from the Grid Interpolation module [-] END TYPE WAMIT2_MiscVarType ! ======================= ! ========= WAMIT2_ParameterType ======= @@ -73,7 +73,7 @@ MODULE WAMIT2_Types INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveExctn2Grid !< Grid of time series of the resulting 2nd order force (Index 1: Time, Index 2: x, Index 3: y, Index 4: platform heading, and Index 5: load component) [(N)] - TYPE(SeaSt_WaveField_ParameterType) :: Exctn2GridParams !< Parameters of WaveExctn2Grid [-] + TYPE(GridInterp_ParameterType) :: Exctn2GridParams !< Parameters of WaveExctn2Grid [-] LOGICAL , DIMENSION(1:6) :: MnDriftDims = .false. !< Flags for which dimensions to calculate in MnDrift calculations [-] LOGICAL , DIMENSION(1:6) :: NewmanAppDims = .false. !< Flags for which dimensions to calculate in NewmanApp calculations [-] LOGICAL , DIMENSION(1:6) :: DiffQTFDims = .false. !< Flags for which dimensions to calculate in DiffQTF calculations [-] @@ -321,7 +321,7 @@ subroutine WAMIT2_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%F_Waves2 = SrcMiscData%F_Waves2 end if - call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) + call GridInterp_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end subroutine @@ -341,7 +341,7 @@ subroutine WAMIT2_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%F_Waves2)) then deallocate(MiscData%F_Waves2) end if - call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) + call GridInterp_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -352,7 +352,7 @@ subroutine WAMIT2_PackMisc(RF, Indata) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%LastIndWave) call RegPackAlloc(RF, InData%F_Waves2) - call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) + call GridInterp_PackMisc(RF, InData%WaveField_m) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -366,7 +366,7 @@ subroutine WAMIT2_UnPackMisc(RF, OutData) if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%LastIndWave); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%F_Waves2); if (RegCheckErr(RF, RoutineName)) return - call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m + call GridInterp_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m end subroutine subroutine WAMIT2_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -395,7 +395,7 @@ subroutine WAMIT2_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs end if DstParamData%WaveExctn2Grid = SrcParamData%WaveExctn2Grid end if - call SeaSt_WaveField_CopyParam(SrcParamData%Exctn2GridParams, DstParamData%Exctn2GridParams, CtrlCode, ErrStat2, ErrMsg2) + call GridInterp_CopyParam(SrcParamData%Exctn2GridParams, DstParamData%Exctn2GridParams, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstParamData%MnDriftDims = SrcParamData%MnDriftDims @@ -422,7 +422,7 @@ subroutine WAMIT2_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%WaveExctn2Grid)) then deallocate(ParamData%WaveExctn2Grid) end if - call SeaSt_WaveField_DestroyParam(ParamData%Exctn2GridParams, ErrStat2, ErrMsg2) + call GridInterp_DestroyParam(ParamData%Exctn2GridParams, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -434,7 +434,7 @@ subroutine WAMIT2_PackParam(RF, Indata) call RegPack(RF, InData%NBody) call RegPack(RF, InData%NBodyMod) call RegPackAlloc(RF, InData%WaveExctn2Grid) - call SeaSt_WaveField_PackParam(RF, InData%Exctn2GridParams) + call GridInterp_PackParam(RF, InData%Exctn2GridParams) call RegPack(RF, InData%MnDriftDims) call RegPack(RF, InData%NewmanAppDims) call RegPack(RF, InData%DiffQTFDims) @@ -459,7 +459,7 @@ subroutine WAMIT2_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NBodyMod); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WaveExctn2Grid); if (RegCheckErr(RF, RoutineName)) return - call SeaSt_WaveField_UnpackParam(RF, OutData%Exctn2GridParams) ! Exctn2GridParams + call GridInterp_UnpackParam(RF, OutData%Exctn2GridParams) ! Exctn2GridParams call RegUnpack(RF, OutData%MnDriftDims); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NewmanAppDims); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DiffQTFDims); if (RegCheckErr(RF, RoutineName)) return diff --git a/modules/hydrodyn/src/WAMIT_Interp.f90 b/modules/hydrodyn/src/WAMIT_Interp.f90 index 90a95e3432..a41191bcf4 100644 --- a/modules/hydrodyn/src/WAMIT_Interp.f90 +++ b/modules/hydrodyn/src/WAMIT_Interp.f90 @@ -29,8 +29,9 @@ MODULE WAMIT_Interp USE NWTC_Library - use SeaSt_WaveField_Types, only: SeaSt_WaveField_ParameterType, SeaSt_WaveField_MiscVarType - use SeaSt_WaveField, only: WaveField_Interp_Setup3D, WaveField_Interp_Setup4D + use GridInterp_Types, only: GridInterp_ParameterType, GridInterp_MiscVarType + use GridInterp, only: GridInterpSetup3D, GridInterpSetup4D, GridInterp3DVec6, GridInterp4DVec6 + IMPLICIT NONE PRIVATE @@ -654,30 +655,16 @@ function WAMIT_ForceWaves_Interp_3D_vec6(Time, pos, pKinXX, WF_p, WF_m, ErrStat3 real(DbKi), intent(in ) :: Time real(ReKi), intent(in ) :: pos(2) !< position real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) - type(SeaSt_WaveField_ParameterType), intent(in ) :: WF_p !< wavefield parameters - type(SeaSt_WaveField_MiscVarType), intent(inout) :: WF_m !< wavefield misc/optimization variables + type(GridInterp_ParameterType), intent(in ) :: WF_p !< Wave excitation grid parameters + type(GridInterp_MiscVarType), intent(inout) :: WF_m !< GridInterp misc/optimization variables integer(IntKi), intent( out) :: ErrStat3 character(*), intent( out) :: ErrMsg3 real(SiKi) :: WAMIT_ForceWaves_Interp_3D_vec6(6) - real(SiKi) :: u(8) - integer(IntKi) :: i - - ! get the bounding indices from the WaveField info (same indexing used in WAMIT) - call WaveField_Interp_Setup3D( Time, pos, WF_p, WF_m, ErrStat3, ErrMsg3 ) - - ! interpolate - do i = 1,6 - u(1) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), i ) - u(2) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), i ) - u(3) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), i ) - u(4) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), i ) - u(5) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), i ) - u(6) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), i ) - u(7) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), i ) - u(8) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), i ) - WAMIT_ForceWaves_Interp_3D_vec6(i) = SUM ( WF_m%N3D * u ) - end do + + call GridInterpSetup3D( (/Real(Time,ReKi),pos(1),pos(2)/), WF_p, WF_m, ErrStat3, ErrMsg3 ) + WAMIT_ForceWaves_Interp_3D_vec6 = GridInterp3DVec6( pKinXX, WF_m ) + end function @@ -687,38 +674,16 @@ function WAMIT_ForceWaves_Interp_4D_vec6(Time, pos, pKinXX, WF_p, WF_m, ErrStat3 real(DbKi), intent(in ) :: Time real(ReKi), intent(in ) :: pos(3) !< position real(SiKi), intent(in ) :: pKinXX(0:,:,:,:,:) !< 4D Wave excitation data (SiKi for storage space reasons) - type(SeaSt_WaveField_ParameterType), intent(in ) :: WF_p !< wavefield parameters - type(SeaSt_WaveField_MiscVarType), intent(inout) :: WF_m !< wavefield misc/optimization variables + type(GridInterp_ParameterType), intent(in ) :: WF_p !< Wave excitation grid parameters + type(GridInterp_MiscVarType), intent(inout) :: WF_m !< GridInterp misc/optimization variables integer(IntKi), intent( out) :: ErrStat3 character(*), intent( out) :: ErrMsg3 real(SiKi) :: WAMIT_ForceWaves_Interp_4D_vec6(6) - real(SiKi) :: u(16) - integer(IntKi) :: i - - ! get the bounding indices from the WaveField info (same indexing used in WAMIT) - call WaveField_Interp_Setup4D( Time, pos, WF_p, WF_m, ErrStat3, ErrMsg3 ) - - ! interpolate - do i = 1,6 - u( 1) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) - u( 2) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) - u( 3) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) - u( 4) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) - u( 5) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) - u( 6) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) - u( 7) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) - u( 8) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) - u( 9) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) - u(10) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) - u(11) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) - u(12) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) - u(13) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) - u(14) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) - u(15) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) - u(16) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) - WAMIT_ForceWaves_Interp_4D_vec6(i) = SUM ( WF_m%N4D * u ) - end do + + call GridInterpSetup4D( (/Real(Time,ReKi),pos(1),pos(2),pos(3)/), WF_p, WF_m, ErrStat3, ErrMsg3 ) + WAMIT_ForceWaves_Interp_4D_vec6 = GridInterp4DVec6( pKinXX, WF_m ) + end function diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index cfa511e855..f74679ba14 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -109,7 +109,7 @@ MODULE WAMIT_Types TYPE(Conv_Rdtn_MiscVarType) :: Conv_Rdtn !< [-] TYPE(Conv_Rdtn_InputType) :: Conv_Rdtn_u !< [-] TYPE(Conv_Rdtn_OutputType) :: Conv_Rdtn_y !< [-] - TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] + TYPE(GridInterp_MiscVarType) :: WaveField_m !< misc var information from the Grid Interpolation module [-] END TYPE WAMIT_MiscVarType ! ======================= ! ========= WAMIT_ParameterType ======= @@ -133,7 +133,7 @@ MODULE WAMIT_Types REAL(DbKi) :: DT = 0.0_R8Ki !< [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] INTEGER(IntKi) :: PtfmYMod = 0_IntKi !< Large yaw model [-] - TYPE(SeaSt_WaveField_ParameterType) :: ExctnGridParams !< Parameters of WaveExctnGrid [-] + TYPE(GridInterp_ParameterType) :: ExctnGridParams !< Parameters of WaveExctnGrid [-] END TYPE WAMIT_ParameterType ! ======================= ! ========= WAMIT_InputType ======= @@ -742,7 +742,7 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call Conv_Rdtn_CopyOutput(SrcMiscData%Conv_Rdtn_y, DstMiscData%Conv_Rdtn_y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) + call GridInterp_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end subroutine @@ -786,7 +786,7 @@ subroutine WAMIT_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call Conv_Rdtn_DestroyOutput(MiscData%Conv_Rdtn_y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) + call GridInterp_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -809,7 +809,7 @@ subroutine WAMIT_PackMisc(RF, Indata) call Conv_Rdtn_PackMisc(RF, InData%Conv_Rdtn) call Conv_Rdtn_PackInput(RF, InData%Conv_Rdtn_u) call Conv_Rdtn_PackOutput(RF, InData%Conv_Rdtn_y) - call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) + call GridInterp_PackMisc(RF, InData%WaveField_m) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -835,7 +835,7 @@ subroutine WAMIT_UnPackMisc(RF, OutData) call Conv_Rdtn_UnpackMisc(RF, OutData%Conv_Rdtn) ! Conv_Rdtn call Conv_Rdtn_UnpackInput(RF, OutData%Conv_Rdtn_u) ! Conv_Rdtn_u call Conv_Rdtn_UnpackOutput(RF, OutData%Conv_Rdtn_y) ! Conv_Rdtn_y - call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m + call GridInterp_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m end subroutine subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -930,7 +930,7 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%DT = SrcParamData%DT DstParamData%WaveField => SrcParamData%WaveField DstParamData%PtfmYMod = SrcParamData%PtfmYMod - call SeaSt_WaveField_CopyParam(SrcParamData%ExctnGridParams, DstParamData%ExctnGridParams, CtrlCode, ErrStat2, ErrMsg2) + call GridInterp_CopyParam(SrcParamData%ExctnGridParams, DstParamData%ExctnGridParams, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end subroutine @@ -966,7 +966,7 @@ subroutine WAMIT_DestroyParam(ParamData, ErrStat, ErrMsg) call SS_Exc_DestroyParam(ParamData%SS_Exctn, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(ParamData%WaveField) - call SeaSt_WaveField_DestroyParam(ParamData%ExctnGridParams, ErrStat2, ErrMsg2) + call GridInterp_DestroyParam(ParamData%ExctnGridParams, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -1001,7 +1001,7 @@ subroutine WAMIT_PackParam(RF, Indata) end if end if call RegPack(RF, InData%PtfmYMod) - call SeaSt_WaveField_PackParam(RF, InData%ExctnGridParams) + call GridInterp_PackParam(RF, InData%ExctnGridParams) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1051,7 +1051,7 @@ subroutine WAMIT_UnPackParam(RF, OutData) OutData%WaveField => null() end if call RegUnpack(RF, OutData%PtfmYMod); if (RegCheckErr(RF, RoutineName)) return - call SeaSt_WaveField_UnpackParam(RF, OutData%ExctnGridParams) ! ExctnGridParams + call GridInterp_UnpackParam(RF, OutData%ExctnGridParams) ! ExctnGridParams end subroutine subroutine WAMIT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/inflowwind/src/IfW_C_Binding.f90 b/modules/inflowwind/src/IfW_C_Binding.f90 index 1050b1cec4..79df59b106 100644 --- a/modules/inflowwind/src/IfW_C_Binding.f90 +++ b/modules/inflowwind/src/IfW_C_Binding.f90 @@ -19,18 +19,23 @@ !********************************************************************************************************************************** MODULE InflowWind_C_BINDING - USE ISO_C_BINDING - USE InflowWind - USE InflowWind_Subs, only: MaxOutPts - USE InflowWind_Types - USE NWTC_Library - USE VersionInfo + use ISO_C_BINDING + use IfW_FlowField, only: IfW_FlowField_GetVelAcc + use InflowWind + use InflowWind_Subs, only: MaxOutPts + use InflowWind_Types + use NWTC_Library + use VersionInfo + use NWTC_C_Binding, only: ErrMsgLen_C, IntfStrLen, SetErrStat_F2C IMPLICIT NONE PUBLIC :: IfW_C_Init PUBLIC :: IfW_C_CalcOutput PUBLIC :: IfW_C_End + PUBLIC :: IfW_C_GetFlowFieldPointer + PUBLIC :: IfW_C_SetFlowFieldPointer + PUBLIC :: IfW_C_GetWindVel !------------------------------------------------------------------------------------ ! Version info for display @@ -58,43 +63,14 @@ MODULE InflowWind_C_BINDING type(InflowWind_OutputType) :: y !< Initial output (outputs are not calculated; only the output mesh is initialized) type(InflowWind_MiscVarType) :: m !< Misc variables for optimization (not copied in glue code) - !------------------------------------------------------------------------------------ - ! Error handling - ! This must exactly match the value in the python-lib. If ErrMsgLen changes at - ! some point in the nwtc-library, this should be updated, but the logic exists - ! to correctly handle different lengths of the strings - integer(IntKi), parameter :: ErrMsgLen_C = 1025 - integer(IntKi), parameter :: IntfStrLen = 1025 ! length of other strings through the C interface - - - CONTAINS -!> This routine sets the error status in C_CHAR for export to calling code. -!! Make absolutely certain that we do not overrun the end of ErrMsg_C. That is hard coded to 1025, -!! but ErrMsgLen is set in the nwtc_library, and could change without updates here. We don't want an -!! inadvertant buffer overrun -- that can lead to bad things. -subroutine SetErr(ErrStat, ErrMsg, ErrStat_C, ErrMsg_C) - integer, intent(in ) :: ErrStat !< aggregated error message (fortran type) - character(ErrMsgLen), intent(in ) :: ErrMsg !< aggregated error message (fortran type) - integer(c_int), intent( out) :: ErrStat_C - character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) - ErrStat_C = ErrStat ! We will send back the same error status that is used in OpenFAST - if (ErrMsgLen > ErrMsgLen_C-1) then ! If ErrMsgLen is > the space in ErrMsg_C, do not copy everything over - ErrMsg_C = TRANSFER( trim(ErrMsg(1:ErrMsgLen_C-1))//C_NULL_CHAR, ErrMsg_C ) - else - ErrMsg_C = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_C ) - endif -end subroutine SetErr - - !=============================================================================================================== !--------------------------------------------- IFW INIT -------------------------------------------------------- !=============================================================================================================== -SUBROUTINE IfW_C_Init(IfWinputFilePassed, IfWinputFileString_C, IfWinputFileStringLength_C, OutRootName_C, & - NumWindPts_C, DT_C, DebugLevel_in, NumChannels_C, OutputChannelNames_C, OutputChannelUnits_C, & +SUBROUTINE IfW_C_Init(IfWinputFilePassed, IfWinputFileString_C, IfWinputFileStringLength_C, OutRootName_C, & + NumWindPts_C, DT_C, DebugLevel_in, NumChannels_C, OutputChannelNames_C, OutputChannelUnits_C, & ErrStat_C, ErrMsg_C) BIND (C, NAME='IfW_C_Init') - IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT !DEC$ ATTRIBUTES DLLEXPORT :: IfW_C_Init !GCC$ ATTRIBUTES DLLEXPORT :: IfW_C_Init @@ -129,6 +105,9 @@ SUBROUTINE IfW_C_Init(IfWinputFilePassed, IfWinputFileString_C, IfWinputFileStri ErrStat = ErrID_None ErrMsg = "" + ! clear out any leftover memory that might be allocated from a previous call + call MemClear(ErrStat2, ErrMsg2); if (Failed()) return + CALL NWTC_Init( ProgNameIn=version%Name ) CALL DispCopyrightLicense( version%Name ) CALL DispCompileRuntimeInfo( version%Name ) @@ -160,9 +139,7 @@ SUBROUTINE IfW_C_Init(IfWinputFilePassed, IfWinputFileString_C, IfWinputFileStri endif ! For debugging the interface: - if (DebugLevel > 0) then - call ShowPassedData() - endif + if (DebugLevel > 0) call ShowPassedData() ! Get fortran pointer to C_NULL_CHAR deliniated input file as a string CALL C_F_pointer(IfWinputFileString_C, IfWinputFileString) @@ -217,7 +194,8 @@ SUBROUTINE IfW_C_Init(IfWinputFilePassed, IfWinputFileString_C, IfWinputFileStri call Cleanup() - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + call SetErrStat_F2C(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + CONTAINS logical function Failed() @@ -225,7 +203,7 @@ logical function Failed() Failed = ErrStat >= AbortErrLev if (Failed) then call Cleanup() - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + call SetErrStat_F2C(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) endif end function Failed subroutine Cleanup() ! NOTE: we are ignoring any error reporting from here @@ -238,8 +216,7 @@ subroutine ShowPassedData() integer :: i,j call WrSCr("") call WrScr("-----------------------------------------------------------") - call WrScr("Interface debugging: Variables passed in through interface") - call WrScr(" ADI_C_Init") + call WrScr("Interface debugging: IfW_C_Init") call WrScr(" --------------------------------------------------------") call WrScr(" FileInfo") TmpFlag="F"; if (IfWinputFilePassed==1_c_int) TmpFlag="T" @@ -260,15 +237,14 @@ END SUBROUTINE IfW_C_Init !--------------------------------------------- IFW CALCOUTPUT -------------------------------------------------- !=============================================================================================================== -SUBROUTINE IfW_C_CalcOutput(Time_C,Positions_C,Velocities_C,OutputChannelValues_C,ErrStat_C,ErrMsg_C) BIND (C, NAME='IfW_C_CalcOutput') - IMPLICIT NONE +SUBROUTINE IfW_C_CalcOutput(Time_C,Pos_C,Vel_C,OutputChannelValues_C,ErrStat_C,ErrMsg_C) BIND (C, NAME='IfW_C_CalcOutput') #ifndef IMPLICIT_DLLEXPORT !DEC$ ATTRIBUTES DLLEXPORT :: IfW_C_CalcOutput !GCC$ ATTRIBUTES DLLEXPORT :: IfW_C_CalcOutput #endif REAL(C_DOUBLE) , INTENT(IN ) :: Time_C - REAL(C_FLOAT) , INTENT(IN ) :: Positions_C(3*InitInp%NumWindPoints) - REAL(C_FLOAT) , INTENT( OUT) :: Velocities_C(3*InitInp%NumWindPoints) + REAL(C_FLOAT) , INTENT(IN ) :: Pos_C(3*InitInp%NumWindPoints) + REAL(C_FLOAT) , INTENT( OUT) :: Vel_C(3*InitInp%NumWindPoints) REAL(C_FLOAT) , INTENT( OUT) :: OutputChannelValues_C(p%NumOuts) INTEGER(C_INT) , INTENT( OUT) :: ErrStat_C CHARACTER(KIND=C_CHAR) , INTENT( OUT) :: ErrMsg_C(ErrMsgLen_C) @@ -285,52 +261,238 @@ SUBROUTINE IfW_C_CalcOutput(Time_C,Positions_C,Velocities_C,OutputChannelValues_ ErrStat = ErrID_None ErrMsg = "" + ! Interface debugging + if (DebugLevel > 0) call ShowPassedData() + ! Convert the inputs from C to Fortran Time = REAL(Time_C,DbKi) - InputData%PositionXYZ = reshape( real(Positions_C,ReKi), (/3, InitInp%NumWindPoints/) ) + InputData%PositionXYZ = reshape( real(Pos_C,ReKi), (/3, InitInp%NumWindPoints/) ) ! Call the main subroutine InflowWind_CalcOutput to get the velocities CALL InflowWind_CalcOutput( Time, InputData, p, ContStates, DiscStates, ConstrStates, OtherStates, y, m, ErrStat2, ErrMsg2 ) if (Failed()) return ! Get velocities out of y and flatten them (still in same spot in memory) - Velocities_C = reshape( REAL(y%VelocityUVW, C_FLOAT), (/3*InitInp%NumWindPoints/) ) ! VelocityUVW is 2D array of ReKi (might need reshape or make into pointer); size [3,N] + Vel_C = reshape( REAL(y%VelocityUVW, C_FLOAT), (/3*InitInp%NumWindPoints/) ) ! VelocityUVW is 2D array of ReKi (might need reshape or make into pointer); size [3,N] + + ! Interface debugging + if (DebugLevel > 0) call ShowReturnData() ! Get the output channel info out of y OutputChannelValues_C = REAL(y%WriteOutput, C_FLOAT) - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + call SetErrStat_F2C(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) CONTAINS logical function Failed() CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) Failed = ErrStat >= AbortErrLev - if (Failed) call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + if (Failed) call SetErrStat_F2C(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) end function Failed + !> This subroutine prints out all the variables that are passed in. Use this only + !! for debugging the interface on the Fortran side. + subroutine ShowPassedData() + integer(IntKi) :: i + character(4) :: TmpCh + call WrSCr("") + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: IfW_C_CalcOutput") + call WrScr(" --------------------------------------------------------") + call WrScr(" Time_C -> "//trim(Num2LStr(Time_C))) + do i=1,InitInp%NumWindPoints + write(TmpCh, '(i4)') i + call WrScr(" Pos_C("//TmpCh//") -> ("//trim(Num2LStr(Pos_C((i-1)*3+1)))//","//trim(Num2LStr(Pos_C((i-1)*3+2)))//","//trim(Num2LStr(Pos_C((i-1)*3+3)))//")") + enddo + end subroutine ShowPassedData + subroutine ShowReturnData() + integer(IntKi) :: i + character(4) :: TmpCh + do i=1,InitInp%NumWindPoints + call WrScr(" Vel_C("//TmpCh//") <- ("//trim(Num2LStr(Vel_C((i-1)*3+1)))//","//trim(Num2LStr(Vel_C((i-1)*3+2)))//","//trim(Num2LStr(Vel_C((i-1)*3+3)))//")") + enddo + call WrScr("-----------------------------------------------------------") + end subroutine ShowReturnData END SUBROUTINE IfW_C_CalcOutput !=============================================================================================================== !--------------------------------------------------- IFW END --------------------------------------------------- !=============================================================================================================== - -SUBROUTINE IfW_C_End(ErrStat_C,ErrMsg_C) BIND (C, NAME='IfW_C_End') - IMPLICIT NONE +subroutine IfW_C_End(ErrStat_C,ErrMsg_C) BIND (C, NAME='IfW_C_End') #ifndef IMPLICIT_DLLEXPORT !DEC$ ATTRIBUTES DLLEXPORT :: IfW_C_End !GCC$ ATTRIBUTES DLLEXPORT :: IfW_C_End #endif - INTEGER(C_INT) , INTENT( OUT) :: ErrStat_C - CHARACTER(KIND=C_CHAR) , INTENT( OUT) :: ErrMsg_C(ErrMsgLen_C) + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + integer :: ErrStat,ErrStat2 + character(ErrMsgLen) :: ErrMsg,ErrMsg2 + character(*), parameter :: RoutineName = 'IfW_C_End' - ! Local variables - INTEGER :: ErrStat - CHARACTER(ErrMsgLen) :: ErrMsg + ErrStat = ErrID_None + ErrMsg = "" ! Call the main subroutine InflowWind_End - CALL InflowWind_End( InputData, p, ContStates, DiscStates, ConstrStates, OtherStates, y, m, ErrStat, ErrMsg ) + call InflowWind_End( InputData, p, ContStates, DiscStates, ConstrStates, OtherStates, y, m, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Clear extra memory within library + call MemClear(ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + call SetErrStat_F2C(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) +end subroutine IfW_C_End + + +!> basic routine to get the wind velocity at a single point in time and space +subroutine IfW_C_GetWindVel(Time_C,Pos_C,Vel_C,ErrStat_C,ErrMsg_C) BIND (C, NAME='IfW_C_GetWindVel') + real(c_double), intent(in ) :: Time_C + real(c_float), intent(in ) :: Pos_C(3) + real(c_float), intent( out) :: Vel_C(3) + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + real(dbki) :: Time + integer :: ErrStat, ErrStat2 + character(ErrMsgLen) :: ErrMsg, ErrMsg2 + character(*), parameter :: RoutineName = 'IfW_C_GetWindVel' + integer(intKi) :: StartNode + real(ReKi) :: Pos(3,1), Vel(3,1), PosOffset(3) + real(ReKi), allocatable :: NoAcc(:,:) + + ErrStat = ErrID_None + ErrMsg = "" + + ! Interface debugging + if (DebugLevel > 0) call ShowPassedData() + + if (.not. associated(p%FlowField)) then + ErrStat = ErrID_Fatal + ErrMsg = "Invalid pointer to FlowField data. Is the data initialized?" + Vel_C = 0.0_c_float + endif + + ! Initialize node. Since this is standalone, set to 1. + StartNode = 1 + ! no offset + PosOffset = 0.0_ReKi + + ! Convert the inputs from C to Fortran + Time = REAL(Time_C,DbKi) + Pos(1:3,1) = real(Pos_C,ReKi) + + ! call wind routine to get single point velocity + call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, Time, Pos, Vel, NoAcc, ErrStat2, ErrMsg2) + if (Failed()) return + Vel_C = real(Vel(1:3,1), c_float) + + ! Interface debugging + if (DebugLevel > 0) call ShowReturnData() + + call SetErrStat_F2C(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) call SetErrStat_F2C(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + end function Failed + !> This subroutine prints out all the variables that are passed in. Use this only + !! for debugging the interface on the Fortran side. + subroutine ShowPassedData() + call WrSCr("") + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: IfW_C_GetWindVel") + call WrScr(" --------------------------------------------------------") + call WrScr(" Time_C -> "//trim(Num2LStr(Time_C))) + call WrScr(" Pos_C -> ("//trim(Num2LStr(Pos_C(1)))//","//trim(Num2LStr(Pos_C(2)))//","//trim(Num2LStr(Pos_C(3)))//")") + end subroutine ShowPassedData + subroutine ShowReturnData() + call WrScr(" Vel_C <- ("//trim(Num2LStr(Vel_C(1)))//","//trim(Num2LStr(Vel_C(2)))//","//trim(Num2LStr(Vel_C(3)))//")") + call WrScr("-----------------------------------------------------------") + end subroutine ShowReturnData +end subroutine IfW_C_GetWindVel + + +!> clear local memory that isn't stored in `_End` routine +subroutine MemClear(ErrStat,ErrMsg) + integer, intent( out) :: ErrStat + character(ErrMsgLen), intent( out) :: ErrMsg + call InflowWind_DestroyInitInput( InitInp, ErrStat, ErrMsg) + call InflowWind_DestroyInitOutput(InitOutData, ErrStat, ErrMsg) +end subroutine MemClear + + + +!> return the pointer to the WaveField data +subroutine IfW_C_GetFlowFieldPointer(FlowFieldPointer_C,ErrStat_C,ErrMsg_C) BIND (C, NAME='IfW_C_GetFlowFieldPointer') +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: IfW_C_GetFlowFieldPointer +!GCC$ ATTRIBUTES DLLEXPORT :: IfW_C_GetFlowFieldPointer +#endif + type(c_ptr), intent( out) :: FlowFieldPointer_C + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + integer :: ErrStat + character(ErrMsgLen) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_C_GetFlowFieldPointer' + ErrStat = ErrID_None + ErrMSg = "" + if (associated(p%FlowField)) then + FlowFieldPointer_C = C_LOC(p%FlowField) + else + FlowFieldPointer_C = C_NULL_PTR + call SetErrStat(ErrID_Fatal,"Pointer to FlowField data not valid: data not initialized",ErrStat,ErrMsg,RoutineName) + endif + call SetErrStat_F2C( ErrStat, ErrMsg, ErrStat_C, ErrMsg_C ) + if (DebugLevel > 1) call ShowPassedData() + return +contains + subroutine ShowPassedData() + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: IfW_C_GetFlowFieldPointer") + call WrScr(" --------------------------------------------------------") + call WrScr(" FlowFieldPointer_C -> "//trim(Num2LStr(loc(p%FlowField)))) + call WrScr("-----------------------------------------------------------") + end subroutine ShowPassedData +end subroutine + + +!FIXME: this will require changes to IfW_C_Init to instantiate an empty IfW instance +! so before exposing this publicly, the initialization should be updated. +!> set the pointer to the FlowField data +subroutine IfW_C_SetFlowFieldPointer(FlowFieldPointer_C,ErrStat_C,ErrMsg_C) BIND (C, NAME='IfW_C_SetFlowFieldPointer') +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: IfW_C_SetFlowFieldPointer +!GCC$ ATTRIBUTES DLLEXPORT :: IfW_C_SetFlowFieldPointer +#endif + type(c_ptr), intent(in ) :: FlowFieldPointer_C + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + integer :: ErrStat + character(ErrMsgLen) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_C_SetFlowFieldPointer' + ErrStat = ErrID_None + ErrMSg = "" + call C_F_POINTER(FlowFieldPointer_C, p%FlowField) + if (associated(p%FlowField)) then + ! basic sanity check + if (p%FlowField%FieldType <= 0_IntKi) then + call SetErrStat(ErrID_Fatal,"Invalid pointer passed in, or FlowField not initialized",ErrStat,ErrMsg,RoutineName) + endif + else + call SetErrStat(ErrID_Fatal,"Invalid pointer passed in, or FlowField not initialized",ErrStat,ErrMsg,RoutineName) + endif + call SetErrStat_F2C( ErrStat, ErrMsg, ErrStat_C, ErrMsg_C ) + if (DebugLevel > 1) call ShowPassedData() + return +contains + subroutine ShowPassedData() + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: IfW_C_SetFlowFieldPointer") + call WrScr(" --------------------------------------------------------") + call WrScr(" FlowFieldPointer_C <- "//trim(Num2LStr(loc(p%FlowField)))) + call WrScr("-----------------------------------------------------------") + end subroutine ShowPassedData +end subroutine - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) -END SUBROUTINE IfW_C_End END MODULE diff --git a/modules/inflowwind/src/IfW_FlowField.f90 b/modules/inflowwind/src/IfW_FlowField.f90 index 546359d16e..2778000246 100644 --- a/modules/inflowwind/src/IfW_FlowField.f90 +++ b/modules/inflowwind/src/IfW_FlowField.f90 @@ -1628,7 +1628,7 @@ subroutine Grid4DField_GetVel(G4D, Time, Position, Velocity, ErrStat, ErrMsg) real(ReKi) :: P(3, 16) ! Point values real(ReKi) :: tmp integer(IntKi) :: i - character(60) :: PtLoc + character(60) :: PtLoc, BoxLL, BoxUR ErrStat = ErrID_None ErrMsg = "" @@ -1665,12 +1665,16 @@ subroutine Grid4DField_GetVel(G4D, Time, Position, Velocity, ErrStat, ErrMsg) do i = 1, 4 if (Indx_Lo(i) <= 0) then Indx_Lo(i) = 1 - write(PtLoc,'(A1,3(f8.2,A1))') '(',Position(1),',',Position(2),',',Position(3),')' - call SetErrStat(ErrID_Fatal, 'Outside the grid bounds: '//trim(PtLoc), ErrStat, ErrMsg, RoutineName) + write(PtLoc, '(A1,3(f8.2,A1))') '(',Position(1),',',Position(2),',',Position(3),')' + write(BoxLL, '(A1,3(f8.2,A1))') '(',G4D%pZero(1),',',G4D%pZero(2),',',G4D%pZero(3),')' + write(BoxUR, '(A1,3(f8.2,A1))') '(',G4D%pZero(1)+(G4D%n(1)-1)*G4D%delta(1),',',G4D%pZero(2)+(G4D%n(2)-1)*G4D%delta(2),',',G4D%pZero(3)+(G4D%n(3)-1)*G4D%delta(3),')' + call SetErrStat(ErrID_Fatal, 'Outside the grid bounds: '//trim(PtLoc)//'; box bounds: '//trim(BoxLL)//' to '//trim(BoxUR), ErrStat, ErrMsg, RoutineName) return elseif (Indx_Lo(i) >= G4D%n(i)) then - write(PtLoc,'(A1,3(f8.2,A1))') '(',Position(1),',',Position(2),',',Position(3),')' - call SetErrStat(ErrID_Fatal, 'Outside the grid bounds: '//trim(PtLoc), ErrStat, ErrMsg, RoutineName) + write(PtLoc, '(A1,3(f8.2,A1))') '(',Position(1),',',Position(2),',',Position(3),')' + write(BoxLL, '(A1,3(f8.2,A1))') '(',G4D%pZero(1),',',G4D%pZero(2),',',G4D%pZero(3),')' + write(BoxUR, '(A1,3(f8.2,A1))') '(',G4D%pZero(1)+(G4D%n(1)-1)*G4D%delta(1),',',G4D%pZero(2)+(G4D%n(2)-1)*G4D%delta(2),',',G4D%pZero(3)+(G4D%n(3)-1)*G4D%delta(3),')' + call SetErrStat(ErrID_Fatal, 'Outside the grid bounds: '//trim(PtLoc)//'; box bounds: '//trim(BoxLL)//' to '//trim(BoxUR), ErrStat, ErrMsg, RoutineName) return end if Indx_Hi(i) = min(Indx_Lo(i) + 1, G4D%n(i)) ! make sure it's a valid index diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index af7474d710..9965ee5b42 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -299,11 +299,6 @@ subroutine MAP_PackInitInput(RF, Indata) type(MAP_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_PackInitInput' if (RF%ErrStat >= AbortErrLev) return - if (c_associated(InData%C_obj%object)) then - RF%ErrStat = ErrID_Fatal - RF%ErrMsg = RoutineName//': C_obj%object cannot be packed.' - return - end if call RegPack(RF, InData%gravity) call RegPack(RF, InData%sea_density) call RegPack(RF, InData%depth) @@ -471,11 +466,6 @@ subroutine MAP_PackInitOutput(RF, Indata) type(MAP_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_PackInitOutput' if (RF%ErrStat >= AbortErrLev) return - if (c_associated(InData%C_obj%object)) then - RF%ErrStat = ErrID_Fatal - RF%ErrMsg = RoutineName//': C_obj%object cannot be packed.' - return - end if call RegPack(RF, InData%progName) call RegPack(RF, InData%version) call RegPack(RF, InData%compilingData) @@ -573,11 +563,6 @@ subroutine MAP_PackContState(RF, Indata) type(MAP_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_PackContState' if (RF%ErrStat >= AbortErrLev) return - if (c_associated(InData%C_obj%object)) then - RF%ErrStat = ErrID_Fatal - RF%ErrMsg = RoutineName//': C_obj%object cannot be packed.' - return - end if call RegPack(RF, InData%dummy) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -654,11 +639,6 @@ subroutine MAP_PackDiscState(RF, Indata) type(MAP_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_PackDiscState' if (RF%ErrStat >= AbortErrLev) return - if (c_associated(InData%C_obj%object)) then - RF%ErrStat = ErrID_Fatal - RF%ErrMsg = RoutineName//': C_obj%object cannot be packed.' - return - end if call RegPack(RF, InData%dummy) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1072,11 +1052,6 @@ subroutine MAP_PackOtherState(RF, Indata) character(*), parameter :: RoutineName = 'MAP_PackOtherState' logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - if (c_associated(InData%C_obj%object)) then - RF%ErrStat = ErrID_Fatal - RF%ErrMsg = RoutineName//': C_obj%object cannot be packed.' - return - end if call RegPackPtr(RF, InData%H) call RegPackPtr(RF, InData%V) call RegPackPtr(RF, InData%Ha) @@ -1691,11 +1666,6 @@ subroutine MAP_PackConstrState(RF, Indata) character(*), parameter :: RoutineName = 'MAP_PackConstrState' logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - if (c_associated(InData%C_obj%object)) then - RF%ErrStat = ErrID_Fatal - RF%ErrMsg = RoutineName//': C_obj%object cannot be packed.' - return - end if call RegPackPtr(RF, InData%H) call RegPackPtr(RF, InData%V) call RegPackPtr(RF, InData%x) @@ -1926,11 +1896,6 @@ subroutine MAP_PackParam(RF, Indata) type(MAP_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_PackParam' if (RF%ErrStat >= AbortErrLev) return - if (c_associated(InData%C_obj%object)) then - RF%ErrStat = ErrID_Fatal - RF%ErrMsg = RoutineName//': C_obj%object cannot be packed.' - return - end if call RegPack(RF, InData%g) call RegPack(RF, InData%depth) call RegPack(RF, InData%rho_sea) @@ -2105,11 +2070,6 @@ subroutine MAP_PackInput(RF, Indata) character(*), parameter :: RoutineName = 'MAP_PackInput' logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - if (c_associated(InData%C_obj%object)) then - RF%ErrStat = ErrID_Fatal - RF%ErrMsg = RoutineName//': C_obj%object cannot be packed.' - return - end if call RegPackPtr(RF, InData%x) call RegPackPtr(RF, InData%y) call RegPackPtr(RF, InData%z) @@ -2377,11 +2337,6 @@ subroutine MAP_PackOutput(RF, Indata) character(*), parameter :: RoutineName = 'MAP_PackOutput' logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return - if (c_associated(InData%C_obj%object)) then - RF%ErrStat = ErrID_Fatal - RF%ErrMsg = RoutineName//': C_obj%object cannot be packed.' - return - end if call RegPackPtr(RF, InData%Fx) call RegPackPtr(RF, InData%Fy) call RegPackPtr(RF, InData%Fz) diff --git a/modules/moordyn/CMakeLists.txt b/modules/moordyn/CMakeLists.txt index 5ec97ef21c..ffaff4fd8d 100644 --- a/modules/moordyn/CMakeLists.txt +++ b/modules/moordyn/CMakeLists.txt @@ -37,15 +37,32 @@ add_executable(moordyn_driver target_link_libraries(moordyn_driver moordynlib versioninfolib) # C-bindings interface library -add_library(moordyn_c_binding SHARED - src/MoorDyn_C_Binding.f90 -) -target_link_libraries(moordyn_c_binding moordynlib seastlib versioninfolib) +# create object instead of directly linking into shared and static -- causes issues in parallel builds +# This is only required because we are static linking the library for wavetank +# NOTE: target linking at the object, static, and shared libraries. Different CMake versions handle this +# slightly differently with unpredictable results if I don't. +add_library(moordyn_c_binding_object OBJECT src/MoorDyn_C_Binding.f90) +target_link_libraries(moordyn_c_binding_object moordynlib seastlib nwtclibs versioninfolib) +set_property(TARGET moordyn_c_binding_object PROPERTY POSITION_INDEPENDENT_CODE 1) # required for shared libs + +# shared +add_library(moordyn_c_binding SHARED $) +target_link_libraries(moordyn_c_binding moordynlib seastlib nwtclibs versioninfolib) if(APPLE OR UNIX) target_compile_definitions(moordyn_c_binding PRIVATE IMPLICIT_DLLEXPORT) endif() -install(TARGETS moordynlib moordyn_driver moordyn_c_binding +# C-bindings non-shared interface +# This is a workaround for building wavetank into a single DLL (also allows setting CU globaly for sending screen to file for labview integration) +add_library(moordyn_c_bind_static SHARED $) +target_link_libraries(moordyn_c_bind_static moordynlib seastlib nwtclibs versioninfolib) +if(APPLE OR UNIX) + target_compile_definitions(moordyn_c_bind_static PRIVATE IMPLICIT_DLLEXPORT) +endif() + + + +install(TARGETS moordynlib moordyn_driver moordyn_c_binding moordyn_c_bind_static EXPORT "${CMAKE_PROJECT_NAME}Libraries" RUNTIME DESTINATION bin ARCHIVE DESTINATION lib diff --git a/modules/moordyn/README.md b/modules/moordyn/README.md index 1042d2a075..81177663e2 100644 --- a/modules/moordyn/README.md +++ b/modules/moordyn/README.md @@ -1,7 +1,7 @@ # MoorDyn Module This is an externally developed module with further information -available on the developer's documentation site: -[Matt Hall](http://www.matt-hall.ca/moordyn.html). +available on the documentation site: +[MoorDyn Docs](https://moordyn.readthedocs.io/en/latest/). ## Overview MoorDyn is a lumped-mass mooring line model for simulating the dynamics of diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index ebee550a70..1ba16c8ccd 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -157,7 +157,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CHARACTER(*), PARAMETER :: RoutineName = 'MD_Init' - + ! Initialize Err stat ErrStat = ErrID_None ErrMsg = "" m%zeros6 = 0.0_DbKi @@ -241,13 +241,9 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! read input file and create cross-referenced mooring system objects !--------------------------------------------------------------------------------------------- - - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - CALL WrScr( ' Parsing MoorDyn input file: '//trim(InitInp%FileName) ) + CALL WrScr( ' Parsing MoorDyn input file: '//trim(InitInp%FileName) ) ! ----------------------------------------------------------------- @@ -291,6 +287,13 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er do while ( i <= FileInfo_In%NumLines ) + if (INDEX(Line, "ECHO") > 0) then + ! check for Echo flag and if so, throw message suggesting write log + ErrStat2 = ErrID_Info + ErrMsg2 = 'MoorDyn does not support ECHO. Instead, enable the log file by setting WriteLog > 0.' + CALL CheckError( ErrStat2, ErrMsg2 ) + end if + if (INDEX(Line, "---") > 0) then ! look for a header line if ( ( INDEX(Line, "LINE DICTIONARY") > 0) .or. ( INDEX(Line, "LINE TYPES") > 0) ) then ! if line dictionary header @@ -438,10 +441,10 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er read (OptValue,*) p%writeLog if (p%writeLog > 0) then ! if not zero, open a log file for output CALL GetNewUnit( p%UnLog ) - CALL OpenFOutFile ( p%UnLog, TRIM(p%RootName)//'.log', ErrStat, ErrMsg ) - IF ( ErrStat > AbortErrLev ) THEN - ErrMsg = ' Failed to open MoorDyn log file: '//TRIM(ErrMsg) - RETURN + CALL OpenFOutFile ( p%UnLog, TRIM(p%RootName)//'.log', ErrStat2, ErrMsg2 ) + IF ( ErrStat2 > AbortErrLev ) THEN + ErrMsg2 = ' Failed to open MoorDyn log file: '//TRIM(ErrMsg2) + CALL CheckError( ErrStat2, ErrMsg2 ); IF (ErrStat >= AbortErrLev) RETURN END IF write(p%UnLog,'(A)', IOSTAT=ErrStat2) "MoorDyn v2 log file with output level "//TRIM(Num2LStr(p%writeLog)) write(p%UnLog,'(A)', IOSTAT=ErrStat2) "Note: options above the writeLog line in the input file will not be recorded." @@ -490,7 +493,9 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er else if ( OptString == 'DISABLEOUTTIME') then read (OptValue,*) p%disableOutTime else - CALL SetErrStat( ErrID_Warn, 'Unable to interpret input '//trim(OptString)//' in OPTIONS section.', ErrStat, ErrMsg, RoutineName ) + ErrStat2 = ErrID_Warn + ErrMsg2 = 'Unable to interpret input '//trim(OptString)//' in OPTIONS section.' + CALL CheckError( ErrStat2, ErrMsg2 ) end if nOpts = nOpts + 1 @@ -548,7 +553,8 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! set up seabed bathymetry - CALL setupBathymetry(DepthValue, InitInp%WtrDepth, m%BathymetryGrid, m%BathGrid_Xs, m%BathGrid_Ys, ErrStat2, ErrMsg2) + CALL setupBathymetry(p, DepthValue, InitInp%WtrDepth, m%BathymetryGrid, m%BathGrid_Xs, m%BathGrid_Ys, ErrStat2, ErrMsg2) + CALL CheckError( ErrStat2, ErrMsg2 ); IF (ErrStat >= AbortErrLev) RETURN CALL getDepthFromBathymetry(m%BathymetryGrid, m%BathGrid_Xs, m%BathGrid_Ys, 0.0_DbKi, 0.0_DbKi, p%WtrDpth, nvec) ! set depth at 0,0 as nominal for waves etc @@ -1111,12 +1117,13 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er if ((let1 == "ANCHOR") .or. (let1 == "FIXED") .or. (let1 == "FIX")) then m%RodList(l)%typeNum = 2 - CALL Body_AddRod(m%GroundBody, l, tempArray) ! add rod l to Ground body - + CALL Body_AddRod(m%GroundBody, l, tempArray, ErrStat2, ErrMsg2) ! add rod l to Ground body + if (Failed()) return else if ((let1 == "PINNED") .or. (let1 == "PIN")) then m%RodList(l)%typeNum = 1 - CALL Body_AddRod(m%GroundBody, l, tempArray) ! add rod l to Ground body + CALL Body_AddRod(m%GroundBody, l, tempArray, ErrStat2, ErrMsg2) ! add rod l to Ground body + if (Failed()) return p%nFreeRods=p%nFreeRods+1 ! add this pinned rod to the free list because it is half free @@ -1134,7 +1141,8 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er if ((J <= p%nBodies) .and. (J > 0)) then - CALL Body_AddRod(m%BodyList(J), l, tempArray) ! add rod l to the body + CALL Body_AddRod(m%BodyList(J), l, tempArray, ErrStat2, ErrMsg2) ! add rod l to the body + if (Failed()) return if ( (let2 == "PINNED") .or. (let2 == "PIN") ) then m%RodList(l)%typeNum = 1 @@ -1235,30 +1243,25 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! process output flag characters (LineOutString) and set line output flag array (OutFlagList) m%RodList(l)%OutFlagList = 0 ! first set array all to zero ! per node, 3 component - IF ( scan( LineOutString, 'p') > 0 ) m%RodList(l)%OutFlagList(2 ) = 1 ! node position - IF ( scan( LineOutString, 'v') > 0 ) m%RodList(l)%OutFlagList(3 ) = 1 ! node velocity - IF ( scan( LineOutString, 'U') > 0 ) m%RodList(l)%OutFlagList(4 ) = 1 ! water velocity - IF ( scan( LineOutString, 'B') > 0 ) m%RodList(l)%OutFlagList(5 ) = 1 ! node buoyancy force - IF ( scan( LineOutString, 'D') > 0 ) m%RodList(l)%OutFlagList(6 ) = 1 ! drag force - IF ( scan( LineOutString, 'I') > 0 ) m%RodList(l)%OutFlagList(7 ) = 1 ! inertia force - IF ( scan( LineOutString, 'P') > 0 ) m%RodList(l)%OutFlagList(8 ) = 1 ! dynamic pressure force - IF ( scan( LineOutString, 'b') > 0 ) m%RodList(l)%OutFlagList(9 ) = 1 ! seabed contact forces + IF ( scan( LineOutString, 'p') > 0 ) m%RodList(l)%OutFlagList(2 ) = 1 ! node position (p) + IF ( scan( LineOutString, 'v') > 0 ) m%RodList(l)%OutFlagList(3 ) = 1 ! node velocity (v) + IF ( scan( LineOutString, 'U') > 0 ) m%RodList(l)%OutFlagList(4 ) = 1 ! water velocity (U) + IF ( scan( LineOutString, 'B') > 0 ) m%RodList(l)%OutFlagList(5 ) = 1 ! node buoyancy force (Bo) + IF ( scan( LineOutString, 'D') > 0 ) m%RodList(l)%OutFlagList(6 ) = 1 ! drag force (D) + IF ( scan( LineOutString, 'I') > 0 ) m%RodList(l)%OutFlagList(7 ) = 1 ! inertia force (I) + IF ( scan( LineOutString, 'P') > 0 ) m%RodList(l)%OutFlagList(8 ) = 1 ! dynamic pressure force (Pd) + IF ( scan( LineOutString, 'b') > 0 ) m%RodList(l)%OutFlagList(9 ) = 1 ! seabed contact forces (B) ! per node, 1 component IF ( scan( LineOutString, 'W') > 0 ) m%RodList(l)%OutFlagList(10) = 1 ! node weight/buoyancy (positive up) - IF ( scan( LineOutString, 'K') > 0 ) m%RodList(l)%OutFlagList(11) = 1 ! curvature at node - ! per element, 1 component >>> these don't apply to a rod!! <<< - IF ( scan( LineOutString, 't') > 0 ) m%RodList(l)%OutFlagList(12) = 1 ! segment tension force (just EA) - IF ( scan( LineOutString, 'c') > 0 ) m%RodList(l)%OutFlagList(13) = 1 ! segment internal damping force - IF ( scan( LineOutString, 's') > 0 ) m%RodList(l)%OutFlagList(14) = 1 ! Segment strain - IF ( scan( LineOutString, 'd') > 0 ) m%RodList(l)%OutFlagList(15) = 1 ! Segment strain rate + ! Extended flags outputs + IF ( scan( LineOutString, 'A') > 0 ) m%RodList(l)%OutFlagList(16) = 1 ! Transverse fluid inertia force (Ap) + IF ( scan( LineOutString, 'a') > 0 ) m%RodList(l)%OutFlagList(17) = 1 ! Axial fluid inertia force (Aq) + IF ( scan( LineOutString, 'X') > 0 ) m%RodList(l)%OutFlagList(18) = 1 ! Transverse drag forces (Dp) + IF ( scan( LineOutString, 'Y') > 0 ) m%RodList(l)%OutFlagList(19) = 1 ! Tangential drag forces (Dq) IF (SUM(m%RodList(l)%OutFlagList) > 0) m%RodList(l)%OutFlagList(1) = 1 ! this first entry signals whether to create any output file at all ! the above letter-index combinations define which OutFlagList entry corresponds to which output type - - ! specify IdNum of line for error checking - m%RodList(l)%IdNum = l - if (p%writeLog > 1) then write(p%UnLog, '(A)' ) " - Rod"//trim(num2lstr(m%RodList(l)%IdNum))//":" write(p%UnLog, '(A15,I2)' ) " ID : ", m%RodList(l)%IdNum @@ -1269,7 +1272,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! check for sequential IdNums IF ( m%RodList(l)%IdNum .NE. l ) THEN - CALL SetErrStat( ErrID_Fatal, 'Line numbers must be sequential starting from 1.', ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrID_Fatal, 'Rod numbers must be sequential starting from 1.', ErrStat, ErrMsg, RoutineName ) CALL CleanUp() RETURN END IF @@ -1363,7 +1366,8 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er !m%PointList(l)%r = tempArray(1:3) ! set initial node position - CALL Body_AddPoint(m%GroundBody, l, tempArray(1:3)) ! add point l to Ground body + CALL Body_AddPoint(m%GroundBody, l, tempArray(1:3), ErrStat2, ErrMsg2) ! add point l to Ground body + if (Failed()) return else if (let1 == "BODY") then ! attached to a body if (len_trim(num1) > 0) then @@ -1372,7 +1376,8 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er if ((J <= p%nBodies) .and. (J > 0)) then m%PointList(l)%typeNum = 1 - CALL Body_AddPoint(m%BodyList(J), l, tempArray(1:3)) ! add point l to Ground body + CALL Body_AddPoint(m%BodyList(J), l, tempArray(1:3), ErrStat2, ErrMsg2) ! add point l to Ground body + if (Failed()) return else CALL SetErrStat( ErrID_Fatal, "Body ID out of bounds for Point "//trim(Num2LStr(l))//".", ErrStat, ErrMsg, RoutineName ) @@ -1549,9 +1554,11 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er if ((J <= p%nRods) .and. (J > 0)) then if (let2 == "A") then - CALL Rod_AddLine(m%RodList(J), l, 0, 0) ! add line l (end A, denoted by 0) to rod J (end A, denoted by 0) + CALL Rod_AddLine(m%RodList(J), l, 0, 0, ErrStat2, ErrMsg2) ! add line l (end A, denoted by 0) to rod J (end A, denoted by 0) + if (Failed()) return else if (let2 == "B") then - CALL Rod_AddLine(m%RodList(J), l, 0, 1) ! add line l (end A, denoted by 0) to rod J (end B, denoted by 1) + CALL Rod_AddLine(m%RodList(J), l, 0, 1, ErrStat2, ErrMsg2) ! add line l (end A, denoted by 0) to rod J (end B, denoted by 1) + if (Failed()) return else CALL SetErrStat( ErrID_Fatal, "Error: rod end (A or B) must be specified for line "//trim(Num2LStr(l))//" end A attachment. Instead seeing "//let2, ErrStat, ErrMsg, RoutineName ) CALL CleanUp() @@ -1567,7 +1574,8 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er else if ((len_trim(let1)==0) .or. (let1 == "P") .or. (let1 == "POINT")) then if ((J <= p%nPoints) .and. (J > 0)) then - CALL Point_AddLine(m%PointList(J), l, 0) ! add line l (end A, denoted by 0) to point J + CALL Point_AddLine(m%PointList(J), l, 0, ErrStat2, ErrMsg2) ! add line l (end A, denoted by 0) to point J + if (Failed()) return else CALL SetErrStat( ErrID_Fatal, "Error: point out of bounds for line "//trim(Num2LStr(l))//" end A attachment.", ErrStat, ErrMsg, RoutineName ) CALL CleanUp() @@ -1594,9 +1602,11 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er if ((J <= p%nRods) .and. (J > 0)) then if (let2 == "A") then - CALL Rod_AddLine(m%RodList(J), l, 1, 0) ! add line l (end B, denoted by 1) to rod J (end A, denoted by 0) + CALL Rod_AddLine(m%RodList(J), l, 1, 0, ErrStat2, ErrMsg2) ! add line l (end B, denoted by 1) to rod J (end A, denoted by 0) + if (Failed()) return else if (let2 == "B") then - CALL Rod_AddLine(m%RodList(J), l, 1, 1) ! add line l (end B, denoted by 1) to rod J (end B, denoted by 1) + CALL Rod_AddLine(m%RodList(J), l, 1, 1, ErrStat2, ErrMsg2) ! add line l (end B, denoted by 1) to rod J (end B, denoted by 1) + if (Failed()) return else CALL SetErrStat( ErrID_Fatal, "Error: rod end (A or B) must be specified for line "//trim(Num2LStr(l))//" end B attachment. Instead seeing "//let2, ErrStat, ErrMsg, RoutineName ) CALL CleanUp() @@ -1612,7 +1622,8 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er else if ((len_trim(let1)==0) .or. (let1 == "P") .or. (let1 == "POINT")) then if ((J <= p%nPoints) .and. (J > 0)) then - CALL Point_AddLine(m%PointList(J), l, 1) ! add line l (end B, denoted by 1) to point J + CALL Point_AddLine(m%PointList(J), l, 1, ErrStat2, ErrMsg2) ! add line l (end B, denoted by 1) to point J + if (Failed()) return else CALL SetErrStat( ErrID_Fatal, "Error: point out of bounds for line "//trim(Num2LStr(l))//" end B attachment.", ErrStat, ErrMsg, RoutineName ) CALL CleanUp() @@ -1625,11 +1636,11 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! process output flag characters (LineOutString) and set line output flag array (OutFlagList) m%LineList(l)%OutFlagList = 0 ! first set array all to zero ! per node 3 component - IF ( scan( LineOutString, 'p') > 0 ) m%LineList(l)%OutFlagList(2) = 1 - IF ( scan( LineOutString, 'v') > 0 ) m%LineList(l)%OutFlagList(3) = 1 - IF ( scan( LineOutString, 'U') > 0 ) m%LineList(l)%OutFlagList(4) = 1 - IF ( scan( LineOutString, 'D') > 0 ) m%LineList(l)%OutFlagList(5) = 1 - IF ( scan( LineOutString, 'b') > 0 ) m%LineList(l)%OutFlagList(6) = 1 ! seabed contact forces + IF ( scan( LineOutString, 'p') > 0 ) m%LineList(l)%OutFlagList(2) = 1 ! node position (p) + IF ( scan( LineOutString, 'v') > 0 ) m%LineList(l)%OutFlagList(3) = 1 ! node velocity (v) + IF ( scan( LineOutString, 'U') > 0 ) m%LineList(l)%OutFlagList(4) = 1 ! node displacement (U) + IF ( scan( LineOutString, 'D') > 0 ) m%LineList(l)%OutFlagList(5) = 1 ! node rotation (D) + IF ( scan( LineOutString, 'b') > 0 ) m%LineList(l)%OutFlagList(6) = 1 ! seabed contact forces (B) IF ( scan( LineOutString, 'V') > 0 ) m%LineList(l)%OutFlagList(7) = 1 ! VIV forces ! per node 1 component IF ( scan( LineOutString, 'W') > 0 ) m%LineList(l)%OutFlagList(8) = 1 ! node weight/buoyancy (positive up) @@ -1645,9 +1656,6 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! the above letter-index combinations define which OutFlagList entry corresponds to which output type - ! specify IdNum of line for error checking - m%LineList(l)%IdNum = l - if (p%writeLog > 1) then write(p%UnLog, '(A)' ) " - Line"//trim(num2lstr(m%LineList(l)%IdNum))//":" write(p%UnLog, '(A15,I2)' ) " ID : ", m%LineList(l)%IdNum @@ -2021,6 +2029,13 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! get lines m%FailList(l)%nLinesToDetach = N + + ! Check that N is less than MD_MaxFailLines -- this would result in an out bounds array access + if (m%FailList(l)%nLinesToDetach > MD_MaxFailLines) then + call SetErrStat( ErrID_Fatal, ' More than hard coded limit of '//trim(Num2LStr(MD_MaxFailLines))//' lines to detach specified for line failure '//trim(Num2LStr(l))//'.', ErrStat, ErrMsg, RoutineName ) + call CleanUp() + return + endif DO il = 1, m%FailList(l)%nLinesToDetach if (TempIDnums(il) <= p%nLines) then ! ensure line ID is in range @@ -2935,7 +2950,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ENDIF endif - CALL WrScr(' MoorDyn initialization completed.') + CALL WrScr(' MoorDyn initialization completed.') if (p%writeLog > 0) then write(p%UnLog, '(A)') NewLine//"MoorDyn initialization completed."//NewLine if (ErrStat /= ErrID_None) then @@ -2998,7 +3013,7 @@ SUBROUTINE CheckError(ErrID,Msg) IF (ErrStat /= ErrID_None) ErrMsg = TRIM(ErrMsg)//NewLine ! if there's a pre-existing warning/error, retain the message and start a new line - ErrMsg = TRIM(ErrMsg)//' MD_Init:'//TRIM(Msg) + ErrMsg = TRIM(ErrMsg)//RoutineName//":"//TRIM(Msg) ErrStat = MAX(ErrStat, ErrID) Msg = "" ! Reset the error message now that it has been logged into ErrMsg @@ -3255,6 +3270,8 @@ SUBROUTINE DetachLines (attachID, isRod, lineIDs, lineTops, nLinesToDetach, time REAL(DbKi), INTENT(IN ) :: time INTEGER(IntKi) :: k ! index REAL(DbKi) :: dummyPointState(6) = 0.0_DbKi ! dummy state array to hold kinematics of old attachment point (format in terms of part of point state vector: r[J] = X[3 + J]; rd[J] = X[J]; ) + integer(IntKi) :: ErrStat3 + character(ErrMsgLen) :: ErrMsg3 ! add point to list of free ones and add states for it p%nPoints = p%nPoints + 1 ! add 1 to the number of points (this is now the number of the new point) @@ -3307,7 +3324,9 @@ SUBROUTINE DetachLines (attachID, isRod, lineIDs, lineTops, nLinesToDetach, time ! attach lines to new point DO k=1,nLinesToDetach ! for each relevant line - CALL Point_AddLine(m%PointList(p%nPoints), lineIDs(k), lineTops(k)) + CALL Point_AddLine(m%PointList(p%nPoints), lineIDs(k), lineTops(k), ErrStat3, ErrMsg3) + call CheckError(ErrStat3, ErrMsg3) + if (ErrStat >= AbortErrLev) return ENDDO ! update point kinematics to match old line attachment point kinematics and set positions of attached line ends @@ -3903,15 +3922,10 @@ SUBROUTINE MD_End(u, p, x, xd, z, other, y, m, ErrStat , ErrMsg) CALL MD_DestroyMisc(m, ErrStat2, ErrMsg2) CALL CheckError( ErrStat2, ErrMsg2 ) - IF (p%UnLog > 0_IntKi) CLOSE( p%UnLog ) ! close log file if it's open - !TODO: any need to specifically deallocate things like m%xTemp%states in the above? <<<< - - ! IF ( ErrStat==ErrID_None) THEN - ! CALL WrScr('MoorDyn closed without errors') - ! ELSE - ! CALL WrScr('MoorDyn closed with errors') - ! END IF - + IF (p%UnLog > 0_IntKi) then + CLOSE( p%UnLog ) ! close log file if it's open + p%UnLog = -1 ! in case we call end a second time for whatever reason + endif CONTAINS diff --git a/modules/moordyn/src/MoorDyn_Body.f90 b/modules/moordyn/src/MoorDyn_Body.f90 index 3fbf2d6bac..19245533c6 100644 --- a/modules/moordyn/src/MoorDyn_Body.f90 +++ b/modules/moordyn/src/MoorDyn_Body.f90 @@ -613,21 +613,26 @@ END SUBROUTINE Body_GetCoupledForce ! this function handles assigning a point to a body !-------------------------------------------------------------- - SUBROUTINE Body_AddPoint(Body, pointID, coords) + SUBROUTINE Body_AddPoint(Body, pointID, coords, ErrStat, ErrMsg) - Type(MD_Body), INTENT(INOUT) :: Body ! the Point object - Integer(IntKi), INTENT(IN ) :: pointID - REAL(DbKi), INTENT(IN ) :: coords(3) + Type(MD_Body), INTENT(INOUT) :: Body ! the Point object + Integer(IntKi), INTENT(IN ) :: pointID + REAL(DbKi), INTENT(IN ) :: coords(3) + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen),intent( out) :: ErrMsg IF (wordy > 0) Print*, "P", pointID, "->B", Body%IdNum - IF(Body%nAttachedP < 30) THEN ! this is currently just a maximum imposed by a fixed array size. could be improved. + IF(Body%nAttachedP < MD_MaxBdAtch) THEN ! this is currently just a maximum imposed by a fixed array size. could be improved. Body%nAttachedP = Body%nAttachedP + 1 ! increment the number pointed Body%AttachedC(Body%nAttachedP) = pointID Body%rPointRel(:,Body%nAttachedP) = coords ! store relative position of point on body + ErrStat = ErrID_None + ErrMsg = '' ELSE - call WrScr("too many Points attached to Body "//trim(num2lstr(Body%IdNum))//" in MoorDyn!") + ErrStat = ErrID_Fatal + ErrMsg = "too many Points attached to Body "//trim(num2lstr(Body%IdNum))//" in MoorDyn!" END IF END SUBROUTINE Body_AddPoint @@ -635,18 +640,20 @@ END SUBROUTINE Body_AddPoint ! this function handles assigning a rod to a body !-------------------------------------------------------------- - SUBROUTINE Body_AddRod(Body, rodID, coords) + SUBROUTINE Body_AddRod(Body, rodID, coords, ErrStat, ErrMsg) - Type(MD_Body), INTENT(INOUT) :: Body ! the Point object - Integer(IntKi), INTENT(IN ) :: rodID - REAL(DbKi), INTENT(IN ) :: coords(6) ! positions of rod ends A and B relative to body + Type(MD_Body), INTENT(INOUT) :: Body ! the Point object + Integer(IntKi), INTENT(IN ) :: rodID + REAL(DbKi), INTENT(IN ) :: coords(6) ! positions of rod ends A and B relative to body + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen),intent( out) :: ErrMsg REAL(DbKi) :: tempUnitVec(3) REAL(DbKi) :: dummyLength IF (wordy > 0) Print*, "R", rodID, "->B", Body%IdNum - IF(Body%nAttachedR < 30) THEN ! this is currently just a maximum imposed by a fixed array size. could be improved. + IF(Body%nAttachedR < MD_MaxBdAtch) THEN ! this is currently just a maximum imposed by a fixed array size. could be improved. Body%nAttachedR = Body%nAttachedR + 1 ! increment the number connected ! store rod ID @@ -657,8 +664,11 @@ SUBROUTINE Body_AddRod(Body, rodID, coords) Body%r6RodRel(1:3, Body%nAttachedR) = coords(1:3) Body%r6RodRel(4:6, Body%nAttachedR) = tempUnitVec + ErrStat = ErrID_None + ErrMsg = '' ELSE - call WrScr("too many rods attached to Body "//trim(num2lstr(Body%IdNum))//" in MoorDyn") + ErrStat = ErrID_Fatal + ErrMsg = "too many rods attached to Body "//trim(num2lstr(Body%IdNum))//" in MoorDyn" END IF END SUBROUTINE Body_AddRod diff --git a/modules/moordyn/src/MoorDyn_C_Binding.f90 b/modules/moordyn/src/MoorDyn_C_Binding.f90 index 22d1044d28..ef70233506 100644 --- a/modules/moordyn/src/MoorDyn_C_Binding.f90 +++ b/modules/moordyn/src/MoorDyn_C_Binding.f90 @@ -24,7 +24,7 @@ MODULE MoorDyn_C USE MoorDyn USE MoorDyn_Types USE NWTC_Library - USE NWTC_C_Binding + USE NWTC_C_Binding, ONLY: IntfStrLen, ErrMsgLen_C, FileNameFromCString, SetErrStat_F2C USE VersionInfo IMPLICIT NONE @@ -33,7 +33,9 @@ MODULE MoorDyn_C PUBLIC :: MD_C_UpdateStates PUBLIC :: MD_C_CalcOutput PUBLIC :: MD_C_End +PUBLIC :: MD_C_SetWaveFieldData +PRIVATE !------------------------------------------------------------------------------------ ! Version info for display @@ -129,6 +131,7 @@ MODULE MoorDyn_C !=============================================================================================================== !---------------------------------------------- MD INIT -------------------------------------------------------- !=============================================================================================================== +!FIXME: add ShowPassed and DebugLevel SUBROUTINE MD_C_Init( & InputFilePassed, InputFileString_C, InputFileStringLength_C, & DT_C, G_C, RHO_C, DEPTH_C, PtfmInit_C, & @@ -147,31 +150,53 @@ SUBROUTINE MD_C_Init( & REAL(C_FLOAT) , INTENT(IN ) :: G_C REAL(C_FLOAT) , INTENT(IN ) :: RHO_C REAL(C_FLOAT) , INTENT(IN ) :: DEPTH_C +!FIXME: PtfmInit_C should be resized for N nodes (6xN position), but can stay as euler angle for angles REAL(C_FLOAT) , INTENT(IN ) :: PtfmInit_C(6) ! TODO: make this more flexible, can we not have 6 DOF only coupling? INTEGER(C_INT) , INTENT(IN ) :: InterpOrder_C INTEGER(C_INT) , INTENT( OUT) :: NumChannels_C - CHARACTER(KIND=C_CHAR) , INTENT( OUT) :: OutputChannelNames_C(100000) - CHARACTER(KIND=C_CHAR) , INTENT( OUT) :: OutputChannelUnits_C(100000) + CHARACTER(KIND=C_CHAR) , INTENT( OUT) :: OutputChannelNames_C(ChanLen*1000) ! The size of these arrays was chosen as a "big number", it isn't set by MoorDyn. Watch out, it might be bigger than this! + CHARACTER(KIND=C_CHAR) , INTENT( OUT) :: OutputChannelUnits_C(ChanLen*1000) INTEGER(C_INT) , INTENT( OUT) :: ErrStat_C CHARACTER(KIND=C_CHAR) , INTENT( OUT) :: ErrMsg_C(ErrMsgLen_C) ! Local Variables CHARACTER(KIND=C_char, LEN=InputFileStringLength_C), POINTER :: InputFileString !< Input file as a single string with NULL chracter separating lines - INTEGER(IntKi) :: ErrStat, ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg, ErrMsg2 + INTEGER(IntKi) :: ErrStat_F, ErrStat_F2 + CHARACTER(ErrMsgLen) :: ErrMsg_F, ErrMsg_F2 INTEGER :: I, J, K character(*), parameter :: RoutineName = 'MD_C_Init' ! Initialize library and display info on this compile - ErrStat = ErrID_None - ErrMsg = '' + ErrStat_F = ErrID_None + ErrMsg_F = '' CALL NWTC_Init( ProgNameIn=version%Name ) CALL DispCopyrightLicense( version%Name ) CALL DispCompileRuntimeInfo( version%Name ) - + ! Destroy global memory + if (allocated(u)) then + do i = 1, size(u) + call MD_DestroyInput(u(i), ErrStat_F, ErrMsg_F) + end do + deallocate(u) + end if + call MD_DestroyParam(p, ErrStat_F, ErrMsg_F) + do i = 0, 2 + call MD_DestroyContState(x(i), ErrStat_F, ErrMsg_F) + end do + do i = 0, 2 + call MD_DestroyDiscState(xd(i), ErrStat_F, ErrMsg_F) + end do + do i = 0, 2 + call MD_DestroyConstrState(z(i), ErrStat_F, ErrMsg_F) + end do + do i = 0, 2 + call MD_DestroyOtherState(other(i), ErrStat_F, ErrMsg_F) + end do + call MD_DestroyOutput(y, ErrStat_F, ErrMsg_F) + call MD_DestroyMisc(m, ErrStat_F, ErrMsg_F) ! Convert the MD input file to FileInfoType !---------------------------------------------------------------------------------------------------------------------------------------------- @@ -183,7 +208,7 @@ SUBROUTINE MD_C_Init( & if (InputFilePassed==1_c_int) then InitInp%UsePrimaryInputFile = .FALSE. ! Don't try to read an input -- use passed data instead (blades and AF tables not passed) InitInp%FileName = "" ! not actually used - CALL InitFileInfo(InputFileString, InitInp%PassedPrimaryInputData, ErrStat2, ErrMsg2); if (Failed()) return + CALL InitFileInfo(InputFileString, InitInp%PassedPrimaryInputData, ErrStat_F2, ErrMsg_F2); if (Failed()) return else InitInp%UsePrimaryInputFile = .TRUE. ! Read input info from a primary input file InitInp%FileName = FileNameFromCString(InputFileString, InputFileStringLength_C) @@ -195,10 +220,10 @@ SUBROUTINE MD_C_Init( & ! Check the interpolation order IF (InterpOrder_C .EQ. 1 .OR. InterpOrder_C .EQ. 2) THEN InterpOrder = INT(InterpOrder_C, IntKi) - call AllocAry( InputTimes, InterpOrder+1, 'InputTimes', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry( InputTimes, InterpOrder+1, 'InputTimes', ErrStat_F2, ErrMsg_F2); if (Failed()) return ELSE - ErrStat2 = ErrID_Fatal - ErrMsg2 = 'InterpOrder must be 1 (linear) or 2 (quadratic)' + ErrStat_F2 = ErrID_Fatal + ErrMsg_F2 = 'InterpOrder must be 1 (linear) or 2 (quadratic)' if (Failed()) return END IF @@ -213,22 +238,22 @@ SUBROUTINE MD_C_Init( & ! Platform position (x,y,z,Rx,Ry,Rz) -- where rotations are small angle assumption in radians. ! This data is used to set the CoupledKinematics mesh that will be used at each timestep call - CALL AllocAry (InitInp%PtfmInit, 6, 1, 'InitInp%PtfmInit', ErrStat2, ErrMsg2 ); if (Failed()) return + CALL AllocAry (InitInp%PtfmInit, 6, 1, 'InitInp%PtfmInit', ErrStat_F2, ErrMsg_F2 ); if (Failed()) return DO I = 1,6 InitInp%PtfmInit(I,1) = REAL(PtfmInit_C(I),ReKi) END DO - ALLOCATE(u(InterpOrder+1), STAT=ErrStat2) - if (ErrStat2 /= 0) then - ErrStat2 = ErrID_Fatal - ErrMsg2 = 'Failed to allocate Inputs type for MD' + ALLOCATE(u(InterpOrder+1), STAT=ErrStat_F2) + if (ErrStat_F2 /= 0) then + ErrStat_F2 = ErrID_Fatal + ErrMsg_F2 = 'Failed to allocate Inputs type for MD' if (Failed()) return endif !------------------------------------------------- ! Call the main subroutine MD_Init !------------------------------------------------- - CALL MD_Init(InitInp, u(1), p, x(STATE_CURR), xd(STATE_CURR), z(STATE_CURR), other(STATE_CURR), y, m, dT_Global, InitOutData, ErrStat2, ErrMsg2); if (Failed()) return + CALL MD_Init(InitInp, u(1), p, x(STATE_CURR), xd(STATE_CURR), z(STATE_CURR), other(STATE_CURR), y, m, dT_Global, InitOutData, ErrStat_F2, ErrMsg_F2); if (Failed()) return !------------------------------------------------- ! Set output channel information for driver code @@ -259,45 +284,43 @@ SUBROUTINE MD_C_Init( & END DO tmpVelocities = 0_ReKi tmpAccelerations = 0_ReKi - CALL SetMotionLoadsInterfaceMeshes(ErrStat2,ErrMsg2); if (Failed()) return + CALL SetMotionLoadsInterfaceMeshes(ErrStat_F2,ErrMsg_F2); if (Failed()) return DO i=2,InterpOrder+1 - CALL MD_CopyInput (u(1), u(i), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL MD_CopyInput (u(1), u(i), MESH_NEWCOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return END DO InputTimePrev = -dT_Global ! Initialize for MD_C_UpdateStates !------------------------------------------------------------- ! Initial setup of other pieces of x,xd,z,other !------------------------------------------------------------- - CALL MD_CopyContState ( x( STATE_CURR), x( STATE_PRED), MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - CALL MD_CopyDiscState ( xd( STATE_CURR), xd( STATE_PRED), MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - CALL MD_CopyConstrState( z( STATE_CURR), z( STATE_PRED), MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - CALL MD_CopyOtherState ( other(STATE_CURR), other(STATE_PRED), MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + CALL MD_CopyContState ( x( STATE_CURR), x( STATE_PRED), MESH_NEWCOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL MD_CopyDiscState ( xd( STATE_CURR), xd( STATE_PRED), MESH_NEWCOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL MD_CopyConstrState( z( STATE_CURR), z( STATE_PRED), MESH_NEWCOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL MD_CopyOtherState ( other(STATE_CURR), other(STATE_PRED), MESH_NEWCOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return !------------------------------------------------------------- ! Setup the previous timestep copies of states !------------------------------------------------------------- - CALL MD_CopyContState ( x( STATE_CURR), x( STATE_LAST), MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - CALL MD_CopyDiscState ( xd( STATE_CURR), xd( STATE_LAST), MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - CALL MD_CopyConstrState( z( STATE_CURR), z( STATE_LAST), MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - CALL MD_CopyOtherState ( other(STATE_CURR), other(STATE_LAST), MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + CALL MD_CopyContState ( x( STATE_CURR), x( STATE_LAST), MESH_NEWCOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL MD_CopyDiscState ( xd( STATE_CURR), xd( STATE_LAST), MESH_NEWCOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL MD_CopyConstrState( z( STATE_CURR), z( STATE_LAST), MESH_NEWCOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return + CALL MD_CopyOtherState ( other(STATE_CURR), other(STATE_LAST), MESH_NEWCOPY, ErrStat_F2, ErrMsg_F2); if (Failed()) return !------------------------------------------------- ! Clean up variables and set up for MD_C_CalcOutput !------------------------------------------------- - CALL MD_DestroyInitInput( InitInp, ErrStat2, ErrMsg2 ); if (Failed()) return - CALL MD_DestroyInitOutput( InitOutData, ErrStat2, ErrMsg2 ); if (Failed()) return + CALL MD_DestroyInitInput( InitInp, ErrStat_F2, ErrMsg_F2 ); if (Failed()) return + CALL MD_DestroyInitOutput( InitOutData, ErrStat_F2, ErrMsg_F2 ); if (Failed()) return - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) CONTAINS logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - if (Failed) then - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) - endif + CALL SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + Failed = ErrStat_F >= AbortErrLev + if (Failed) call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) end function Failed END SUBROUTINE MD_C_Init @@ -318,14 +341,14 @@ SUBROUTINE MD_C_UpdateStates(Time_C, TimeNext_C, POSITIONS_C, VELOCITIES_C, ACCE CHARACTER(KIND=C_CHAR) , INTENT( OUT) :: ErrMsg_C(ErrMsgLen_C) ! Local Variables - INTEGER(IntKi) :: ErrStat, ErrStat2, J - CHARACTER(ErrMsgLen) :: ErrMsg, ErrMsg2 + INTEGER(IntKi) :: ErrStat_F, ErrStat_F2, J + CHARACTER(ErrMsgLen) :: ErrMsg_F, ErrMsg_F2 LOGICAL :: CorrectionStep character(*), parameter :: RoutineName = 'MD_C_UpdateStates' ! Set up error handling for MD_C_CalcOutput - ErrStat = ErrID_None - ErrMsg = '' + ErrStat_F = ErrID_None + ErrMsg_F = '' CorrectionStep = .FALSE. !------------------------------------------------------- @@ -366,17 +389,17 @@ SUBROUTINE MD_C_UpdateStates(Time_C, TimeNext_C, POSITIONS_C, VELOCITIES_C, ACCE ! Step back to previous state because we are doing a correction step ! -- repeating the T -> T+dt update with new inputs at T+dt ! -- the STATE_CURR contains states at T+dt from the previous call, so revert those - CALL MD_CopyContState (x( STATE_LAST), x( STATE_CURR), MESH_UPDATECOPY, ErrStat2, ErrMsg2); IF (Failed()) RETURN - CALL MD_CopyDiscState (xd( STATE_LAST), xd( STATE_CURR), MESH_UPDATECOPY, ErrStat2, ErrMsg2); IF (Failed()) RETURN - CALL MD_CopyConstrState (z( STATE_LAST), z( STATE_CURR), MESH_UPDATECOPY, ErrStat2, ErrMsg2); IF (Failed()) RETURN - CALL MD_CopyOtherState (other(STATE_LAST), other(STATE_CURR), MESH_UPDATECOPY, ErrStat2, ErrMsg2); IF (Failed()) RETURN + CALL MD_CopyContState (x( STATE_LAST), x( STATE_CURR), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); IF (Failed()) RETURN + CALL MD_CopyDiscState (xd( STATE_LAST), xd( STATE_CURR), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); IF (Failed()) RETURN + CALL MD_CopyConstrState (z( STATE_LAST), z( STATE_CURR), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); IF (Failed()) RETURN + CALL MD_CopyOtherState (other(STATE_LAST), other(STATE_CURR), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); IF (Failed()) RETURN ELSE ! Cycle inputs back one timestep since we are moving forward in time. IF (InterpOrder>1) THEN ! quadratic, so keep the old time - CALL MD_CopyInput( u(INPUT_CURR), u(INPUT_LAST), MESH_UPDATECOPY, ErrStat2, ErrMsg2); IF (Failed()) RETURN + CALL MD_CopyInput( u(INPUT_CURR), u(INPUT_LAST), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); IF (Failed()) RETURN END IF ! Move inputs from previous t+dt (now t) to t - CALL MD_CopyInput( u(INPUT_PRED), u(INPUT_CURR), MESH_UPDATECOPY, ErrStat2, ErrMsg2); IF (Failed()) RETURN + CALL MD_CopyInput( u(INPUT_PRED), u(INPUT_CURR), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); IF (Failed()) RETURN END IF ! Reshape position and velocity (transposing from a row vector to a column vector) @@ -388,20 +411,20 @@ SUBROUTINE MD_C_UpdateStates(Time_C, TimeNext_C, POSITIONS_C, VELOCITIES_C, ACCE ! Transfer motions to input meshes CALL Set_MotionMesh() - CALL MD_SetInputMotion( u(INPUT_PRED), ErrStat2, ErrMsg2 ); IF (Failed()) RETURN + CALL MD_SetInputMotion( u(INPUT_PRED), ErrStat_F2, ErrMsg_F2 ); IF (Failed()) RETURN ! Set copy the current state over to the predicted state for sending to UpdateStates ! -- The STATE_PREDicted will get updated in the call. ! -- The UpdateStates routine expects this to contain states at T at the start of the call (history not passed in) - CALL MD_CopyContState (x( STATE_CURR), x( STATE_PRED), MESH_UPDATECOPY, ErrStat2, ErrMsg2); IF (Failed()) RETURN - CALL MD_CopyDiscState (xd( STATE_CURR), xd( STATE_PRED), MESH_UPDATECOPY, ErrStat2, ErrMsg2); IF (Failed()) RETURN - CALL MD_CopyConstrState (z( STATE_CURR), z( STATE_PRED), MESH_UPDATECOPY, ErrStat2, ErrMsg2); IF (Failed()) RETURN - CALL MD_CopyOtherState (other(STATE_CURR), other(STATE_PRED), MESH_UPDATECOPY, ErrStat2, ErrMsg2); IF (Failed()) RETURN + CALL MD_CopyContState (x( STATE_CURR), x( STATE_PRED), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); IF (Failed()) RETURN + CALL MD_CopyDiscState (xd( STATE_CURR), xd( STATE_PRED), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); IF (Failed()) RETURN + CALL MD_CopyConstrState (z( STATE_CURR), z( STATE_PRED), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); IF (Failed()) RETURN + CALL MD_CopyOtherState (other(STATE_CURR), other(STATE_PRED), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); IF (Failed()) RETURN !------------------------------------------------- ! Call the main subroutine MD_UpdateStates !------------------------------------------------- - CALL MD_UpdateStates( InputTimes(INPUT_CURR), N_Global, u, InputTimes, p, x(STATE_PRED), xd(STATE_PRED), z(STATE_PRED), other(STATE_PRED), m, ErrStat2, ErrMsg2); IF (Failed()) RETURN + CALL MD_UpdateStates( InputTimes(INPUT_CURR), N_Global, u, InputTimes, p, x(STATE_PRED), xd(STATE_PRED), z(STATE_PRED), other(STATE_PRED), m, ErrStat_F2, ErrMsg_F2); IF (Failed()) RETURN !------------------------------------------------------- ! Cycle the states @@ -409,26 +432,24 @@ SUBROUTINE MD_C_UpdateStates(Time_C, TimeNext_C, POSITIONS_C, VELOCITIES_C, ACCE ! Move current state at T to previous state at T-dt ! -- STATE_LAST now contains info at time T ! -- this allows repeating the T --> T+dt update - CALL MD_CopyContState (x( STATE_CURR), x( STATE_LAST), MESH_UPDATECOPY, ErrStat2, ErrMsg2); IF (Failed()) RETURN - CALL MD_CopyDiscState (xd( STATE_CURR), xd( STATE_LAST), MESH_UPDATECOPY, ErrStat2, ErrMsg2); IF (Failed()) RETURN - CALL MD_CopyConstrState (z( STATE_CURR), z( STATE_LAST), MESH_UPDATECOPY, ErrStat2, ErrMsg2); IF (Failed()) RETURN - CALL MD_CopyOtherState (other(STATE_CURR), other(STATE_LAST), MESH_UPDATECOPY, ErrStat2, ErrMsg2); IF (Failed()) RETURN + CALL MD_CopyContState (x( STATE_CURR), x( STATE_LAST), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); IF (Failed()) RETURN + CALL MD_CopyDiscState (xd( STATE_CURR), xd( STATE_LAST), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); IF (Failed()) RETURN + CALL MD_CopyConstrState (z( STATE_CURR), z( STATE_LAST), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); IF (Failed()) RETURN + CALL MD_CopyOtherState (other(STATE_CURR), other(STATE_LAST), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); IF (Failed()) RETURN ! Update the predicted state as the new current state ! -- we have now advanced from T to T+dt. This allows calling with CalcOuput to get the outputs at T+dt - CALL MD_CopyContState (x( STATE_PRED), x( STATE_CURR), MESH_UPDATECOPY, ErrStat2, ErrMsg2); IF (Failed()) RETURN - CALL MD_CopyDiscState (xd( STATE_PRED), xd( STATE_CURR), MESH_UPDATECOPY, ErrStat2, ErrMsg2); IF (Failed()) RETURN - CALL MD_CopyConstrState (z( STATE_PRED), z( STATE_CURR), MESH_UPDATECOPY, ErrStat2, ErrMsg2); IF (Failed()) RETURN - CALL MD_CopyOtherState (other(STATE_PRED), other(STATE_CURR), MESH_UPDATECOPY, ErrStat2, ErrMsg2); IF (Failed()) RETURN - + CALL MD_CopyContState (x( STATE_PRED), x( STATE_CURR), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); IF (Failed()) RETURN + CALL MD_CopyDiscState (xd( STATE_PRED), xd( STATE_CURR), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); IF (Failed()) RETURN + CALL MD_CopyConstrState (z( STATE_PRED), z( STATE_CURR), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); IF (Failed()) RETURN + CALL MD_CopyOtherState (other(STATE_PRED), other(STATE_CURR), MESH_UPDATECOPY, ErrStat_F2, ErrMsg_F2); IF (Failed()) RETURN + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) - -CONTAINS + CONTAINS logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - if (Failed) call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + CALL SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + Failed = ErrStat_F >= AbortErrLev + if (Failed) call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) end function Failed END SUBROUTINE MD_C_UpdateStates @@ -452,13 +473,13 @@ SUBROUTINE MD_C_CalcOutput(Time_C, POSITIONS_C, VELOCITIES_C, ACCELERATIONS_C, F ! Local Variables REAL(DbKi) :: t - INTEGER(IntKi) :: ErrStat, ErrStat2, J - CHARACTER(ErrMsgLen) :: ErrMsg, ErrMsg2 + INTEGER(IntKi) :: ErrStat_F, ErrStat_F2, J + CHARACTER(ErrMsgLen) :: ErrMsg_F, ErrMsg_F2 character(*), parameter :: RoutineName = 'MD_C_CalcOutput' ! Set up error handling for MD_C_CalcOutput - ErrStat = ErrID_None - ErrMsg = '' + ErrStat_F = ErrID_None + ErrMsg_F = '' ! Set up inputs to MD_CalcOutput !----------------------------------------------------------------------------------------------------------- @@ -477,18 +498,18 @@ SUBROUTINE MD_C_CalcOutput(Time_C, POSITIONS_C, VELOCITIES_C, ACCELERATIONS_C, F CALL Set_MotionMesh() ! transfer input motion mesh to u(1) meshes - CALL MD_SetInputMotion( u(1), ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL MD_SetInputMotion( u(1), ErrStat_F2, ErrMsg_F2 ); if (Failed()) return; !------------------------------------------------- ! Call the main subroutine MD_CalcOutput !------------------------------------------------- - CALL MD_CalcOutput( t, u(1), p, x(STATE_CURR), xd(STATE_CURR), z(STATE_CURR), other(STATE_CURR), y, m, ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL MD_CalcOutput( t, u(1), p, x(STATE_CURR), xd(STATE_CURR), z(STATE_CURR), other(STATE_CURR), y, m, ErrStat_F2, ErrMsg_F2 ); if (Failed()) return; !------------------------------------------------- ! Convert the outputs of MD_calcOutput back to C !------------------------------------------------- ! Transfer resulting load meshes to intermediate mesh - CALL MD_TransferLoads( u(1), y, ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL MD_TransferLoads( u(1), y, ErrStat_F2, ErrMsg_F2 ); if (Failed()) return; ! Set output force/moment array CALL Set_OutputLoadArray( ) @@ -500,14 +521,15 @@ SUBROUTINE MD_C_CalcOutput(Time_C, POSITIONS_C, VELOCITIES_C, ACCELERATIONS_C, F OUTPUTS_C = REAL(y%WriteOutput, C_FLOAT) + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) + CONTAINS logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - if (Failed) then - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) - endif + CALL SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + Failed = ErrStat_F >= AbortErrLev + if (Failed) call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) end function Failed + END SUBROUTINE MD_C_CalcOutput !=============================================================================================================== @@ -524,17 +546,22 @@ SUBROUTINE MD_C_End(ErrStat_C,ErrMsg_C) BIND (C, NAME='MD_C_End') CHARACTER(KIND=C_CHAR) , INTENT( OUT) :: ErrMsg_C(ErrMsgLen_C) ! Local variables - INTEGER(IntKi) :: ErrStat, ErrStat2, i - CHARACTER(ErrMsgLen) :: ErrMsg, ErrMsg2 + INTEGER(IntKi) :: ErrStat_F, ErrStat_F2, i + CHARACTER(ErrMsgLen) :: ErrMsg_F, ErrMsg_F2 character(*), parameter :: RoutineName = 'MD_C_End' ! Set up error handling for MD_C_End - ErrStat = ErrID_None - ErrMsg = '' + ErrStat_F = ErrID_None + ErrMsg_F = '' ! Call the main subroutine MD_End - CALL MD_End(u(1), p, x(1), xd(1), z(1), other(1), y, m, ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! If u is not allocated, then we didn't get far at all in initialization, + ! or AD_C_End got called before Init. We don't want a segfault, so check + ! for allocation. + if (allocated(u)) then + CALL MD_End(u(1), p, x(1), xd(1), z(1), other(1), y, m, ErrStat_F2, ErrMsg_F2) + call SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + endif ! NOTE: MoorDyn_End only takes 1 instance of u, not the array. So extra ! logic is required here (this isn't necessary in the fortran driver @@ -542,25 +569,25 @@ SUBROUTINE MD_C_End(ErrStat_C,ErrMsg_C) BIND (C, NAME='MD_C_End') ! or some other code using the c-bindings) IF (allocated(u)) THEN DO i=2,size(u) - CALL MD_DestroyInput( u(i), ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_DestroyInput( u(i), ErrStat_F2, ErrMsg_F2 ) + call SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) END DO IF (allocated(u)) deallocate(u) END IF ! Destroy any other copies of states (rerun on (STATE_CURR) is ok) - call MD_DestroyContState( x( STATE_LAST), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call MD_DestroyContState( x( STATE_CURR), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call MD_DestroyContState( x( STATE_PRED), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call MD_DestroyDiscState( xd( STATE_LAST), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call MD_DestroyDiscState( xd( STATE_CURR), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call MD_DestroyDiscState( xd( STATE_PRED), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call MD_DestroyConstrState( z( STATE_LAST), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call MD_DestroyConstrState( z( STATE_CURR), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call MD_DestroyConstrState( z( STATE_PRED), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call MD_DestroyOtherState( other(STATE_LAST), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call MD_DestroyOtherState( other(STATE_CURR), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call MD_DestroyOtherState( other(STATE_PRED), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call MD_DestroyContState( x( STATE_LAST), ErrStat_F2, ErrMsg_F2 ); call SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + call MD_DestroyContState( x( STATE_CURR), ErrStat_F2, ErrMsg_F2 ); call SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + call MD_DestroyContState( x( STATE_PRED), ErrStat_F2, ErrMsg_F2 ); call SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + call MD_DestroyDiscState( xd( STATE_LAST), ErrStat_F2, ErrMsg_F2 ); call SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + call MD_DestroyDiscState( xd( STATE_CURR), ErrStat_F2, ErrMsg_F2 ); call SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + call MD_DestroyDiscState( xd( STATE_PRED), ErrStat_F2, ErrMsg_F2 ); call SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + call MD_DestroyConstrState( z( STATE_LAST), ErrStat_F2, ErrMsg_F2 ); call SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + call MD_DestroyConstrState( z( STATE_CURR), ErrStat_F2, ErrMsg_F2 ); call SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + call MD_DestroyConstrState( z( STATE_PRED), ErrStat_F2, ErrMsg_F2 ); call SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + call MD_DestroyOtherState( other(STATE_LAST), ErrStat_F2, ErrMsg_F2 ); call SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + call MD_DestroyOtherState( other(STATE_CURR), ErrStat_F2, ErrMsg_F2 ); call SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + call MD_DestroyOtherState( other(STATE_PRED), ErrStat_F2, ErrMsg_F2 ); call SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) ! if deallocate other items now if (allocated(InputTimes)) deallocate(InputTimes) @@ -568,22 +595,45 @@ SUBROUTINE MD_C_End(ErrStat_C,ErrMsg_C) BIND (C, NAME='MD_C_End') ! Clear out mesh related data storage call ClearMesh() - call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + call SetErrStat_F2C(ErrStat_F,ErrMsg_F,ErrStat_C,ErrMsg_C) CONTAINS !> Don't leave junk in memory. So destroy meshes and mappings. subroutine ClearMesh() - call MeshDestroy( MD_MotionMesh, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call MeshDestroy( MD_LoadMesh, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call MeshDestroy( MD_MotionMesh, ErrStat_F2, ErrMsg_F2 ) + call SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + call MeshDestroy( MD_LoadMesh, ErrStat_F2, ErrMsg_F2 ) + call SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) ! Destroy mesh mappings - call NWTC_Library_Destroymeshmaptype( Map_Motion_2_MD, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call NWTC_Library_Destroymeshmaptype( Map_MD_2_Load, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call NWTC_Library_Destroymeshmaptype( Map_Motion_2_MD, ErrStat_F2, ErrMsg_F2 ) + call SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) + call NWTC_Library_Destroymeshmaptype( Map_MD_2_Load, ErrStat_F2, ErrMsg_F2 ) + call SetErrStat( ErrStat_F2, ErrMsg_F2, ErrStat_F, ErrMsg_F, RoutineName ) end subroutine ClearMesh END SUBROUTINE MD_C_End +!=============================================================================================================== +!----------------------------------------------- MD SetWaveFieldData ------------------------------------------- +!=============================================================================================================== +!> Set the wave field data pointer from an external source such as SeaState +SUBROUTINE MD_C_SetWaveFieldData(WaveFieldData_C) BIND (C, NAME='MD_C_SetWaveFieldData') +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: MD_C_SetWaveFieldData +!GCC$ ATTRIBUTES DLLEXPORT :: MD_C_SetWaveFieldData +#endif + TYPE(C_PTR), INTENT(IN) :: WaveFieldData_C + + ! Local Variables + ! INTEGER(IntKi) :: ErrStat_F, ErrStat_F2 + ! CHARACTER(ErrMsgLen) :: ErrMsg_F, ErrMsg_F2 + character(*), parameter :: RoutineName = 'MD_C_SetWaveFieldData' + + ! ErrStat_F = ErrID_None + ! ErrMsg_F = '' + + call C_F_POINTER(WaveFieldData_C, InitInp%WaveField) ! Set the wave field data pointer + +END SUBROUTINE MD_C_SetWaveFieldData + !=============================================================================================================== !----------------------------------------- ADDITIONAL SUBROUTINES ---------------------------------------------- !=============================================================================================================== diff --git a/modules/moordyn/src/MoorDyn_Driver.f90 b/modules/moordyn/src/MoorDyn_Driver.f90 index 3ed23fc7c2..772b46a7a0 100644 --- a/modules/moordyn/src/MoorDyn_Driver.f90 +++ b/modules/moordyn/src/MoorDyn_Driver.f90 @@ -78,15 +78,14 @@ PROGRAM MoorDyn_Driver ! SeaState types TYPE(SeaSt_InitInputType) :: InitInData_SeaSt ! Input data for initialization TYPE(SeaSt_InitOutputType) :: InitOutData_SeaSt ! Output data from initialization - type(SeaSt_ContinuousStateType) :: x_SeaSt ! Continuous states - type(SeaSt_DiscreteStateType) :: xd_SeaSt ! Discrete states - type(SeaSt_ConstraintStateType) :: z_SeaSt ! Constraint states - type(SeaSt_OtherStateType) :: OtherState_SeaSt ! Other states - type(SeaSt_MiscVarType) :: m_SeaSt ! Misc/optimization variables - type(SeaSt_ParameterType) :: p_SeaSt ! Parameters - type(SeaSt_InputType) :: u_SeaSt(1) ! System inputs - type(SeaSt_OutputType) :: y_SeaSt ! System outputs - LOGICAL :: SeaState_Initialized = .FALSE. + type(SeaSt_ContinuousStateType) :: x_SeaSt ! Continuous states + type(SeaSt_DiscreteStateType) :: xd_SeaSt ! Discrete states + type(SeaSt_ConstraintStateType) :: z_SeaSt ! Constraint states + type(SeaSt_OtherStateType) :: OtherState_SeaSt ! Other states + type(SeaSt_MiscVarType) :: m_SeaSt ! Misc/optimization variables + type(SeaSt_ParameterType) :: p_SeaSt ! Parameters + type(SeaSt_InputType) :: u_SeaSt(1) ! System inputs + type(SeaSt_OutputType) :: y_SeaSt ! System outputs ! Motion file parsing type(FileInfoType) :: FileInfo_PrescribeMtn !< The derived type for holding the prescribed forces input file for parsing -- we may pass this in the future @@ -138,6 +137,7 @@ PROGRAM MoorDyn_Driver ErrStat = ErrID_None UnEcho=-1 ! set to -1 as echo is no longer used by MD UnIn =-1 + ! TODO: Sort out error handling (two sets of flags currently used) @@ -210,8 +210,6 @@ PROGRAM MoorDyn_Driver ! allocate Input and Output arrays; used for interpolation and extrapolation Allocate(MD_uTimes(MD_interp_order + 1)) - - ! @bonnie : This is in the FAST developers glue code example, but it's probably not needed here. Allocate(MD_u(MD_interp_order + 1)) @@ -237,8 +235,8 @@ PROGRAM MoorDyn_Driver InitInData_SeaSt%TMax = MD_InitInp%TMax InitInData_SeaSt%Linearize = MD_InitInp%Linearize - CALL SeaSt_Init( InitInData_SeaSt, u_SeaSt(1), p_SeaSt, x_SeaSt, xd_SeaSt, z_SeaSt, OtherState_SeaSt, y_SeaSt, m_SeaSt, dtC, InitOutData_SeaSt, ErrStat2, ErrMsg2 ); call AbortIfFailed() - SeaState_Initialized = .TRUE. + CALL SeaSt_Init( InitInData_SeaSt, u_SeaSt(1), p_SeaSt, x_SeaSt, xd_SeaSt, z_SeaSt, OtherState_SeaSt, y_SeaSt, m_SeaSt, dtC, InitOutData_SeaSt, ErrStat2, ErrMsg2 ) + call AbortIfFailed() IF ( dtC /= drvrInitInp%dtC) THEN ErrMsg2 = 'The SeaState Module attempted to change the coupling timestep, but this is not allowed. The SeaState Module must use the Driver coupling timestep.' @@ -252,13 +250,10 @@ PROGRAM MoorDyn_Driver END IF ! call the initialization routine - CALL MD_Init( MD_InitInp, MD_u(1), MD_p, MD_x , MD_xd, MD_xc, MD_xo, MD_y, MD_m, dtC, MD_InitOut, ErrStat2, ErrMsg2 ); call AbortIfFailed() + CALL MD_Init( MD_InitInp, MD_u(1), MD_p, MD_x , MD_xd, MD_xc, MD_xo, MD_y, MD_m, dtC, MD_InitOut, ErrStat2, ErrMsg2 ) + call AbortIfFailed() - CALL MD_DestroyInitInput ( MD_InitInp , ErrStat2, ErrMsg2 ); call AbortIfFailed() - CALL MD_DestroyInitOutput ( MD_InitOut , ErrStat2, ErrMsg2 ); call AbortIfFailed() - - CALL DispNVD( MD_InitOut%Ver ) - + CALL DispNVD( MD_InitOut%Ver ) ! determine number of input channels expected from driver input file time series (DOFs including active tensioning channels) if (allocated(MD_u(1)%DeltaL)) then @@ -693,50 +688,47 @@ PROGRAM MoorDyn_Driver CALL RunTimes( ProgStrtTime, ProgStrtCPU, SimStrtTime, SimStrtCPU, t ) ! Destroy all objects - IF (SeaState_Initialized) THEN - CALL SeaSt_End( u_SeaSt(1), p_SeaSt, x_SeaSt, xd_SeaSt, z_SeaSt, OtherState_SeaSt, y_SeaSt, m_SeaSt, ErrStat2, ErrMsg2); call AbortIfFailed() - ENDIF - CALL MD_End( MD_u(1), MD_p, MD_x, MD_xd, MD_xc , MD_xo, MD_y, MD_m, ErrStat2, ErrMsg2 ); call AbortIfFailed() - - do j = 2,MD_interp_order+1 - call MD_DestroyInput( MD_u(j), ErrStat2, ErrMsg2) - end do - - if ( ErrStat /= ErrID_None ) THEN ! Display all errors - CALL WrScr1( "Errors: " ) - CALL WrScr( trim(GetErrStr(ErrStat))//': '//trim(ErrMsg) ) - endif - - !close (un) - call CleanUp() + call EndAndCleanUp() CALL NormStop() CONTAINS - + !------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE AbortIfFailed() - - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MoorDyn_Driver') - - if (ErrStat >= AbortErrLev) then - if (SeaState_Initialized) then - call SeaSt_End( u_SeaSt(1), p_SeaSt, x_SeaSt, xd_SeaSt, z_SeaSt, OtherState_SeaSt, y_SeaSt, m_SeaSt, ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MoorDyn_Driver' ) - end if - - CALL SeaSt_DestroyInitOutput( InitOutData_SeaSt, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MoorDyn_Driver' ) - CALL SeaSt_DestroyInitInput( InitInData_SeaSt, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MoorDyn_Driver' ) - - call CleanUp() - Call ProgAbort(trim(ErrMsg)) - elseif ( ErrStat2 /= ErrID_None ) THEN - CALL WrScr1( trim(GetErrStr(ErrStat2))//': '//trim(ErrMsg2)//NewLine) - end if + + if (ErrStat >= AbortErrLev .OR. ErrStat2 >= AbortErrLev) then + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MoorDyn_Driver') + + call EndAndCleanUp() + Call ProgAbort(trim(ErrMsg)) + elseif ( ErrStat2 /= ErrID_None ) THEN ! print messages as we get them (but don't call SetErrStat or they will be printed 2x) + CALL WrScr1( trim(GetErrStr(ErrStat2))//': '//trim(ErrMsg2)//NewLine) + end if + END SUBROUTINE AbortIfFailed + !------------------------------------------------------------------------------------------------------------------------------- + SUBROUTINE EndAndCleanUp() + CALL SeaSt_DestroyInitOutput( InitOutData_SeaSt, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MoorDyn_Driver' ) + CALL SeaSt_DestroyInitInput( InitInData_SeaSt, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MoorDyn_Driver' ) + + CALL MD_DestroyInitOutput( MD_InitOut, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MoorDyn_Driver' ) + CALL MD_DestroyInitInput( MD_InitInp, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MoorDyn_Driver' ) + + call SeaSt_End( u_SeaSt(1), p_SeaSt, x_SeaSt, xd_SeaSt, z_SeaSt, OtherState_SeaSt, y_SeaSt, m_SeaSt, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MoorDyn_Driver' ) + + CALL MD_End( MD_u(1), MD_p, MD_x, MD_xd, MD_xc , MD_xo, MD_y, MD_m, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MoorDyn_Driver' ) + + do j = 2,MD_interp_order+1 + call MD_DestroyInput( MD_u(j), ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MoorDyn_Driver' ) + end do - SUBROUTINE CleanUp() if(UnEcho >0) CLOSE( UnEcho ) if(UnIn >0) CLOSE( UnIn ) @@ -749,7 +741,15 @@ SUBROUTINE CleanUp() IF (ALLOCATED(rd_in2 )) DEALLOCATE(rd_in2 ) IF (ALLOCATED(rdd_in )) DEALLOCATE(rdd_in ) IF (ALLOCATED(rdd_in2 )) DEALLOCATE(rdd_in2 ) - END SUBROUTINE CleanUp + IF (ALLOCATED(TmpRe )) DEALLOCATE(TmpRe ) + + + + if ( ErrStat /= ErrID_None ) THEN ! Display all errors + CALL WrScr1( "Errors: " ) + CALL WrScr( trim(GetErrStr(ErrStat))//': '//trim(ErrMsg) ) + endif + END SUBROUTINE EndAndCleanUp !------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE ReadDriverInputFile( inputFile, InitInp) diff --git a/modules/moordyn/src/MoorDyn_IO.f90 b/modules/moordyn/src/MoorDyn_IO.f90 index 12764b381a..3061b350f9 100644 --- a/modules/moordyn/src/MoorDyn_IO.f90 +++ b/modules/moordyn/src/MoorDyn_IO.f90 @@ -31,9 +31,6 @@ MODULE MoorDyn_IO INTEGER(IntKi), PARAMETER :: wordy = 0 ! verbosity level. >1 = more console output - INTEGER, PARAMETER :: nCoef = 30 ! maximum number of entries to allow in nonlinear coefficient lookup tables - ! it would be nice if the above worked for everything, but I think it needs to also be matched in the Registry - ! --------------------------- Output definitions ----------------------------------------- ! The following are some definitions for use with the output options in MoorDyn. @@ -79,19 +76,23 @@ MODULE MoorDyn_IO INTEGER, PARAMETER :: MZ = 25 INTEGER, PARAMETER :: Sub = 26 INTEGER, PARAMETER :: TenA = 27 - INTEGER, PARAMETER :: TenB = 28 - + INTEGER, PARAMETER :: TenB = 28 + ! List of units corresponding to the quantities parameters for QTypes - CHARACTER(ChanLen), PARAMETER :: UnitList(0:26) = (/ & - "(s) ","(m) ","(m) ","(m) ", & - "(deg) ","(deg) ","(deg) ", & - "(m/s) ","(m/s) ","(m/s) ", & - "(deg/s) ","(deg/s) ","(deg/s) ", & - "(m/s2) ","(m/s2) ","(m/s2) ", & - "(deg/s2) ","(deg/s2) ","(deg/s2) ", & - "(N) ","(N) ","(N) ","(N) ", & - "(Nm) ","(Nm) ","(Nm) ","(frac) "/) + CHARACTER(ChanLen), PARAMETER :: UnitList(0:26) = (/ & + "(s) ", & ! 0: Time + "(m) ", "(m) ", "(m) ", & ! 1–3: PosX, PosY, PosZ + "(deg) ", "(deg) ", "(deg) ", & ! 4–6: RotX, RotY, RotZ + "(m/s) ", "(m/s) ", "(m/s) ", & ! 7–9: VelX, VelY, VelZ + "(deg/s) ", "(deg/s) ", "(deg/s) ", & ! 10–12: RVelX, RVelY, RVelZ + "(m/s2) ", "(m/s2) ", "(m/s2) ", & ! 13–15: AccX, AccY, AccZ + "(deg/s2) ", "(deg/s2) ", "(deg/s2) ", & ! 16–18: RAccX, RAccY, RAccZ + "(N) ", & ! 19: Ten + "(N) ", "(N) ", "(N) ", & ! 20–22: FX, FY, FZ + "(Nm) ", "(Nm) ", "(Nm) ", & ! 23–25: MX, MY, MZ + "(frac) " & ! 26: Sub +/) CHARACTER(28), PARAMETER :: OutPFmt = "( I4, 3X,A 10,1 X, A10 )" ! Output format parameter output list. CHARACTER(28), PARAMETER :: OutSFmt = "ES10.3E2" @@ -124,9 +125,10 @@ MODULE MoorDyn_IO CONTAINS - SUBROUTINE setupBathymetry(inputString, defaultDepth, BathGrid, BathGrid_Xs, BathGrid_Ys, ErrStat3, ErrMsg3) + SUBROUTINE setupBathymetry(p, inputString, defaultDepth, BathGrid, BathGrid_Xs, BathGrid_Ys, ErrStat3, ErrMsg3) ! SUBROUTINE getBathymetry(inputString, BathGrid, BathGrid_Xs, BathGrid_Ys, BathGrid_npoints, ErrStat3, ErrMsg3) + TYPE(MD_ParameterType), INTENT(INOUT) :: p ! Parameters CHARACTER(40), INTENT(IN ) :: inputString ! string describing water depth or bathymetry filename REAL(ReKi), INTENT(IN ) :: defaultDepth ! depth to use if inputString is empty REAL(DbKi), ALLOCATABLE, INTENT(INOUT) :: BathGrid (:,:) @@ -140,7 +142,8 @@ SUBROUTINE setupBathymetry(inputString, defaultDepth, BathGrid, BathGrid_Xs, Bat INTEGER(IntKi) :: ErrStat4 CHARACTER(120) :: ErrMsg4 - CHARACTER(4096) :: Line2 + CHARACTER(4096) :: Line2 + CHARACTER(1024) :: FileName CHARACTER(20) :: nGridX_string ! string to temporarily hold the nGridX string from Line2 CHARACTER(20) :: nGridY_string ! string to temporarily hold the nGridY string from Line3 @@ -173,41 +176,63 @@ SUBROUTINE setupBathymetry(inputString, defaultDepth, BathGrid, BathGrid_Xs, Bat ELSE ! otherwise interpret the input as a file name to load the bathymetry lookup data from CALL WrScr(" The depth input contains letters so will load a bathymetry file.") + IF ( PathIsRelative( inputString ) ) THEN ! properly handle relative path <<< + FileName = TRIM(p%PriPath)//TRIM(inputString) + ELSE + FileName = trim(inputString) + END IF + ! load lookup table data from file CALL GetNewUnit( UnCoef ) ! unit number for coefficient input file - CALL OpenFInpFile( UnCoef, TRIM(inputString), ErrStat4, ErrMsg4 ) - cALL SetErrStat(ErrStat4, ErrMsg4, ErrStat3, ErrMsg3, 'MDIO_getBathymetry') + CALL OpenFInpFile( UnCoef, FileName, ErrStat4, ErrMsg4 ) + CALL SetErrStat(ErrStat4, ErrMsg4, ErrStat3, ErrMsg3, 'MDIO_getBathymetry') READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 ! skip the first title line READ(UnCoef,*,IOSTAT=ErrStat4) nGridX_string, nGridX ! read in the second line as the number of x values in the BathGrid READ(UnCoef,*,IOSTAT=ErrStat4) nGridY_string, nGridY ! read in the third line as the number of y values in the BathGrid + ! error check that the number of x and y values were read in correctly + IF (ErrStat4 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, "Error reading the number of x and y values from the bathymetry file "//TRIM(inputString), ErrStat3, ErrMsg3, 'MDIO_getBathymetry') + CLOSE (UnCoef) + RETURN + ENDIF + ! Allocate the bathymetry matrix and associated grid x and y values ALLOCATE(BathGrid(nGridY, nGridX), STAT=ErrStat4) ALLOCATE(BathGrid_Xs(nGridX), STAT=ErrStat4) ALLOCATE(BathGrid_Ys(nGridY), STAT=ErrStat4) + ! Error check that allocation was successful + IF (ErrStat4 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, "Error allocating memory for the bathymetry grid from file "//TRIM(inputString), ErrStat3, ErrMsg3, 'MDIO_getBathymetry') + CLOSE (UnCoef) + RETURN + ENDIF + DO I = 1, nGridY+1 ! loop through each line in the rest of the bathymetry file READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 ! read into a line and call it Line2 - IF (ErrStat4 > 0) EXIT IF (I==1) THEN ! if it's the first line in the Bathymetry Grid, then it's a list of all the x values READ(Line2, *,IOSTAT=ErrStat4) BathGrid_Xs ELSE ! if it's not the first line, then the first value is a y value and the rest are the depth values READ(Line2, *,IOSTAT=ErrStat4) BathGrid_Ys(I-1), BathGrid(I-1,:) ENDIF + + IF (ErrStat4 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, "Error reading the bathymetry file "//TRIM(inputString)//" at table line "//trIM(Num2Lstr(I)), ErrStat3, ErrMsg3, 'MDIO_getBathymetry') + CLOSE (UnCoef) + RETURN + ENDIF END DO + CLOSE (UnCoef) + IF (I < 2) THEN - ErrStat3 = ErrID_Fatal - ErrMsg3 = "Less than the minimum of 2 data lines found in file "//TRIM(inputString) - CLOSE (UnCoef) + CALL SetErrStat(ErrID_Fatal, "Less than the minimum of 2 data lines found in file "//TRIM(inputString), ErrStat3, ErrMsg3, 'MDIO_getBathymetry') RETURN - ELSE - ! BathGrid_npoints = nGridX*nGridY ! save the number of points in the grid - CLOSE (UnCoef) END IF END IF @@ -221,8 +246,8 @@ SUBROUTINE getCoefficientOrCurve(inputString, LineProp_c, LineProp_npoints, Line CHARACTER(40), INTENT(IN ) :: inputString REAL(DbKi), INTENT(INOUT) :: LineProp_c INTEGER(IntKi), INTENT( OUT) :: LineProp_nPoints - REAL(DbKi), INTENT( OUT) :: LineProp_Xs (nCoef) - REAL(DbKi), INTENT( OUT) :: LineProp_Ys (nCoef) + REAL(DbKi), INTENT( OUT) :: LineProp_Xs (MD_MaxNCoef) ! MD_MaxNCoef set in registry + REAL(DbKi), INTENT( OUT) :: LineProp_Ys (MD_MaxNCoef) ! MD_MaxNCoef set in registry INTEGER(IntKi), INTENT( OUT) :: ErrStat3 ! Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg3 ! Error message if ErrStat /= ErrID_None @@ -261,7 +286,7 @@ SUBROUTINE getCoefficientOrCurve(inputString, LineProp_c, LineProp_npoints, Line READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 - DO I = 1, nCoef + DO I = 1, MD_MaxNCoef READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 !read into a line @@ -801,9 +826,9 @@ SUBROUTINE MDIO_ProcessOutList(OutList, p, m, y, InitOut, ErrStat, ErrMsg ) DO I=1,p%NRods ! calculate number of output entries (excluding time) to write for this Rod - RodNumOuts = 3*(m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(2:9)) & - + (m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(10:11)) & - + m%RodList(I)%N*SUM(m%RodList(I)%OutFlagList(12:18)) + RodNumOuts = 3*(m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(2:24)) & + + (m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(25:26)) & + + m%RodList(I)%N*SUM(m%RodList(I)%OutFlagList(27:51)) ALLOCATE(m%RodList(I)%RodWrOutput( 1 + RodNumOuts), STAT = ErrStat) IF ( ErrStat /= ErrID_None ) THEN @@ -860,7 +885,7 @@ SUBROUTINE MDIO_OpenOutput( MD_ProgDesc, p, m, InitOut, ErrStat, ErrMsg ) ! INTEGER :: L ! counter for index in LineWrOutput INTEGER :: LineNumOuts ! number of entries in LineWrOutput for each line INTEGER :: RodNumOuts ! for Rods ... redundant <<< - CHARACTER(200) :: Frmt ! a string to hold a format statement + CHARACTER(4000) :: Frmt ! a string to hold a format statement INTEGER :: ErrStat2 @@ -1097,9 +1122,9 @@ SUBROUTINE MDIO_OpenOutput( MD_ProgDesc, p, m, InitOut, ErrStat, ErrMsg ) ! calculate number of output entries (excluding time) to write for this Rod - RodNumOuts = 3*(m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(2:9)) & - + (m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(10:11)) & - + m%RodList(I)%N*SUM(m%RodList(I)%OutFlagList(12:18)) + RodNumOuts = 3*(m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(2:24)) & + + (m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(25:26)) & + + m%RodList(I)%N*SUM(m%RodList(I)%OutFlagList(27:51)) if (wordy > 2) PRINT *, RodNumOuts, " output channels" @@ -1170,6 +1195,22 @@ SUBROUTINE MDIO_OpenOutput( MD_ProgDesc, p, m, InitOut, ErrStat, ErrMsg ) WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A15))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'SRt', J=1,(m%RodList(I)%N) ) END IF + IF (m%RodList(I)%OutFlagList(16) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr(3+3*m%RodList(I)%N))//'(A1,A15))', advance='no') & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'ApX', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'ApY', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'ApZ', J=0,m%RodList(I)%N ) + END IF + IF (m%RodList(I)%OutFlagList(17) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr(3+3*m%RodList(I)%N))//'(A1,A15))', advance='no') & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'AqX', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'AqY', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'AqZ', J=0,m%RodList(I)%N ) + END IF + IF (m%RodList(I)%OutFlagList(18) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr(3+3*m%RodList(I)%N))//'(A1,A15))', advance='no') & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'DpX', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'DpY', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'DpZ', J=0,m%RodList(I)%N ) + END IF + IF (m%RodList(I)%OutFlagList(19) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr(3+3*m%RodList(I)%N))//'(A1,A15))', advance='no') & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'DqX', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'DqY', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'DqZ', J=0,m%RodList(I)%N ) + END IF WRITE(m%RodList(I)%RodUnOut,'(A1)', IOSTAT=ErrStat2) ' ' ! make line break at the end @@ -1235,6 +1276,24 @@ SUBROUTINE MDIO_OpenOutput( MD_ProgDesc, p, m, InitOut, ErrStat, ErrMsg ) WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A15))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, '(1/s)', J=1,(m%RodList(I)%N) ) END IF + IF (m%RodList(I)%OutFlagList(16) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr(3+3*m%RodList(I)%N))//'(A1,A15))', advance='no') & + ( p%Delim, '(N)', p%Delim, '(N)', p%Delim, '(N)', J=0,m%RodList(I)%N ) + END IF + IF (m%RodList(I)%OutFlagList(17) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr(3+3*m%RodList(I)%N))//'(A1,A15))', advance='no') & + ( p%Delim, '(N)', p%Delim, '(N)', p%Delim, '(N)', J=0,m%RodList(I)%N ) + END IF + IF (m%RodList(I)%OutFlagList(18) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr(3+3*m%RodList(I)%N))//'(A1,A15))', advance='no') & + ( p%Delim, '(N)', p%Delim, '(N)', p%Delim, '(N)', J=0,m%RodList(I)%N ) + END IF + IF (m%RodList(I)%OutFlagList(19) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr(3+3*m%RodList(I)%N))//'(A1,A15))', advance='no') & + ( p%Delim, '(N)', p%Delim, '(N)', p%Delim, '(N)', J=0,m%RodList(I)%N ) + END IF + + WRITE(m%RodList(I)%RodUnOut,'(A1)', IOSTAT=ErrStat2) ' ' ! make Rod break at the end @@ -1258,22 +1317,20 @@ SUBROUTINE MDIO_CloseOutput ( p, m, ErrStat, ErrMsg ) INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - INTEGER(IntKi) :: I ! generic counter - + INTEGER(IntKi) :: I ! generic counter + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MDIO_CloseOutput' ErrStat = 0 ErrMsg = "" - -!FIXME: make sure thes are actually open before trying to close them. Segfault will occur otherwise!!!! -! This bug can be triggered by an early failure of the parsing routines, before these files were ever opened -! which returns MD to OpenFAST as ErrID_Fatal, then OpenFAST calls MD_End, which calls this. - ! close main MoorDyn output file if (p%MDUnOut > 0) then - CLOSE( p%MDUnOut, IOSTAT = ErrStat ) - IF ( ErrStat /= 0 ) THEN - ErrMsg = 'Error closing output file' + CLOSE( p%MDUnOut, IOSTAT = ErrStat2 ) + p%MDUnOut = -1 + IF ( ErrStat2 /= 0 ) THEN + call SetErrStat(ErrID_Severe,'Error closing output file',ErrStat,ErrMsg,RoutineName) END IF end if @@ -1281,9 +1338,10 @@ SUBROUTINE MDIO_CloseOutput ( p, m, ErrStat, ErrMsg ) DO I=1,p%NRods if (allocated(m%RodList)) then if (m%RodList(I)%RodUnOut > 0) then - CLOSE( m%RodList(I)%RodUnOut, IOSTAT = ErrStat ) - IF ( ErrStat /= 0 ) THEN - ErrMsg = 'Error closing rod output file' + CLOSE( m%RodList(I)%RodUnOut, IOSTAT = ErrStat2 ) + m%RodList(I)%RodUnOut = -1 + IF ( ErrStat2 /= 0 ) THEN + call SetErrStat(ErrID_Severe,'Error closing rod output file',ErrStat,ErrMsg,RoutineName) END IF end if end if @@ -1293,9 +1351,10 @@ SUBROUTINE MDIO_CloseOutput ( p, m, ErrStat, ErrMsg ) DO I=1,p%NLines if (allocated(m%LineList)) then if (m%LineList(I)%LineUnOut > 0) then - CLOSE( m%LineList(I)%LineUnOut, IOSTAT = ErrStat ) - IF ( ErrStat /= 0 ) THEN - ErrMsg = 'Error closing line output file' + CLOSE( m%LineList(I)%LineUnOut, IOSTAT = ErrStat2 ) + m%LineList(I)%LineUnOut = -1 + IF ( ErrStat2 /= 0 ) THEN + call SetErrStat(ErrID_Severe,'Error closing line output file',ErrStat,ErrMsg,RoutineName) END IF end if end if @@ -1328,7 +1387,8 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) INTEGER :: L ! counter for index in LineWrOutput INTEGER :: LineNumOuts ! number of entries in LineWrOutput for each line INTEGER :: RodNumOuts ! same for Rods - CHARACTER(200) :: Frmt ! a string to hold a format statement + CHARACTER(4000) :: Frmt ! a string to hold a format statement + REAL(DbKi) :: VOFsum IF ( .NOT. ALLOCATED( p%OutParam ) .OR. p%MDUnOut < 0 ) THEN @@ -1462,7 +1522,11 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) CASE (MZ) y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%F6net(6) ! total force in z CASE (Sub) - y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%h0 / m%RodList(p%OutParam(I)%ObjID)%UnstrLen ! rod submergence + VOFsum = 0.0_DbKi + do j = 0, m%RodList(p%OutParam(I)%ObjID)%N + VOFsum = VOFsum + m%RodList(p%OutParam(I)%ObjID)%VOF(j) + end do + y%WriteOutput(I) = VOFsum / size(m%RodList(p%OutParam(I)%ObjID)%VOF) ! rod submergence CASE (TenA) y%WriteOutput(I) = sqrt(m%RodList(p%OutParam(I)%ObjID)%FextA(1)**2 + m%RodList(p%OutParam(I)%ObjID)%FextA(2)**2 + m%RodList(p%OutParam(I)%ObjID)%FextA(3)**2)! external forces on end A CASE (TenB) @@ -1763,9 +1827,9 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) IF (m%RodList(I)%OutFlagList(1) == 1) THEN ! only proceed if the line is flagged to output a file ! calculate number of output entries to write for this Rod - RodNumOuts = 3*(m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(2:9)) & - + (m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(10:11)) & - + m%RodList(I)%N*SUM(m%RodList(I)%OutFlagList(12:18)) + RodNumOuts = 3*(m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(2:24)) & + + (m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(25:26)) & + + m%RodList(I)%N*SUM(m%RodList(I)%OutFlagList(27:51)) Frmt = '(F10.4,'//TRIM(Int2LStr(RodNumOuts))//'(A1,ES15.7))' ! should evenutally use user specified format? @@ -1865,6 +1929,46 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) L = L+1 END DO END IF + + ! Node tangential fluid inertial force + IF (m%RodList(I)%OutFlagList(16) == 1) THEN + DO J = 0,m%RodList(I)%N + DO K = 1,3 + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%Ap(K,J) + L = L+1 + END DO + END DO + END IF + + ! Node transverse fluid inertia forc + IF (m%RodList(I)%OutFlagList(17) == 1) THEN + DO J = 0,m%RodList(I)%N + DO K = 1,3 + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%Aq(K,J) + L = L+1 + END DO + END DO + END IF + + ! Node transverse drag forces + IF (m%RodList(I)%OutFlagList(18) == 1) THEN + DO J = 0,m%RodList(I)%N + DO K = 1,3 + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%Dp(K,J) + L = L+1 + END DO + END DO + END IF + + ! Node Tangential drag forces + IF (m%RodList(I)%OutFlagList(19) == 1) THEN + DO J = 0,m%RodList(I)%N + DO K = 1,3 + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%Dq(K,J) + L = L+1 + END DO + END DO + END IF ! ! Node curvatures ! IF (m%RodList(I)%OutFlagList(8) == 1) THEN diff --git a/modules/moordyn/src/MoorDyn_Line.f90 b/modules/moordyn/src/MoorDyn_Line.f90 index 702bae39b2..50e93350bf 100644 --- a/modules/moordyn/src/MoorDyn_Line.f90 +++ b/modules/moordyn/src/MoorDyn_Line.f90 @@ -375,7 +375,7 @@ SUBROUTINE Line_Initialize (Line, LineProp, p, ErrStat, ErrMsg) Line%r(3,J) = Line%r(3,0) + (Line%r(3,N) - Line%r(3,0))*REAL(J, DbKi)/REAL(N, DbKi) END DO - CALL WrScr(' Vertical initial profile for Line '//trim(Num2LStr(Line%IdNum))//'.') + CALL WrScr(' Vertical initial profile for Line '//trim(Num2LStr(Line%IdNum))//'.') ELSE ! If the line is not vertical, solve for the catenary profile @@ -396,9 +396,9 @@ SUBROUTINE Line_Initialize (Line, LineProp, p, ErrStat, ErrMsg) ELSE ! if there is a problem with the catenary approach, just stretch the nodes linearly between fairlead and anchor ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, ' Line_Initialize: Line '//trim(Num2LStr(Line%IdNum))//' ') - CALL WrScr(' Catenary solve of Line '//trim(Num2LStr(Line%IdNum))//' unsuccessful. Initializing as linear.') + CALL WrScr(' Catenary solve of Line '//trim(Num2LStr(Line%IdNum))//' unsuccessful. Initializing as linear.') IF (wordy == 1) THEN - CALL WrScr(' Message from catenary solver: '//ErrMsg2) + CALL WrScr(' Message from catenary solver: '//ErrMsg2) ENDIF DO J = 0,N ! Loop through all nodes per line where the line position and tension can be output @@ -579,7 +579,7 @@ SUBROUTINE Catenary ( XF_In, ZF_In, L_In , EA_In, & IF ( ZF < 0.0 ) THEN ! .TRUE. if the fairlead has passed below its anchor ZF = -ZF reverseFlag = .TRUE. - CALL WrScr(' Warning from catenary: Anchor point is above the fairlead point for Line '//trim(Num2LStr(Line%IdNum))//', consider changing.') + CALL WrScr(' Warning from catenary: Anchor point is above the fairlead point for Line '//trim(Num2LStr(Line%IdNum))//', consider changing.') ELSE reverseFlag = .FALSE. ENDIF @@ -1349,8 +1349,8 @@ SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p, ErrStat, ErrMsg) !, FairFtot, Fai ! >>>> could do similar as above for nonlinear damping or bending stiffness <<<< - if (Line%nBApoints > 0) print *, 'Nonlinear elastic damping not yet implemented' - if (Line%nEIpoints > 0) print *, 'Nonlinear bending stiffness not yet implemented' + if (Line%nBApoints > 0) CALL SetErrStat(ErrID_Warn,'Nonlinear elastic damping not yet implemented',ErrStat,ErrMsg,RoutineName) + if (Line%nEIpoints > 0) CALL SetErrStat(ErrID_Warn,'Nonlinear bending stiffness not yet implemented',ErrStat,ErrMsg,RoutineName) ! basic elasticity model @@ -1375,8 +1375,7 @@ SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p, ErrStat, ErrMsg) !, FairFtot, Fai ! Double check none of the assumptions were violated (this should never happen) IF (Line%alphaMBL <= 0 .OR. Line%vbeta <= 0 .OR. Line%l(I) <= 0 .OR. Line%dl_1(I) <= 0 .OR. EA_D < Line%EA) THEN - ErrStat = ErrID_Warn - ErrMsg = "Viscoelastic model: Assumption for mean load dependent dynamic stiffness violated" + CALL SetErrStat(ErrID_Warn,"Viscoelastic model: Assumption for mean load dependent dynamic stiffness violated",ErrStat,ErrMsg,RoutineName) if (wordy > 2) then print *, "Line%alphaMBL", Line%alphaMBL print *, "Line%vbeta", Line%vbeta @@ -1397,12 +1396,10 @@ SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p, ErrStat, ErrMsg) !, FairFtot, Fai endif if (EA_D == 0.0) then ! Make sure EA != EA_D or else nans, also make sure EA_D != 0 or else nans. - ErrStat = ErrID_Fatal - ErrMsg = "Viscoelastic model: Dynamic stiffness cannot equal zero" + CALL SetErrStat(ErrID_Fatal,"Viscoelastic model: Dynamic stiffness cannot equal zero",ErrStat,ErrMsg,RoutineName) return else if (EA_D == Line%EA) then - ErrStat = ErrID_Fatal - ErrMsg = "Viscoelastic model: Dynamic stiffness cannot equal static stiffness" + CALL SetErrStat(ErrID_Fatal,"Viscoelastic model: Dynamic stiffness cannot equal static stiffness",ErrStat,ErrMsg,RoutineName) return endif diff --git a/modules/moordyn/src/MoorDyn_Misc.f90 b/modules/moordyn/src/MoorDyn_Misc.f90 index 4466718db2..79e557fc9c 100644 --- a/modules/moordyn/src/MoorDyn_Misc.f90 +++ b/modules/moordyn/src/MoorDyn_Misc.f90 @@ -1071,7 +1071,6 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) REAL(SiKi) :: WaveDOmega ! frequency step REAL(SiKi), ALLOCATABLE :: SinWaveDir(:) ! SIN( WaveDirArr(I) ) -- Each wave frequency has a unique wave direction. REAL(SiKi), ALLOCATABLE :: CosWaveDir(:) ! COS( WaveDirArr(I) ) -- Each wave frequency has a unique wave direction. - LOGICAL :: WaveMultiDir = .FALSE. ! Indicates the waves are multidirectional -- set by WaveField pointer if enabled REAL(SiKi), ALLOCATABLE :: TmpFFTWaveElev(:) ! Data for the FFT calculation TYPE(FFT_DataType) :: FFT_Data ! the instance of the FFT module we're using @@ -1083,7 +1082,6 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) COMPLEX(SiKi), PARAMETER :: ImagNmbr = (0.0,1.0) ! The imaginary number, SQRT(-1.0) COMPLEX(SiKi) :: ImagOmega ! = ImagNmbr*Omega (rad/s) REAL(DbKi), ALLOCATABLE :: WaveNmbr(:) ! wave number for frequency array - REAL(SiKi), ALLOCATABLE :: WaveDirArr(:) ! Wave direction array. Each frequency has a unique direction of WaveNDir > 1 (degrees). 0's for WaveKin = 1 or if disabled in SeaState. REAL(SiKi), ALLOCATABLE :: WaveElevC0(:,:) ! Discrete Fourier transform of the instantaneous elevation of incident waves at the ref point (meters) COMPLEX(SiKi), ALLOCATABLE :: WaveElevC( :) ! Discrete Fourier transform of the instantaneous elevation of incident waves at the ref point (meters) COMPLEX(SiKi), ALLOCATABLE :: WaveAccCHx(:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) @@ -1160,7 +1158,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) END IF ! Check for if SeaState grid does not match water depth - IF (p%WaveField%GridParams%Z_Depth /= p%WtrDpth) THEN + IF (p%WaveField%GridDepth /= p%WtrDpth) THEN IF (p%writeLog > 0) THEN WRITE(p%UnLog, '(A)' ) " INFO SeaState grid depth does not match MoorDyn water depth." ENDIF @@ -1412,7 +1410,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) END IF ! Warning check to make sure SeaState and MoorDyn have the same wave dir. For now, no wave spreading. This can be updated - IF (p%WaveField%WaveDir /= WaveDir) THEN + IF (p%WaveField%WaveDir /= WaveDir) THEN !bjj: the local WaveDir doesn't appear to be used when WaveKin = 2 and p%WaveField%WaveDirArr is true, so I don't think this error message is completely valid. IF (p%writeLog > 0) THEN WRITE(p%UnLog, '(A)' ) " WARNING SeaState WaveDir does not match MoorDyn WaveDir. Using MoorDyn values for interpolating SeaState data to MoorDyn grid." ENDIF @@ -1422,7 +1420,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) ! Info check for if MoorDyn dtWave is non-zero. Users may set this accidentially, or could be left over in an input file IF (p%dtWave > 0) THEN IF (p%writeLog > 0) THEN - WRITE(p%UnLog, '(A)' ) " MoorDyn dtWave is ignored when using WaveKinMod = 2 becasue wave frequency information is supplied by SeaState" + WRITE(p%UnLog, '(A)' ) " MoorDyn dtWave is ignored when using WaveKinMod = 2 because wave frequency information is supplied by SeaState" ENDIF END IF @@ -1445,15 +1443,8 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) NStepWave = p%WaveField%NStepWave ! Pull some other things out of the WaveField pointer - WaveMultiDir = p%WaveField%WaveMultiDir p%ntWave = NStepWave ! set ntWave to NStepWave - ! Set wave spreading array if enabled in SeaState, otherwise set to zero - If (WaveMultiDir) THEN - ! Note: allocations not needed here because they are already allocated in SeaState - WaveDirArr = p%WaveField%WaveDirArr - ENDIF - ELSEIF (p%WaveKin == 1) THEN ! must be a filepath therefore read wave elevations from timeseries ! NOTE: there is a decent ammount of code duplication (intentional for now) with what is in SeaState that eventually @@ -1659,9 +1650,9 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) ALLOCATE ( SinWaveDir(0:NStepWave2), STAT=ErrStat2); ErrMsg2 = 'Cannot allocate SinWaveDir.'; IF (Failed0()) RETURN ! Set the CosWaveDir and SinWaveDir values. - IF (WaveMultiDir) THEN ! This is only possible with WaveKinMod = 2 - CosWaveDir=COS(D2R*WaveDirArr) - SinWaveDir=SIN(D2R*WaveDirArr) + IF (p%WaveKin == 2 .and. p%WaveField%WaveMultiDir) THEN ! This is only possible with WaveKinMod = 2 + CosWaveDir=COS(D2R*p%WaveField%WaveDirArr) + SinWaveDir=SIN(D2R*p%WaveField%WaveDirArr) ELSE CosWaveDir=COS(D2R*WaveDir) SinWaveDir=SIN(D2R*WaveDir) diff --git a/modules/moordyn/src/MoorDyn_Point.f90 b/modules/moordyn/src/MoorDyn_Point.f90 index af320e528e..b64a5efb70 100644 --- a/modules/moordyn/src/MoorDyn_Point.f90 +++ b/modules/moordyn/src/MoorDyn_Point.f90 @@ -359,11 +359,13 @@ END SUBROUTINE Point_GetNetForceAndMass ! this function handles assigning a line to a connection node !-------------------------------------------------------------- - SUBROUTINE Point_AddLine(Point, lineID, TopOfLine) + SUBROUTINE Point_AddLine(Point, lineID, TopOfLine, ErrStat, ErrMsg) Type(MD_Point), INTENT (INOUT) :: Point ! the Point object Integer(IntKi), INTENT( IN ) :: lineID Integer(IntKi), INTENT( IN ) :: TopOfLine + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen),intent( out) :: ErrMsg IF (wordy > 0) Print*, "L", lineID, "->C", Point%IdNum @@ -371,7 +373,10 @@ SUBROUTINE Point_AddLine(Point, lineID, TopOfLine) Point%nAttached = Point%nAttached + 1 ! add the line to the number connected Point%Attached(Point%nAttached) = lineID Point%Top(Point%nAttached) = TopOfLine ! attached to line ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) + ErrStat = ErrID_None + ErrMsg = '' ELSE + ErrStat = ErrID_Fatal call WrScr("Too many lines connected to Point "//trim(num2lstr(Point%IdNum))//" in MoorDyn!") END IF diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index ec5177d6de..1d2d3a9670 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -16,6 +16,13 @@ include Registry_NWTC_Library.txt usefrom SeaSt_WaveField.txt + +## ====== parameters ======= +param MoorDyn/MD - IntKi MD_MaxNCoef - 30 - "maximum number of entries to allow in nonlinear coefficient lookup tables" - +param MoorDyn/MD - IntKi MD_MaxBdAtch - 100 - "maximum number of attachments to a body" - +param MoorDyn/MD - IntKi MD_MaxPtAtch - 100 - "maximum number of attachments to a point" - +param MoorDyn/MD - IntKi MD_MaxFailLines - 30 - "maximum number of line failures that can be simulated" - + ## ====== some data read from the input file, but not needed after init ====== typedef MoorDyn/MD MD_InputFileType DbKi DTIC - 0.5 - "convergence check time step for IC generation" "[s]" typedef ^ ^ DbKi TMaxIC - 120 - "maximum time to allow for getting converged ICs" "[s]" @@ -68,14 +75,14 @@ typedef ^ ^ DbKi dF - typedef ^ ^ DbKi cF - - - "Center VIV synchronization in non-dimensional frequency" typedef ^ ^ IntKi ElasticMod - - - "Which elasticity model to use: {1 basic, 2 viscoelastic, 3 viscoelastic+meanload} " - typedef ^ ^ IntKi nEApoints - - - "number of values in stress-strain lookup table (0 means using constant E)" -typedef ^ ^ DbKi stiffXs {30} - - "x array for stress-strain lookup table (up to nCoef)" -typedef ^ ^ DbKi stiffYs {30} - - "y array for stress-strain lookup table" +typedef ^ ^ DbKi stiffXs {MD_MaxNCoef} - - "x array for stress-strain lookup table (up to MD_MaxNCoef)" +typedef ^ ^ DbKi stiffYs {MD_MaxNCoef} - - "y array for stress-strain lookup table" typedef ^ ^ IntKi nBApoints - - - "number of values in stress-strainrate lookup table (0 means using constant c)" -typedef ^ ^ DbKi dampXs {30} - - "x array for stress-strainrate lookup table (up to nCoef)" -typedef ^ ^ DbKi dampYs {30} - - "y array for stress-strainrate lookup table" +typedef ^ ^ DbKi dampXs {MD_MaxNCoef} - - "x array for stress-strainrate lookup table (up to MD_MaxNCoef)" +typedef ^ ^ DbKi dampYs {MD_MaxNCoef} - - "y array for stress-strainrate lookup table" typedef ^ ^ IntKi nEIpoints - - - "number of values in bending stress-strain lookup table (0 means using constant E)" -typedef ^ ^ DbKi bstiffXs {30} - - "x array for stress-strain lookup table (up to nCoef)" -typedef ^ ^ DbKi bstiffYs {30} - - "y array for stress-strain lookup table" +typedef ^ ^ DbKi bstiffXs {MD_MaxNCoef} - - "x array for stress-strain lookup table (up to MD_MaxNCoef)" +typedef ^ ^ DbKi bstiffYs {MD_MaxNCoef} - - "y array for stress-strain lookup table" # rod properties from rod dictionary input typedef ^ MD_RodProp IntKi IdNum - - - "integer identifier of this set of rod properties" @@ -92,12 +99,12 @@ typedef ^ ^ DbKi CaEnd - # this is the Body type, which holds data for each body object typedef ^ MD_Body IntKi IdNum - - - "integer identifier of this Point" typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 0=free, 1=fixed, -1=coupled, 2=coupledpinned" -typedef ^ ^ IntKi AttachedC {30} - - "list of IdNums of points attached to this body" -typedef ^ ^ IntKi AttachedR {30} - - "list of IdNums of rods attached to this body" +typedef ^ ^ IntKi AttachedC {MD_MaxBdAtch} - - "list of IdNums of points attached to this body" +typedef ^ ^ IntKi AttachedR {MD_MaxBdAtch} - - "list of IdNums of rods attached to this body" typedef ^ ^ IntKi nAttachedP - - - "number of attached points" typedef ^ ^ IntKi nAttachedR - - - "number of attached rods" -typedef ^ ^ DbKi rPointRel {3}{30} - - "relative position of point on body" -typedef ^ ^ DbKi r6RodRel {6}{30} - - "relative position and orientation of rod on body" +typedef ^ ^ DbKi rPointRel {3}{MD_MaxBdAtch} - - "relative position of point on body" +typedef ^ ^ DbKi r6RodRel {6}{MD_MaxBdAtch} - - "relative position and orientation of rod on body" typedef ^ ^ DbKi bodyM - - - "body mass (separate from attached objects)" "[kg]" typedef ^ ^ DbKi bodyV - - - "body volume (for buoyancy calculation)" "[m^3]" typedef ^ ^ DbKi bodyI {3} - - "body 3x3 inertia matrix diagonals" "[kg-m^2]" @@ -127,8 +134,8 @@ typedef ^ ^ DbKi BquadL {3} typedef ^ MD_Point IntKi IdNum - - - "integer identifier of this point" typedef ^ ^ CHARACTER(10) type - - - "type of point: fix, vessel, point" typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 1=fixed, -1=coupled, 0=free" -typedef ^ ^ IntKi Attached {10} - - "list of IdNums of lines attached to this point node" -typedef ^ ^ IntKi Top {10} - - "list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" +typedef ^ ^ IntKi Attached {MD_MaxPtAtch} - - "list of IdNums of lines attached to this point node" +typedef ^ ^ IntKi Top {MD_MaxPtAtch} - - "list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" typedef ^ ^ IntKi nAttached - - - "number of attached lines" typedef ^ ^ DbKi pointM - - - "point mass" "[kg]" typedef ^ ^ DbKi pointV - - - "point volume" "[m^3]" @@ -156,13 +163,13 @@ typedef ^ MD_Rod IntKi IdNum - typedef ^ ^ CHARACTER(10) type - - - "type of Rod. should match one of RodProp names" typedef ^ ^ IntKi PropsIdNum - - - "the IdNum of the associated rod properties" - typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 0=free, 1=pinned, 2=fixed, -1=coupledpinned, -2=coupled" -typedef ^ ^ IntKi AttachedA {10} - - "list of IdNums of lines attached to end A" -typedef ^ ^ IntKi AttachedB {10} - - "list of IdNums of lines attached to end B" -typedef ^ ^ IntKi TopA {10} - - "list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" -typedef ^ ^ IntKi TopB {10} - - "list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" +typedef ^ ^ IntKi AttachedA {MD_MaxPtAtch} - - "list of IdNums of lines attached to end A" +typedef ^ ^ IntKi AttachedB {MD_MaxPtAtch} - - "list of IdNums of lines attached to end B" +typedef ^ ^ IntKi TopA {MD_MaxPtAtch} - - "list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" +typedef ^ ^ IntKi TopB {MD_MaxPtAtch} - - "list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" typedef ^ ^ IntKi nAttachedA - - - "number of attached lines to Rod end A" typedef ^ ^ IntKi nAttachedB - - - "number of attached lines to Rod end B" -typedef ^ ^ IntKi OutFlagList {20} - - "array specifying what line quantities should be output (1 vs 0)" - +typedef ^ ^ IntKi OutFlagList {55} - - "array specifying what line quantities should be output (1 vs 0)" - typedef ^ ^ IntKi N - - - "The number of elements in the line" - typedef ^ ^ IntKi endTypeA - - - "type of point at end A: 0=pinned to Point, 1=cantilevered to Rod." - typedef ^ ^ IntKi endTypeB - - - "type of point at end B: 0=pinned to Point, 1=cantilevered to Rod." - @@ -216,7 +223,7 @@ typedef ^ ^ DbKi RodWrOutput {:} typedef ^ ^ DbKi FextU {3} - - "vector of user-defined external force on the rod end A always in the local body-fixed frame" "[N]" typedef ^ ^ DbKi Blin {2} - - "linear damping, transverse damping for rod element always in the local body-fixed frame" "[N/(m/s)]" typedef ^ ^ DbKi Bquad {2} - - "quadratic damping, transverse damping for rod element always in the local body-fixed frame" "[N/(m/s)^2]" - +typedef ^ ^ DbKi VOF {:} - - "Node-based volume-of-fluid for submergence" # this is the Line type, which holds data for each line object @@ -249,14 +256,14 @@ typedef ^ ^ DbKi Cl - typedef ^ ^ DbKi dF - - - "+- range of VIV synchronization in non-dimensional frequency" typedef ^ ^ DbKi cF - - - "Center VIV synchronization in non-dimensional frequency" typedef ^ ^ IntKi nEApoints - - - "number of values in stress-strain lookup table (0 means using constant E)" -typedef ^ ^ DbKi stiffXs {30} - - "x array for stress-strain lookup table (up to nCoef)" -typedef ^ ^ DbKi stiffYs {30} - - "y array for stress-strain lookup table" +typedef ^ ^ DbKi stiffXs {MD_MaxNCoef} - - "x array for stress-strain lookup table (up to MD_MaxNCoef)" +typedef ^ ^ DbKi stiffYs {MD_MaxNCoef} - - "y array for stress-strain lookup table" typedef ^ ^ IntKi nBApoints - - - "number of values in stress-strainrate lookup table (0 means using constant c)" -typedef ^ ^ DbKi dampXs {30} - - "x array for stress-strainrate lookup table (up to nCoef)" -typedef ^ ^ DbKi dampYs {30} - - "y array for stress-strainrate lookup table" +typedef ^ ^ DbKi dampXs {MD_MaxNCoef} - - "x array for stress-strainrate lookup table (up to MD_MaxNCoef)" +typedef ^ ^ DbKi dampYs {MD_MaxNCoef} - - "y array for stress-strainrate lookup table" typedef ^ ^ IntKi nEIpoints - - - "number of values in bending stress-strain lookup table (0 means using constant E)" -typedef ^ ^ DbKi bstiffXs {30} - - "x array for stress-strain lookup table (up to nCoef)" -typedef ^ ^ DbKi bstiffYs {30} - - "y array for stress-strain lookup table" +typedef ^ ^ DbKi bstiffXs {MD_MaxNCoef} - - "x array for stress-strain lookup table (up to MD_MaxNCoef)" +typedef ^ ^ DbKi bstiffYs {MD_MaxNCoef} - - "y array for stress-strain lookup table" typedef ^ ^ DbKi time - - - "current time" "[s]" typedef ^ ^ DbKi r {:}{:} - - "node positions" - typedef ^ ^ DbKi rd {:}{:} - - "node velocities" - @@ -312,8 +319,8 @@ typedef ^ ^ LOGICAL isGlobal - typedef ^ MD_Fail IntKi IdNum - - - "integer identifier of this failure" "-" typedef ^ ^ IntKi attachID - - - "ID of connection or Rod the lines are attached to" "-" typedef ^ ^ IntKi isRod - - - "1 Rod end A, 2 Rod end B, 0 if point" "-" -typedef ^ ^ IntKi lineIDs {30} - - "array of one or more lines to detach (starting from 1...)" "-" -typedef ^ ^ IntKi lineTops {30} - - "an array that will be FILLED IN to return which end of each line was disconnected ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" "-" +typedef ^ ^ IntKi lineIDs {MD_MaxFailLines} - - "array of one or more lines to detach (starting from 1...)" "-" +typedef ^ ^ IntKi lineTops {MD_MaxFailLines} - - "an array that will be FILLED IN to return which end of each line was disconnected ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" "-" typedef ^ ^ IntKi nLinesToDetach - - - "how many lines to dettach" "-" typedef ^ ^ DbKi failTime - - - "time of failure" "s" typedef ^ ^ DbKi failTen - - - "tension threshold of failure" "N" @@ -397,7 +404,7 @@ typedef ^ ^ DbKi BathymetryGrid {:}{:} typedef ^ ^ DbKi BathGrid_Xs {:} - - "array of x-coordinates in the bathymetry grid" typedef ^ ^ DbKi BathGrid_Ys {:} - - "array of y-coordinates in the bathymetry grid" typedef ^ ^ IntKi BathGrid_npoints {:} - - "number of grid points to describe the bathymetry grid" -typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - +typedef ^ ^ GridInterp_MiscVarType WaveField_m - - - "misc var information from the Grid Interpolation module" - typedef ^ ^ LOGICAL IC_gen - .FALSE. - "boolean to indicate dynamic relaxation occuring" "-" diff --git a/modules/moordyn/src/MoorDyn_Rod.f90 b/modules/moordyn/src/MoorDyn_Rod.f90 index 33e29e2c24..34b2eb9339 100644 --- a/modules/moordyn/src/MoorDyn_Rod.f90 +++ b/modules/moordyn/src/MoorDyn_Rod.f90 @@ -105,12 +105,14 @@ SUBROUTINE Rod_Setup(Rod, RodProp, endCoords, p, ErrStat, ErrMsg) ! allocate mass and inverse mass matrices for each node (including ends) ALLOCATE(Rod%M(3, 3, 0:N), STAT=ErrStat2); if(AllocateFailed("Rod: M")) return + ALLOCATE(Rod%VOF(0:N), STAT=ErrStat2) ! allocate VOF array (volume of fluid) for each node ! set to zero initially (important of wave kinematics are not being used) Rod%U = 0.0_DbKi Rod%Ud = 0.0_DbKi Rod%zeta = 0.0_DbKi Rod%PDyn = 0.0_DbKi + Rod%VOF = 0.0_DbKi ! ------------------------- set some geometric properties and the starting kinematics ------------------------- @@ -208,12 +210,12 @@ SUBROUTINE Rod_Initialize(Rod, states, m) states(1:3) = 0.0_DbKi ! zero velocities for initialization states(4:6) = Rod%q ! rod direction unit vector - - end if + end if + ! note: this may also be called by a coupled rod (type = -1) in which case states will be empty - + END SUBROUTINE Rod_Initialize !-------------------------------------------------------------- @@ -708,17 +710,16 @@ SUBROUTINE Rod_DoRHS(Rod, m, p) zA = Rod%r(3,I) - 0.6666666666 * Rod%d* (sin(al))**3 / (2.0*al - sin(2.0*al)) end if end if - - VOF = VOF0*cosPhi**2 + A/(0.25*Pi*Rod%d**2)*sinPhi**2 ! this is a more refined VOF-type measure that can work for any incline + Rod%VOF(I) = VOF0*cosPhi**2 + A/(0.25*Pi*Rod%d**2)*sinPhi**2 ! this is a more refined VOF-type measure that can work for any incline ! build mass and added mass matrix DO J=1,3 DO K=1,3 IF (J==K) THEN - Rod%M(K,J,I) = m_i + VOF*p%rhoW*v_i*( Rod%Can*(1 - Rod%q(J)*Rod%q(K)) + Rod%Cat*Rod%q(J)*Rod%q(K) ) + Rod%M(K,J,I) = m_i + Rod%VOF(I)*p%rhoW*v_i*( Rod%Can*(1 - Rod%q(J)*Rod%q(K)) + Rod%Cat*Rod%q(J)*Rod%q(K) ) ELSE - Rod%M(K,J,I) = VOF*p%rhoW*v_i*( Rod%Can*(-Rod%q(J)*Rod%q(K)) + Rod%Cat*Rod%q(J)*Rod%q(K) ) + Rod%M(K,J,I) = Rod%VOF(I)*p%rhoW*v_i*( Rod%Can*(-Rod%q(J)*Rod%q(K)) + Rod%Cat*Rod%q(J)*Rod%q(K) ) END IF END DO END DO @@ -739,7 +740,7 @@ SUBROUTINE Rod_DoRHS(Rod, m, p) Rod%W(:,I) = (/ 0.0_DbKi, 0.0_DbKi, -m_i * p%g /) ! assuming g is positive ! radial buoyancy force from sides (now calculated based on outside pressure, for submerged portion only) - Ftemp = -VOF * v_i * p%rhoW*p%g * sinPhi ! magnitude of radial buoyancy force at this node + Ftemp = -Rod%VOF(I) * v_i * p%rhoW*p%g * sinPhi ! magnitude of radial buoyancy force at this node Rod%Bo(:,I) = (/ Ftemp*cosBeta*cosPhi, Ftemp*sinBeta*cosPhi, -Ftemp*sinPhi /) !relative flow velocities @@ -766,7 +767,7 @@ SUBROUTINE Rod_DoRHS(Rod, m, p) MagVq = sqrt(SumSqVq) ! transverse and tangenential drag - Rod%Dp(:,I) = VOF * 0.5*p%rhoW*Rod%Cdn* Rod%d* dL * MagVp * Vp + Rod%Dp(:,I) = Rod%VOF(I) * 0.5*p%rhoW*Rod%Cdn* Rod%d* dL * MagVp * Vp Rod%Dq(:,I) = 0.0_DbKi ! 0.25*p%rhoW*Rod%Cdt* Pi*Rod%d* dL * MagVq * Vq <<< should these axial side loads be included? ! transverse and tangential damping force (note this is the force per node) @@ -779,7 +780,7 @@ SUBROUTINE Rod_DoRHS(Rod, m, p) aq = DOT_PRODUCT(Rod%Ud(:,I), Rod%q) * Rod%q ! tangential component of fluid acceleration ap = Rod%Ud(:,I) - aq ! normal component of fluid acceleration ! transverse and axial fluid inertia force - Rod%Ap(:,I) = VOF * p%rhoW*(1.0+Rod%Can)* v_i * ap ! + Rod%Ap(:,I) = Rod%VOF(I) * p%rhoW*(1.0+Rod%Can)* v_i * ap ! Rod%Aq(:,I) = 0.0_DbKi ! p%rhoW*(1.0+Rod%Cat)* v_i * aq ! <<< just put a taper-based term here eventually? ! dynamic pressure @@ -823,28 +824,28 @@ SUBROUTINE Rod_DoRHS(Rod, m, p) ! >>> eventually should consider a VOF approach for the ends hTilt = 0.5*Rod%d/cosPhi <<< ! buoyancy force - Ftemp = -VOF * 0.25*Pi*Rod%d*Rod%d * p%rhoW*p%g* zA + Ftemp = -Rod%VOF(I) * 0.25*Pi*Rod%d*Rod%d * p%rhoW*p%g* zA Rod%Bo(:,I) = Rod%Bo(:,I) + (/ Ftemp*cosBeta*sinPhi, Ftemp*sinBeta*sinPhi, Ftemp*cosPhi /) ! buoyancy moment - Mtemp = -VOF * 1.0/64.0*Pi*Rod%d**4 * p%rhoW*p%g * sinPhi + Mtemp = -Rod%VOF(I) * 1.0/64.0*Pi*Rod%d**4 * p%rhoW*p%g * sinPhi Rod%Mext = Rod%Mext + (/ Mtemp*sinBeta, -Mtemp*cosBeta, 0.0_DbKi /) ! axial drag - Rod%Dq(:,I) = Rod%Dq(:,I) + 0.5 * VOF * 0.25* Pi*Rod%d*Rod%d * p%rhoW*Rod%CdEnd * MagVq * Vq + Rod%Dq(:,I) = Rod%Dq(:,I) + 0.5 * Rod%VOF(I) * 0.25* Pi*Rod%d*Rod%d * p%rhoW*Rod%CdEnd * MagVq * Vq ! >>> what about rotational drag?? <<< eqn will be Pi* Rod%d**4/16.0 omega_rel?^2... *0.5 * Cd... ! long-wave diffraction force - Rod%Aq(:,I) = Rod%Aq(:,I) + VOF * p%rhoW* Rod%CaEnd * (2.0/3.0*Pi*Rod%d**3 /8.0) * aq + Rod%Aq(:,I) = Rod%Aq(:,I) + Rod%VOF(I) * p%rhoW* Rod%CaEnd * (2.0/3.0*Pi*Rod%d**3 /8.0) * aq ! Froude-Krylov force - Rod%Pd(:,I) = Rod%Pd(:,I) + VOF * 0.25* Pi*Rod%d*Rod%d * Rod%PDyn(I) * Rod%q + Rod%Pd(:,I) = Rod%Pd(:,I) + Rod%VOF(I) * 0.25* Pi*Rod%d*Rod%d * Rod%PDyn(I) * Rod%q ! added mass DO J=1,3 DO K=1,3 - Rod%M(K,J,I) = Rod%M(K,J,I) + VOF*p%rhoW* Rod%CaEnd* (2.0/3.0*Pi*Rod%d**3 /8.0) *Rod%q(J)*Rod%q(K) + Rod%M(K,J,I) = Rod%M(K,J,I) + Rod%VOF(I)*p%rhoW* Rod%CaEnd* (2.0/3.0*Pi*Rod%d**3 /8.0) *Rod%q(J)*Rod%q(K) END DO END DO @@ -853,26 +854,26 @@ SUBROUTINE Rod_DoRHS(Rod, m, p) IF ((I==N) .and. (z1lo < Rod%zeta(I))) THEN ! if this end B and it is at least partially submerged (note, if N=0, both this and previous if statement are true) ! buoyancy force - Ftemp = VOF * 0.25*Pi*Rod%d*Rod%d * p%rhoW*p%g* zA + Ftemp = Rod%VOF(I) * 0.25*Pi*Rod%d*Rod%d * p%rhoW*p%g* zA Rod%Bo(:,I) = Rod%Bo(:,I) + (/ Ftemp*cosBeta*sinPhi, Ftemp*sinBeta*sinPhi, Ftemp*cosPhi /) ! buoyancy moment - Mtemp = VOF * 1.0/64.0*Pi*Rod%d**4 * p%rhoW*p%g * sinPhi + Mtemp = Rod%VOF(I) * 1.0/64.0*Pi*Rod%d**4 * p%rhoW*p%g * sinPhi Rod%Mext = Rod%Mext + (/ Mtemp*sinBeta, -Mtemp*cosBeta, 0.0_DbKi /) ! axial drag - Rod%Dq(:,I) = Rod%Dq(:,I) + 0.5 * VOF * 0.25* Pi*Rod%d*Rod%d * p%rhoW*Rod%CdEnd * MagVq * Vq + Rod%Dq(:,I) = Rod%Dq(:,I) + 0.5 * Rod%VOF(I) * 0.25* Pi*Rod%d*Rod%d * p%rhoW*Rod%CdEnd * MagVq * Vq ! long-wave diffraction force - Rod%Aq(:,I) = Rod%Aq(:,I) + VOF * p%rhoW* Rod%CaEnd * (2.0/3.0*Pi*Rod%d**3 /8.0) * aq + Rod%Aq(:,I) = Rod%Aq(:,I) + Rod%VOF(I) * p%rhoW* Rod%CaEnd * (2.0/3.0*Pi*Rod%d**3 /8.0) * aq ! Froud-Krylov force - Rod%Pd(:,I) = Rod%Pd(:,I) - VOF * 0.25* Pi*Rod%d*Rod%d * Rod%PDyn(I) * Rod%q + Rod%Pd(:,I) = Rod%Pd(:,I) - Rod%VOF(I) * 0.25* Pi*Rod%d*Rod%d * Rod%PDyn(I) * Rod%q ! added mass DO J=1,3 DO K=1,3 - Rod%M(K,J,I) = Rod%M(K,J,I) + VOF*p%rhoW* Rod%CaEnd* (2.0/3.0*Pi*Rod%d**3 /8.0) *Rod%q(J)*Rod%q(K) + Rod%M(K,J,I) = Rod%M(K,J,I) + Rod%VOF(I)*p%rhoW* Rod%CaEnd* (2.0/3.0*Pi*Rod%d**3 /8.0) *Rod%q(J)*Rod%q(K) END DO END DO @@ -1147,13 +1148,15 @@ END SUBROUTINE Rod_GetNetForceAndMass ! this function handles assigning a line to a point node - SUBROUTINE Rod_AddLine(Rod, lineID, TopOfLine, endB) + SUBROUTINE Rod_AddLine(Rod, lineID, TopOfLine, endB, ErrStat, ErrMsg) Type(MD_Rod), INTENT (INOUT) :: Rod ! the Point object Integer(IntKi), INTENT( IN ) :: lineID Integer(IntKi), INTENT( IN ) :: TopOfLine Integer(IntKi), INTENT( IN ) :: endB ! add line to end B if 1, end A if 0 + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen),intent( out) :: ErrMsg if (endB==1) then ! attaching to end B @@ -1163,8 +1166,11 @@ SUBROUTINE Rod_AddLine(Rod, lineID, TopOfLine, endB) Rod%nAttachedB = Rod%nAttachedB + 1 ! add the line to the number connected Rod%AttachedB(Rod%nAttachedB) = lineID Rod%TopB(Rod%nAttachedB) = TopOfLine ! attached to line ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) + ErrStat = ErrID_None + ErrMsg = "" ELSE - call WrScr("too many lines connected to Rod "//trim(num2lstr(Rod%IdNum))//" in MoorDyn!") + ErrStat = ErrID_Fatal + ErrMsg = "too many lines connected to Rod "//trim(num2lstr(Rod%IdNum))//" in MoorDyn!" END IF else ! attaching to end A @@ -1175,8 +1181,11 @@ SUBROUTINE Rod_AddLine(Rod, lineID, TopOfLine, endB) Rod%nAttachedA = Rod%nAttachedA + 1 ! add the line to the number connected Rod%AttachedA(Rod%nAttachedA) = lineID Rod%TopA(Rod%nAttachedA) = TopOfLine ! attached to line ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) + ErrStat = ErrID_None + ErrMsg = "" ELSE - call WrScr("too many lines connected to Rod "//trim(num2lstr(Rod%IdNum))//" in MoorDyn!") + ErrStat = ErrID_Fatal + ErrMsg = "too many lines connected to Rod "//trim(num2lstr(Rod%IdNum))//" in MoorDyn!" END IF end if diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 2175d3bc12..dfd52a4962 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -34,6 +34,10 @@ MODULE MoorDyn_Types USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: MD_MaxNCoef = 30 ! maximum number of entries to allow in nonlinear coefficient lookup tables [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MD_MaxBdAtch = 100 ! maximum number of attachments to a body [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MD_MaxPtAtch = 100 ! maximum number of attachments to a point [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MD_MaxFailLines = 30 ! maximum number of line failures that can be simulated [-] ! ========= MD_InputFileType ======= TYPE, PUBLIC :: MD_InputFileType REAL(DbKi) :: DTIC = 0.5 !< convergence check time step for IC generation [[s]] @@ -84,14 +88,14 @@ MODULE MoorDyn_Types REAL(DbKi) :: cF = 0.0_R8Ki !< Center VIV synchronization in non-dimensional frequency [-] INTEGER(IntKi) :: ElasticMod = 0_IntKi !< Which elasticity model to use: {1 basic, 2 viscoelastic, 3 viscoelastic+meanload} [-] INTEGER(IntKi) :: nEApoints = 0_IntKi !< number of values in stress-strain lookup table (0 means using constant E) [-] - REAL(DbKi) , DIMENSION(1:30) :: stiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: stiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] + REAL(DbKi) , DIMENSION(1:MD_MaxNCoef) :: stiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to MD_MaxNCoef) [-] + REAL(DbKi) , DIMENSION(1:MD_MaxNCoef) :: stiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] INTEGER(IntKi) :: nBApoints = 0_IntKi !< number of values in stress-strainrate lookup table (0 means using constant c) [-] - REAL(DbKi) , DIMENSION(1:30) :: dampXs = 0.0_R8Ki !< x array for stress-strainrate lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: dampYs = 0.0_R8Ki !< y array for stress-strainrate lookup table [-] + REAL(DbKi) , DIMENSION(1:MD_MaxNCoef) :: dampXs = 0.0_R8Ki !< x array for stress-strainrate lookup table (up to MD_MaxNCoef) [-] + REAL(DbKi) , DIMENSION(1:MD_MaxNCoef) :: dampYs = 0.0_R8Ki !< y array for stress-strainrate lookup table [-] INTEGER(IntKi) :: nEIpoints = 0_IntKi !< number of values in bending stress-strain lookup table (0 means using constant E) [-] - REAL(DbKi) , DIMENSION(1:30) :: bstiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: bstiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] + REAL(DbKi) , DIMENSION(1:MD_MaxNCoef) :: bstiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to MD_MaxNCoef) [-] + REAL(DbKi) , DIMENSION(1:MD_MaxNCoef) :: bstiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] END TYPE MD_LineProp ! ======================= ! ========= MD_RodProp ======= @@ -112,12 +116,12 @@ MODULE MoorDyn_Types TYPE, PUBLIC :: MD_Body INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this Point [-] INTEGER(IntKi) :: typeNum = 0_IntKi !< integer identifying the type. 0=free, 1=fixed, -1=coupled, 2=coupledpinned [-] - INTEGER(IntKi) , DIMENSION(1:30) :: AttachedC = 0_IntKi !< list of IdNums of points attached to this body [-] - INTEGER(IntKi) , DIMENSION(1:30) :: AttachedR = 0_IntKi !< list of IdNums of rods attached to this body [-] + INTEGER(IntKi) , DIMENSION(1:MD_MaxBdAtch) :: AttachedC = 0_IntKi !< list of IdNums of points attached to this body [-] + INTEGER(IntKi) , DIMENSION(1:MD_MaxBdAtch) :: AttachedR = 0_IntKi !< list of IdNums of rods attached to this body [-] INTEGER(IntKi) :: nAttachedP = 0_IntKi !< number of attached points [-] INTEGER(IntKi) :: nAttachedR = 0_IntKi !< number of attached rods [-] - REAL(DbKi) , DIMENSION(1:3,1:30) :: rPointRel = 0.0_R8Ki !< relative position of point on body [-] - REAL(DbKi) , DIMENSION(1:6,1:30) :: r6RodRel = 0.0_R8Ki !< relative position and orientation of rod on body [-] + REAL(DbKi) , DIMENSION(1:3,1:MD_MaxBdAtch) :: rPointRel = 0.0_R8Ki !< relative position of point on body [-] + REAL(DbKi) , DIMENSION(1:6,1:MD_MaxBdAtch) :: r6RodRel = 0.0_R8Ki !< relative position and orientation of rod on body [-] REAL(DbKi) :: bodyM = 0.0_R8Ki !< body mass (separate from attached objects) [[kg]] REAL(DbKi) :: bodyV = 0.0_R8Ki !< body volume (for buoyancy calculation) [[m^3]] REAL(DbKi) , DIMENSION(1:3) :: bodyI = 0.0_R8Ki !< body 3x3 inertia matrix diagonals [[kg-m^2]] @@ -149,8 +153,8 @@ MODULE MoorDyn_Types INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this point [-] CHARACTER(10) :: type !< type of point: fix, vessel, point [-] INTEGER(IntKi) :: typeNum = 0_IntKi !< integer identifying the type. 1=fixed, -1=coupled, 0=free [-] - INTEGER(IntKi) , DIMENSION(1:10) :: Attached = 0_IntKi !< list of IdNums of lines attached to this point node [-] - INTEGER(IntKi) , DIMENSION(1:10) :: Top = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) , DIMENSION(1:MD_MaxPtAtch) :: Attached = 0_IntKi !< list of IdNums of lines attached to this point node [-] + INTEGER(IntKi) , DIMENSION(1:MD_MaxPtAtch) :: Top = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] INTEGER(IntKi) :: nAttached = 0_IntKi !< number of attached lines [-] REAL(DbKi) :: pointM = 0.0_R8Ki !< point mass [[kg]] REAL(DbKi) :: pointV = 0.0_R8Ki !< point volume [[m^3]] @@ -180,13 +184,13 @@ MODULE MoorDyn_Types CHARACTER(10) :: type !< type of Rod. should match one of RodProp names [-] INTEGER(IntKi) :: PropsIdNum = 0_IntKi !< the IdNum of the associated rod properties [-] INTEGER(IntKi) :: typeNum = 0_IntKi !< integer identifying the type. 0=free, 1=pinned, 2=fixed, -1=coupledpinned, -2=coupled [-] - INTEGER(IntKi) , DIMENSION(1:10) :: AttachedA = 0_IntKi !< list of IdNums of lines attached to end A [-] - INTEGER(IntKi) , DIMENSION(1:10) :: AttachedB = 0_IntKi !< list of IdNums of lines attached to end B [-] - INTEGER(IntKi) , DIMENSION(1:10) :: TopA = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] - INTEGER(IntKi) , DIMENSION(1:10) :: TopB = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) , DIMENSION(1:MD_MaxPtAtch) :: AttachedA = 0_IntKi !< list of IdNums of lines attached to end A [-] + INTEGER(IntKi) , DIMENSION(1:MD_MaxPtAtch) :: AttachedB = 0_IntKi !< list of IdNums of lines attached to end B [-] + INTEGER(IntKi) , DIMENSION(1:MD_MaxPtAtch) :: TopA = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) , DIMENSION(1:MD_MaxPtAtch) :: TopB = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] INTEGER(IntKi) :: nAttachedA = 0_IntKi !< number of attached lines to Rod end A [-] INTEGER(IntKi) :: nAttachedB = 0_IntKi !< number of attached lines to Rod end B [-] - INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList = 0_IntKi !< array specifying what line quantities should be output (1 vs 0) [-] + INTEGER(IntKi) , DIMENSION(1:55) :: OutFlagList = 0_IntKi !< array specifying what line quantities should be output (1 vs 0) [-] INTEGER(IntKi) :: N = 0_IntKi !< The number of elements in the line [-] INTEGER(IntKi) :: endTypeA = 0_IntKi !< type of point at end A: 0=pinned to Point, 1=cantilevered to Rod. [-] INTEGER(IntKi) :: endTypeB = 0_IntKi !< type of point at end B: 0=pinned to Point, 1=cantilevered to Rod. [-] @@ -240,6 +244,7 @@ MODULE MoorDyn_Types REAL(DbKi) , DIMENSION(1:3) :: FextU = 0.0_R8Ki !< vector of user-defined external force on the rod end A always in the local body-fixed frame [[N]] REAL(DbKi) , DIMENSION(1:2) :: Blin = 0.0_R8Ki !< linear damping, transverse damping for rod element always in the local body-fixed frame [[N/(m/s)]] REAL(DbKi) , DIMENSION(1:2) :: Bquad = 0.0_R8Ki !< quadratic damping, transverse damping for rod element always in the local body-fixed frame [[N/(m/s)^2]] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: VOF !< Node-based volume-of-fluid for submergence [-] END TYPE MD_Rod ! ======================= ! ========= MD_Line ======= @@ -272,14 +277,14 @@ MODULE MoorDyn_Types REAL(DbKi) :: dF = 0.0_R8Ki !< +- range of VIV synchronization in non-dimensional frequency [-] REAL(DbKi) :: cF = 0.0_R8Ki !< Center VIV synchronization in non-dimensional frequency [-] INTEGER(IntKi) :: nEApoints = 0_IntKi !< number of values in stress-strain lookup table (0 means using constant E) [-] - REAL(DbKi) , DIMENSION(1:30) :: stiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: stiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] + REAL(DbKi) , DIMENSION(1:MD_MaxNCoef) :: stiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to MD_MaxNCoef) [-] + REAL(DbKi) , DIMENSION(1:MD_MaxNCoef) :: stiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] INTEGER(IntKi) :: nBApoints = 0_IntKi !< number of values in stress-strainrate lookup table (0 means using constant c) [-] - REAL(DbKi) , DIMENSION(1:30) :: dampXs = 0.0_R8Ki !< x array for stress-strainrate lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: dampYs = 0.0_R8Ki !< y array for stress-strainrate lookup table [-] + REAL(DbKi) , DIMENSION(1:MD_MaxNCoef) :: dampXs = 0.0_R8Ki !< x array for stress-strainrate lookup table (up to MD_MaxNCoef) [-] + REAL(DbKi) , DIMENSION(1:MD_MaxNCoef) :: dampYs = 0.0_R8Ki !< y array for stress-strainrate lookup table [-] INTEGER(IntKi) :: nEIpoints = 0_IntKi !< number of values in bending stress-strain lookup table (0 means using constant E) [-] - REAL(DbKi) , DIMENSION(1:30) :: bstiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: bstiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] + REAL(DbKi) , DIMENSION(1:MD_MaxNCoef) :: bstiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to MD_MaxNCoef) [-] + REAL(DbKi) , DIMENSION(1:MD_MaxNCoef) :: bstiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] REAL(DbKi) :: time = 0.0_R8Ki !< current time [[s]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: r !< node positions [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: rd !< node velocities [-] @@ -337,8 +342,8 @@ MODULE MoorDyn_Types INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this failure [-] INTEGER(IntKi) :: attachID = 0_IntKi !< ID of connection or Rod the lines are attached to [-] INTEGER(IntKi) :: isRod = 0_IntKi !< 1 Rod end A, 2 Rod end B, 0 if point [-] - INTEGER(IntKi) , DIMENSION(1:30) :: lineIDs = 0_IntKi !< array of one or more lines to detach (starting from 1...) [-] - INTEGER(IntKi) , DIMENSION(1:30) :: lineTops = 0_IntKi !< an array that will be FILLED IN to return which end of each line was disconnected ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) , DIMENSION(1:MD_MaxFailLines) :: lineIDs = 0_IntKi !< array of one or more lines to detach (starting from 1...) [-] + INTEGER(IntKi) , DIMENSION(1:MD_MaxFailLines) :: lineTops = 0_IntKi !< an array that will be FILLED IN to return which end of each line was disconnected ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] INTEGER(IntKi) :: nLinesToDetach = 0_IntKi !< how many lines to dettach [-] REAL(DbKi) :: failTime = 0.0_R8Ki !< time of failure [s] REAL(DbKi) :: failTen = 0.0_R8Ki !< tension threshold of failure [N] @@ -435,7 +440,7 @@ MODULE MoorDyn_Types REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_Xs !< array of x-coordinates in the bathymetry grid [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_Ys !< array of y-coordinates in the bathymetry grid [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_npoints !< number of grid points to describe the bathymetry grid [-] - TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] + TYPE(GridInterp_MiscVarType) :: WaveField_m !< misc var information from the Grid Interpolation module [-] LOGICAL :: IC_gen = .FALSE. !< boolean to indicate dynamic relaxation occuring [-] END TYPE MD_MiscVarType ! ======================= @@ -1505,6 +1510,18 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%FextU = SrcRodData%FextU DstRodData%Blin = SrcRodData%Blin DstRodData%Bquad = SrcRodData%Bquad + if (allocated(SrcRodData%VOF)) then + LB(1:1) = lbound(SrcRodData%VOF) + UB(1:1) = ubound(SrcRodData%VOF) + if (.not. allocated(DstRodData%VOF)) then + allocate(DstRodData%VOF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%VOF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%VOF = SrcRodData%VOF + end if end subroutine subroutine MD_DestroyRod(RodData, ErrStat, ErrMsg) @@ -1577,6 +1594,9 @@ subroutine MD_DestroyRod(RodData, ErrStat, ErrMsg) if (allocated(RodData%RodWrOutput)) then deallocate(RodData%RodWrOutput) end if + if (allocated(RodData%VOF)) then + deallocate(RodData%VOF) + end if end subroutine subroutine MD_PackRod(RF, Indata) @@ -1648,6 +1668,7 @@ subroutine MD_PackRod(RF, Indata) call RegPack(RF, InData%FextU) call RegPack(RF, InData%Blin) call RegPack(RF, InData%Bquad) + call RegPackAlloc(RF, InData%VOF) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1723,6 +1744,7 @@ subroutine MD_UnPackRod(RF, OutData) call RegUnpack(RF, OutData%FextU); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Blin); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Bquad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VOF); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) @@ -3489,7 +3511,7 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%BathGrid_npoints = SrcMiscData%BathGrid_npoints end if - call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) + call GridInterp_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstMiscData%IC_gen = SrcMiscData%IC_gen @@ -3643,7 +3665,7 @@ subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%BathGrid_npoints)) then deallocate(MiscData%BathGrid_npoints) end if - call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) + call GridInterp_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -3755,7 +3777,7 @@ subroutine MD_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%BathGrid_Xs) call RegPackAlloc(RF, InData%BathGrid_Ys) call RegPackAlloc(RF, InData%BathGrid_npoints) - call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) + call GridInterp_PackMisc(RF, InData%WaveField_m) call RegPack(RF, InData%IC_gen) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -3902,7 +3924,7 @@ subroutine MD_UnPackMisc(RF, OutData) call RegUnpackAlloc(RF, OutData%BathGrid_Xs); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%BathGrid_Ys); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%BathGrid_npoints); if (RegCheckErr(RF, RoutineName)) return - call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m + call GridInterp_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m call RegUnpack(RF, OutData%IC_gen); if (RegCheckErr(RF, RoutineName)) return end subroutine diff --git a/modules/nwtc-library/CMakeLists.txt b/modules/nwtc-library/CMakeLists.txt index d3aced33d0..71b5a0fd9a 100644 --- a/modules/nwtc-library/CMakeLists.txt +++ b/modules/nwtc-library/CMakeLists.txt @@ -17,6 +17,7 @@ if (GENERATE_TYPES) generate_f90_types(src/Registry_NWTC_Library_base.txt ${CMAKE_CURRENT_SOURCE_DIR}/src/NWTC_Library_Types.f90 -noextrap) generate_f90_types(src/Registry_NWTC_Library_mesh.txt ${CMAKE_CURRENT_SOURCE_DIR}/src/NWTC_Library_IncSubs.f90 -incsubs -noextrap) + generate_f90_types(src/GridInterp.txt ${CMAKE_CURRENT_SOURCE_DIR}/src/GridInterp_Types.f90 -noextrap) # Generate Registry_NWTC_Library.txt by concatenating _base.txt and _mesh.txt set_property(DIRECTORY APPEND PROPERTY CMAKE_CONFIGURE_DEPENDS src/Registry_NWTC_Library_mesh.txt @@ -85,6 +86,9 @@ set(NWTCLIBS_SOURCES src/YAML.f90 src/JSON.f90 + src/GridInterp.f90 + src/GridInterp_Types.f90 + # RanLux sources src/ranlux/RANLUX.f90 diff --git a/modules/nwtc-library/src/GridInterp.f90 b/modules/nwtc-library/src/GridInterp.f90 new file mode 100644 index 0000000000..3398ca5269 --- /dev/null +++ b/modules/nwtc-library/src/GridInterp.f90 @@ -0,0 +1,845 @@ +MODULE GridInterp + +USE GridInterp_Types + +IMPLICIT NONE + +PRIVATE SetIndex +PRIVATE GetN1D +PRIVATE GetN1Ddx + +PUBLIC GridInterp_SetParams +PUBLIC GridInterpSetup3D +PUBLIC GridInterpSetup4D +PUBLIC GridInterpSetupN + +INTERFACE GridInterp3D + MODULE PROCEDURE GridInterp3DR4 + MODULE PROCEDURE GridInterp3DR8 +END INTERFACE + +INTERFACE GridInterp3DVec + MODULE PROCEDURE GridInterp3DVecR4 + MODULE PROCEDURE GridInterp3DVecR8 +END INTERFACE + +INTERFACE GridInterp3DVec6 + MODULE PROCEDURE GridInterp3DVec6R4 + MODULE PROCEDURE GridInterp3DVec6R8 +END INTERFACE + +INTERFACE GridInterp4D + MODULE PROCEDURE GridInterp4DR4 + MODULE PROCEDURE GridInterp4DR8 +END INTERFACE + +INTERFACE GridInterp4DVec + MODULE PROCEDURE GridInterp4DVecR4 + MODULE PROCEDURE GridInterp4DVecR8 +END INTERFACE + +INTERFACE GridInterp4DVec6 + MODULE PROCEDURE GridInterp4DVec6R4 + MODULE PROCEDURE GridInterp4DVec6R8 +END INTERFACE + +INTERFACE GridInterpN + MODULE PROCEDURE GridInterpNR4 + MODULE PROCEDURE GridInterpNR8 +END INTERFACE + +INTERFACE GridInterpS + MODULE PROCEDURE GridInterpSR4 + MODULE PROCEDURE GridInterpSR8 +END INTERFACE + +CONTAINS + +Subroutine GridInterp_SetParams(dim, n, delta, pZero, IsPeriodic, p, ErrStat, ErrMsg) + + Integer(IntKi), intent(in ) :: dim + Integer(IntKi), intent(in ) :: n(:) + Real(ReKi), intent(in ) :: delta(:) + Real(ReKi), intent(in ) :: pZero(:) + Logical, intent(in ) :: IsPeriodic(:) + Type(GridInterp_ParameterType), intent(inout) :: p + + Integer(IntKi), INTENT(OUT) :: ErrStat + Character(*), INTENT(OUT) :: ErrMsg + + Integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = "" + + if (dim/=3 .and. dim/=4) then + ErrStat = ErrID_Fatal + ErrMsg = 'GridInterp_Init: dim must be 3 or 4' + return + end if + + do i = 1,dim + p%n(i) = n(i) + p%delta(i) = delta(i) + p%pZero(i) = pZero(i) + p%IsPeriodic(i) = IsPeriodic(i) + end do + +End Subroutine GridInterp_SetParams + +Subroutine SetIndex(pIn,pZero,delta,nMax,IsPeriodic,Indx,isopc,Support,FirstWarn,ErrStat,ErrMsg) + + Real(ReKi), intent(in ) :: pIn + Real(ReKi), intent(in ) :: pZero + Real(ReKi), intent(in ) :: delta + Integer(IntKi), intent(in ) :: nMax + Logical, intent(in ) :: IsPeriodic + Integer(IntKi), intent(inout) :: Indx(:) + Real(ReKi), intent(inout) :: isopc + Integer(IntKi), intent(inout) :: Support ! = 0 for linear interpolation, = 1 for quadratic with one point to the left, = 2 for quadratic with one point to the right, = 3 for cubic + Logical, intent(inout) :: FirstWarn + Integer(IntKi), intent( out) :: ErrStat + Character(*), intent( out) :: ErrMsg + + Real(ReKi) :: p, pMax + Integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = "" + + isopc = 0.0_ReKi + Indx = 0_IntKi + + if ( nMax .EQ. 1_IntKi ) then ! Only one grid point, effectively ignore this dimension + ! Construct a dummy linear interpolation for now + Indx(1) = 0_IntKi + Indx(2) = 0_IntKi + Indx(3) = 0_IntKi + Indx(4) = 0_IntKi + isopc = 0.5_ReKi + Support = 0 + return + end if + + ! Compute normalized coordinate + p = (pIn-pZero) / delta + + if (isPeriodic) then + + ! Calculate normalized coordinate between 0 and 1 + isopc = p - floor(p,ReKi) + + ! Get the normalized coordinates of the two nearest nodes to the left and to the right + Indx = floor( p, IntKi ) + [-1,0,1,2] + + ! Make sure the coordinates are not out of bound using periodicity + do i = 1,4 + if ( Indx(i) < 0 ) then + Indx(i) = Indx(i) - nMax*floor( Real(Indx(i),ReKi) / Real(nMax,ReKi) ) + end if + Indx(i) = mod(Indx(i),nMax) + end do + + ! Always use cubic interpolation for periodic dimensions + support = 3 ! Cubic interpolation + + else + + pMax = Real(nMax-1_IntKi,ReKi) + + if (p<0) then + + p = 0.0_ReKi + + if (FirstWarn) then + call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetIndex') + FirstWarn = .false. + end if + + else if (p>pMax) then + + p = pMax + + if (FirstWarn) then ! don't warn if we are exactly at the boundary + call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetIndex') + FirstWarn = .false. + end if + + end if + + if ( EqualRealNos( p, pMax ) ) then + ! Calculate normalized coordinate between 0 and 1 + isopc = 1.0_ReKi + ! Get the normalized coordinates of the two nearest nodes to the left and to the right + Indx = nMax + [-3,-2,-1,0] + else + ! Calculate normalized coordinate between 0 and 1 + isopc = p - floor(p,ReKi) + ! Get the normalized coordinates of the two nearest nodes to the left and to the right + Indx = floor( p, IntKi ) + [-1,0,1,2] + end if + + ! Supported interpolation method + if ( Indx(1) < 0_IntKi ) then + Indx(1) = 0_IntKi + if (Indx(4) > (nMax-1_IntKi) ) then + support = 0 ! Linear interpolation + Indx(4) = nMax-1_IntKi + else + support = 1 ! Quadratic interpolation with only one node to the left + end if + else if ( Indx(4) > (nMax-1_IntKi) ) then + support = 2 ! Quadratic interpolation with only one node to the right + Indx(4) = nMax-1_IntKi + else + support = 3 ! Cubic interpolation + end if + + end if + +End Subroutine SetIndex + +Subroutine GetN1D(isopc, support, N1D) + + real(ReKi), intent(in ) :: isopc ! isoparametric coordinates + integer(IntKi), intent(in ) :: support + real(ReKi), intent(inout) :: N1D(4) + real(ReKi) :: isopc2,isopc3 + + select case ( Support ) + case ( 3 ) ! Cubic interpolation + + isopc2 = isopc*isopc + isopc3 = isopc*isopc2 + + N1D(1) = -0.5_ReKi*isopc3 + isopc2 - 0.5_ReKi*isopc + N1D(2) = 1.5_ReKi*isopc3 - 2.5_ReKi*isopc2 + 1.0_ReKi + N1D(3) = -1.5_ReKi*isopc3 + 2.0_ReKi*isopc2 + 0.5_ReKi*isopc + N1D(4) = 0.5_ReKi*isopc3 - 0.5_ReKi*isopc2 + + case ( 1 ) ! Quadratic interpolation with only one node to the left + + isopc2 = isopc*isopc + + N1D(1) = 0.0_ReKi + N1D(2) = 0.5_ReKi*isopc2 - 1.5_ReKi*isopc + 1.0_ReKi + N1D(3) = -1.0_ReKi*isopc2 + 2.0_ReKi*isopc + N1D(4) = 0.5_ReKi*isopc2 - 0.5_ReKi*isopc + + case ( 2 ) ! Quadratic interpolation with only one node to the right + + isopc2 = isopc*isopc + + N1D(1) = 0.5_ReKi*isopc2 - 0.5_ReKi*isopc + N1D(2) = -1.0_ReKi*isopc2 + 1.0_ReKi + N1D(3) = 0.5_ReKi*isopc2 + 0.5_ReKi*isopc + N1D(4) = 0.0_ReKi + + case default ! Support == 0 Linear interpolation + + N1D(1) = 0.0_ReKi + N1D(2) = -isopc + 1.0_ReKi + N1D(3) = isopc + N1D(4) = 0.0_ReKi + + end select + +End Subroutine GetN1D + +Subroutine GetN1Ddx(isopc, support, N1D) + + real(ReKi), intent(in ) :: isopc ! isoparametric coordinates + integer(IntKi), intent(in ) :: support + real(ReKi), intent(inout) :: N1D(4) + real(ReKi) :: isopc2 + + select case ( Support ) + case ( 3 ) ! Cubic interpolation + + isopc2 = isopc*isopc + + N1D(1) = -1.5_ReKi*isopc2 + 2.0_ReKi*isopc - 0.5_ReKi + N1D(2) = 4.5_ReKi*isopc2 - 5.0_ReKi*isopc + N1D(3) = -4.5_ReKi*isopc2 + 4.0_ReKi*isopc + 0.5_ReKi + N1D(4) = 1.5_ReKi*isopc2 - isopc + + case ( 1 ) ! Quadratic interpolation with only one node to the left + + N1D(1) = 0.0_ReKi + N1D(2) = isopc - 1.5_ReKi + N1D(3) = -2.0_ReKi*isopc + 2.0_ReKi + N1D(4) = isopc - 0.5_ReKi + + case ( 2 ) ! Quadratic interpolation with only one node to the right + + N1D(1) = isopc - 0.5_ReKi + N1D(2) = -2.0_ReKi*isopc + N1D(3) = isopc + 0.5_ReKi + N1D(4) = 0.0_ReKi + + case default ! Support == 0 Linear interpolation + + N1D(1) = 0.0_ReKi + N1D(2) = -1.0_ReKi + N1D(3) = 1.0_ReKi + N1D(4) = 0.0_ReKi + + end select + +End Subroutine GetN1Ddx + +Subroutine GridInterpSetup3D( position, p, m, ErrStat, ErrMsg ) + + real(ReKi), intent(in ) :: Position(3) !< Array of 3 coordinates + type(GridInterp_ParameterType), intent(in ) :: p !< Parameters + type(GridInterp_MiscVarType), intent(inout) :: m !< MiscVars + integer(IntKi), intent( out) :: ErrStat !< Error status + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'GridInterpSetup3D' + integer(IntKi) :: dim,i,j,k + integer(IntKi) :: support + real(ReKi) :: N1D(4,3) + real(ReKi) :: isopc ! isoparametric coordinates + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + do dim = 1,3 + call SetIndex(Position(dim), p%pZero(dim), p%delta(dim), p%n(dim), p%IsPeriodic(dim), m%Indx(:,dim), isopc, Support, m%FirstWarn_Clamp, ErrStat2, ErrMsg2) + if (Failed()) return; + call GetN1D(isopc, Support, N1D(:,dim)) + end do + + do k = 1,4 + do j = 1,4 + do i = 1,4 + m%N3D(i,j,k) = N1D(i,1)*N1D(j,2)*N1D(k,3) + end do + end do + end do + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function + +End Subroutine GridInterpSetup3D + +Subroutine GridInterpSetup4D( position, p, m, ErrStat, ErrMsg ) + + real(ReKi), intent(in ) :: Position(4) !< Array of 4 coordinates + type(GridInterp_ParameterType), intent(in ) :: p !< Parameters + type(GridInterp_MiscVarType), intent(inout) :: m !< MiscVars + integer(IntKi), intent( out) :: ErrStat !< Error status + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'GridInterpSetup4D' + integer(IntKi) :: dim,i,j,k,l + integer(IntKi) :: support + real(ReKi) :: N1D(4,4) + real(ReKi) :: isopc ! isoparametric coordinates + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + do dim = 1,4 + call SetIndex(Position(dim), p%pZero(dim), p%delta(dim), p%n(dim), p%IsPeriodic(dim), m%Indx(:,dim), isopc, Support, m%FirstWarn_Clamp, ErrStat2, ErrMsg2) + if (Failed()) return; + call GetN1D(isopc, Support, N1D(:,dim)) + end do + + do l = 1,4 + do k = 1,4 + do j = 1,4 + do i = 1,4 + m%N4D(i,j,k,l) = N1D(i,1)*N1D(j,2)*N1D(k,3)*N1D(l,4) + end do + end do + end do + end do + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function + +End Subroutine GridInterpSetup4D + +Subroutine GridInterpSetupN( position, p, m, ErrStat, ErrMsg ) + + real(ReKi), intent(in ) :: Position(3) !< Array of 3 coordinates + type(GridInterp_ParameterType), intent(in ) :: p !< Parameters + type(GridInterp_MiscVarType), intent(inout) :: m !< MiscVars + integer(IntKi), intent( out) :: ErrStat !< Error status + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'GridInterpSetupN' + integer(IntKi) :: dim,i,j,k + integer(IntKi) :: support + real(ReKi) :: N1D(4,3) + real(ReKi) :: N1Ddx(4,2:3) + real(ReKi) :: isopc ! isoparametric coordinates + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + do dim = 1,3 + call SetIndex(Position(dim), p%pZero(dim), p%delta(dim), p%n(dim), p%IsPeriodic(dim), m%Indx(:,dim), isopc, Support, m%FirstWarn_Clamp, ErrStat2, ErrMsg2) + if (Failed()) return; + call GetN1D(isopc, Support, N1D(:,dim)) + if (dim>1) then + call GetN1Ddx(isopc, Support, N1Ddx(:,dim)) + end if + end do + + ! Need two sets of weights for d(.)/dx and d(.)/dy. Borrow m%N4D for this. + do k = 1,4 + do j = 1,4 + do i = 1,4 + m%N4D(i,j,k,1) = N1D(i,1)*N1Ddx(j,2)*N1D (k,3) + m%N4D(i,j,k,2) = N1D(i,1)*N1D (j,2)*N1Ddx(k,3) + end do + end do + end do + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function + +End Subroutine GridInterpSetupN + + +!============================================================================================================= +! INTERFACE GridInterp3D +! - GridInterp3DR4 +! - GridInterp3DR8 +!============================================================================================================= +function GridInterp3DR4( data, m ) + real(SiKi), intent(in ) :: data(0:,0:,0:) !< 3D grid of scalar data + type(GridInterp_MiscVarType), intent(in ) :: m !< MiscVars + + character(*), parameter :: RoutineName = 'GridInterp3DR4' + real(SiKi) :: GridInterp3DR4 + integer(IntKi) :: i,j,k + + ! interpolate + GridInterp3DR4 = 0.0_SiKi + do k = 1,4 + do j = 1,4 + do i = 1,4 + GridInterp3DR4 = GridInterp3DR4 + m%N3D(i,j,k) * data( m%Indx(i,1), m%Indx(j,2), m%Indx(k,3) ) + end do + end do + end do + +end function GridInterp3DR4 + +function GridInterp3DR8( data, m ) + real(DbKi), intent(in ) :: data(0:,0:,0:) !< 3D grid of scalar data + type(GridInterp_MiscVarType), intent(in ) :: m !< MiscVars + + character(*), parameter :: RoutineName = 'GridInterp3DR8' + real(DbKi) :: GridInterp3DR8 + integer(IntKi) :: i,j,k + + ! interpolate + GridInterp3DR8 = 0.0_DbKi + do k = 1,4 + do j = 1,4 + do i = 1,4 + GridInterp3DR8 = GridInterp3DR8 + m%N3D(i,j,k) * data( m%Indx(i,1), m%Indx(j,2), m%Indx(k,3) ) + end do + end do + end do + +end function GridInterp3DR8 + +!============================================================================================================= +! INTERFACE GridInterp3DVec +! - GridInterp3DVecR4 +! - GridInterp3DVecR8 +!============================================================================================================= +function GridInterp3DVecR4( data, m ) + real(SiKi), intent(in ) :: data(0:,0:,0:,:) !< 3D grid of vector data + type(GridInterp_MiscVarType), intent(in ) :: m !< MiscVars + + character(*), parameter :: RoutineName = 'GridInterp3DVecR4' + integer(IntKi), parameter :: vDim = 3 + integer(IntKi) :: i,j,k,vi + real(SiKi) :: GridInterp3DVecR4(vDim) + + ! interpolate + GridInterp3DVecR4 = 0.0_SiKi + do k = 1,4 + do j = 1,4 + do i = 1,4 + do vi = 1,vDim + GridInterp3DVecR4(vi) = GridInterp3DVecR4(vi) + m%N3D(i,j,k) * data( m%Indx(i,1), m%Indx(j,2), m%Indx(k,3), vi ) + end do + end do + end do + end do + +end function GridInterp3DVecR4 + +function GridInterp3DVecR8( data, m ) + real(DbKi), intent(in ) :: data(0:,0:,0:,:) !< 3D grid of vector data + type(GridInterp_MiscVarType), intent(in ) :: m !< MiscVars + + character(*), parameter :: RoutineName = 'GridInterp3DVecR8' + integer(IntKi), parameter :: vDim = 3 + integer(IntKi) :: i,j,k,vi + real(DbKi) :: GridInterp3DVecR8(vDim) + + ! interpolate + GridInterp3DVecR8 = 0.0_DbKi + do k = 1,4 + do j = 1,4 + do i = 1,4 + do vi = 1,vDim + GridInterp3DVecR8(vi) = GridInterp3DVecR8(vi) + m%N3D(i,j,k) * data( m%Indx(i,1), m%Indx(j,2), m%Indx(k,3), vi ) + end do + end do + end do + end do + +end function GridInterp3DVecR8 + +!============================================================================================================= +! INTERFACE GridInterp3DVec6 +! - GridInterp3DVec6R4 +! - GridInterp3DVec6R8 +!============================================================================================================= +function GridInterp3DVec6R4( data, m ) + real(SiKi), intent(in ) :: data(0:,0:,0:,:) !< 3D grid of vector data + type(GridInterp_MiscVarType), intent(in ) :: m !< MiscVars + + character(*), parameter :: RoutineName = 'GridInterp3DVec6R4' + integer(IntKi), parameter :: vDim = 6 + integer(IntKi) :: i,j,k,vi + real(SiKi) :: GridInterp3DVec6R4(vDim) + + ! interpolate + GridInterp3DVec6R4 = 0.0_SiKi + do k = 1,4 + do j = 1,4 + do i = 1,4 + do vi = 1,vDim + GridInterp3DVec6R4(vi) = GridInterp3DVec6R4(vi) + m%N3D(i,j,k) * data( m%Indx(i,1), m%Indx(j,2), m%Indx(k,3), vi ) + end do + end do + end do + end do + +end function GridInterp3DVec6R4 + +function GridInterp3DVec6R8( data, m ) + real(DbKi), intent(in ) :: data(0:,0:,0:,:) !< 3D grid of vector data + type(GridInterp_MiscVarType), intent(in ) :: m !< MiscVars + + character(*), parameter :: RoutineName = 'GridInterp3DVec6R8' + integer(IntKi), parameter :: vDim = 6 + integer(IntKi) :: i,j,k,vi + real(DbKi) :: GridInterp3DVec6R8(vDim) + + ! interpolate + GridInterp3DVec6R8 = 0.0_DbKi + do k = 1,4 + do j = 1,4 + do i = 1,4 + do vi = 1,vDim + GridInterp3DVec6R8(vi) = GridInterp3DVec6R8(vi) + m%N3D(i,j,k) * data( m%Indx(i,1), m%Indx(j,2), m%Indx(k,3), vi ) + end do + end do + end do + end do + +end function GridInterp3DVec6R8 + +!============================================================================================================= +! INTERFACE GridInterp4D +! - GridInterp4DR4 +! - GridInterp4DR8 +!============================================================================================================= +function GridInterp4DR4( data, m ) + real(SiKi), intent(in ) :: data(0:,0:,0:,0:) !< 4D grid of scalar data + type(GridInterp_MiscVarType), intent(in ) :: m !< MiscVars + + character(*), parameter :: RoutineName = 'GridInterp4DR4' + real(SiKi) :: GridInterp4DR4 + integer(IntKi) :: i,j,k,l + + ! interpolate + GridInterp4DR4 = 0.0_SiKi + do l = 1,4 + do k = 1,4 + do j = 1,4 + do i = 1,4 + GridInterp4DR4 = GridInterp4DR4 + m%N4D(i,j,k,l) * data( m%Indx(i,1), m%Indx(j,2), m%Indx(k,3), m%Indx(l,4) ) + end do + end do + end do + end do + +end function GridInterp4DR4 + +function GridInterp4DR8( data, m ) + real(DbKi), intent(in ) :: data(0:,0:,0:,0:) !< 4D grid of scalar data + type(GridInterp_MiscVarType), intent(in ) :: m !< MiscVars + + character(*), parameter :: RoutineName = 'GridInterp4DR8' + real(DbKi) :: GridInterp4DR8 + integer(IntKi) :: i,j,k,l + + ! interpolate + GridInterp4DR8 = 0.0_DbKi + do l = 1,4 + do k = 1,4 + do j = 1,4 + do i = 1,4 + GridInterp4DR8 = GridInterp4DR8 + m%N4D(i,j,k,l) * data( m%Indx(i,1), m%Indx(j,2), m%Indx(k,3), m%Indx(l,4) ) + end do + end do + end do + end do + +end function GridInterp4DR8 + +!============================================================================================================= +! INTERFACE GridInterp4DVec +! - GridInterp4DVecR4 +! - GridInterp4DVecR8 +!============================================================================================================= +function GridInterp4DVecR4( data, m ) + real(SiKi), intent(in ) :: data(0:,0:,0:,0:,:) !< 4D grid of vector data + type(GridInterp_MiscVarType), intent(in ) :: m !< MiscVars + + character(*), parameter :: RoutineName = 'GridInterp4DVecR4' + integer(IntKi), parameter :: vDim = 3 + integer(IntKi) :: i,j,k,l,vi + real(SiKi) :: GridInterp4DVecR4(vDim) + + ! interpolate + GridInterp4DVecR4 = 0.0_SiKi + do l = 1,4 + do k = 1,4 + do j = 1,4 + do i = 1,4 + do vi = 1,vDim + GridInterp4DVecR4(vi) = GridInterp4DVecR4(vi) + m%N4D(i,j,k,l) * data( m%Indx(i,1), m%Indx(j,2), m%Indx(k,3), m%Indx(l,4), vi ) + end do + end do + end do + end do + end do + +end function GridInterp4DVecR4 + +function GridInterp4DVecR8( data, m ) + real(DbKi), intent(in ) :: data(0:,0:,0:,0:,:) !< 4D grid of vector data + type(GridInterp_MiscVarType), intent(in ) :: m !< MiscVars + + character(*), parameter :: RoutineName = 'GridInterp4DVecR8' + integer(IntKi), parameter :: vDim = 3 + integer(IntKi) :: i,j,k,l,vi + real(DbKi) :: GridInterp4DVecR8(vDim) + + ! interpolate + GridInterp4DVecR8 = 0.0_DbKi + do l = 1,4 + do k = 1,4 + do j = 1,4 + do i = 1,4 + do vi = 1,vDim + GridInterp4DVecR8(vi) = GridInterp4DVecR8(vi) + m%N4D(i,j,k,l) * data( m%Indx(i,1), m%Indx(j,2), m%Indx(k,3), m%Indx(l,4), vi ) + end do + end do + end do + end do + end do + +end function GridInterp4DVecR8 + +!============================================================================================================= +! INTERFACE GridInterp4DVec6 +! - GridInterp4DVec6R4 +! - GridInterp4DVec6R8 +!============================================================================================================= +function GridInterp4DVec6R4( data, m ) + real(SiKi), intent(in ) :: data(0:,0:,0:,0:,:) !< 4D grid of vector data + type(GridInterp_MiscVarType), intent(in ) :: m !< MiscVars + + character(*), parameter :: RoutineName = 'GridInterp4DVec6R4' + integer(IntKi), parameter :: vDim = 6 + integer(IntKi) :: i,j,k,l,vi + real(SiKi) :: GridInterp4DVec6R4(vDim) + + ! interpolate + GridInterp4DVec6R4 = 0.0_SiKi + do l = 1,4 + do k = 1,4 + do j = 1,4 + do i = 1,4 + do vi = 1,vDim + GridInterp4DVec6R4(vi) = GridInterp4DVec6R4(vi) + m%N4D(i,j,k,l) * data( m%Indx(i,1), m%Indx(j,2), m%Indx(k,3), m%Indx(l,4), vi ) + end do + end do + end do + end do + end do + +end function GridInterp4DVec6R4 + +function GridInterp4DVec6R8( data, m ) + real(DbKi), intent(in ) :: data(0:,0:,0:,0:,:) !< 4D grid of vector data + type(GridInterp_MiscVarType), intent(in ) :: m !< MiscVars + + character(*), parameter :: RoutineName = 'GridInterp4DVec6R8' + integer(IntKi), parameter :: vDim = 6 + integer(IntKi) :: i,j,k,l,vi + real(DbKi) :: GridInterp4DVec6R8(vDim) + + ! interpolate + GridInterp4DVec6R8 = 0.0_DbKi + do l = 1,4 + do k = 1,4 + do j = 1,4 + do i = 1,4 + do vi = 1,vDim + GridInterp4DVec6R8(vi) = GridInterp4DVec6R8(vi) + m%N4D(i,j,k,l) * data( m%Indx(i,1), m%Indx(j,2), m%Indx(k,3), m%Indx(l,4), vi ) + end do + end do + end do + end do + end do + +end function GridInterp4DVec6R8 + +!============================================================================================================= +! INTERFACE GridInterpN +! - GridInterpNR4 +! - GridInterpNR8 +!============================================================================================================= +function GridInterpNR4( data, p, m ) + real(SiKi), intent(in ) :: data(0:,0:,0:) !< 3D grid of scalar data + type(GridInterp_ParameterType), intent(in ) :: p !< Parameters + type(GridInterp_MiscVarType), intent(in ) :: m !< MiscVars + + character(*), parameter :: RoutineName = 'GridInterpNR4' + real(SiKi) :: GridInterpNR4(3) + real(SiKi) :: dZetadx, dZetady + integer(IntKi) :: i,j,k + + ! interpolate slope + dZetadx = 0.0_SiKi + dZetady = 0.0_SiKi + do k = 1,4 + do j = 1,4 + do i = 1,4 + dZetadx = dZetadx + m%N4D(i,j,k,1) * data( m%Indx(i,1), m%Indx(j,2), m%Indx(k,3) ) + dZetady = dZetady + m%N4D(i,j,k,2) * data( m%Indx(i,1), m%Indx(j,2), m%Indx(k,3) ) + end do + end do + end do + dZetadx = dZetadx / p%delta(2) + dZetady = dZetady / p%delta(3) + + GridInterpNR4 = [-dZetadx,-dZetady,1.0_SiKi] + GridInterpNR4 = GridInterpNR4 / TwoNorm(GridInterpNR4) + +end function GridInterpNR4 + +function GridInterpNR8( data, p, m ) + real(DbKi), intent(in ) :: data(0:,0:,0:) !< 3D grid of scalar data + type(GridInterp_ParameterType), intent(in ) :: p !< Parameters + type(GridInterp_MiscVarType), intent(in ) :: m !< MiscVars + + character(*), parameter :: RoutineName = 'GridInterpNR8' + real(DbKi) :: GridInterpNR8(3) + real(DbKi) :: dZetadx, dZetady + integer(IntKi) :: i,j,k + + ! interpolate slope + dZetadx = 0.0_DbKi + dZetady = 0.0_DbKi + do k = 1,4 + do j = 1,4 + do i = 1,4 + dZetadx = dZetadx + m%N4D(i,j,k,1) * data( m%Indx(i,1), m%Indx(j,2), m%Indx(k,3) ) + dZetady = dZetady + m%N4D(i,j,k,2) * data( m%Indx(i,1), m%Indx(j,2), m%Indx(k,3) ) + end do + end do + end do + dZetadx = dZetadx / p%delta(2) + dZetady = dZetady / p%delta(3) + + GridInterpNR8 = (/-dZetadx,-dZetady,1.0_DbKi/) + GridInterpNR8 = GridInterpNR8 / TwoNorm(GridInterpNR8) + +end function GridInterpNR8 + +!============================================================================================================= +! INTERFACE GridInterpS +! - GridInterpSR4 +! - GridInterpSR8 +!============================================================================================================= +function GridInterpSR4( data, p, m ) + real(SiKi), intent(in ) :: data(0:,0:,0:) !< 3D grid of scalar data + type(GridInterp_ParameterType), intent(in ) :: p !< Parameters + type(GridInterp_MiscVarType), intent(in ) :: m !< MiscVars + + character(*), parameter :: RoutineName = 'GridInterpSR4' + real(SiKi) :: GridInterpSR4(2) + integer(IntKi) :: i,j,k,dir + + ! interpolate slope + GridInterpSR4 = 0.0_SiKi + do k = 1,4 + do j = 1,4 + do i = 1,4 + do dir = 1,2 + GridInterpSR4(dir) = GridInterpSR4(dir) + m%N4D(i,j,k,dir) * data( m%Indx(i,1), m%Indx(j,2), m%Indx(k,3) ) + end do + end do + end do + end do + GridInterpSR4 = GridInterpSR4 / p%delta(2:3) + +end function GridInterpSR4 + +function GridInterpSR8( data, p, m ) + real(DbKi), intent(in ) :: data(0:,0:,0:) !< 3D grid of scalar data + type(GridInterp_ParameterType), intent(in ) :: p !< Parameters + type(GridInterp_MiscVarType), intent(in ) :: m !< MiscVars + + character(*), parameter :: RoutineName = 'GridInterpSR8' + real(DbKi) :: GridInterpSR8(2) + integer(IntKi) :: i,j,k,dir + + ! interpolate slope + GridInterpSR8 = 0.0_DbKi + do k = 1,4 + do j = 1,4 + do i = 1,4 + do dir = 1,2 + GridInterpSR8(dir) = GridInterpSR8(dir) + m%N4D(i,j,k,dir) * data( m%Indx(i,1), m%Indx(j,2), m%Indx(k,3) ) + end do + end do + end do + end do + GridInterpSR8 = GridInterpSR8 / p%delta(2:3) + +end function GridInterpSR8 + +END MODULE GridInterp \ No newline at end of file diff --git a/modules/nwtc-library/src/GridInterp.txt b/modules/nwtc-library/src/GridInterp.txt new file mode 100644 index 0000000000..cf562f7cb7 --- /dev/null +++ b/modules/nwtc-library/src/GridInterp.txt @@ -0,0 +1,11 @@ +#--------------------------------------------------------------------------------------------------------------------------------------------------------- +# +#--------------------------------------------------------------------------------------------------------------------------------------------------------- +typedef GridInterp ParameterType IntKi n {4} - - "number of evenly-spaced grid points in each dimension" - +typedef ^ ParameterType ReKi delta {4} - - "size between 2 consecutive grid points in each grid direction" - +typedef ^ ParameterType ReKi pZero {4} - - "fixed position of the grid starting corner (i.e., XYZW coordinates of m%V(0,0,0,0,:))" - +typedef ^ ParameterType logical IsPeriodic {4} .false. - "flag to indicate whether this dimension should be treated as periodic" - +typedef ^ MiscVarType ReKi N3D {4}{4}{4} - - "this is the weights for 3D grid values" - +typedef ^ MiscVarType ReKi N4D {4}{4}{4}{4} - - "this is the weights for 4D grid values" - +typedef ^ MiscVarType integer Indx {4}{4} - - "this is the neighboring node index into the grid" - +typedef ^ MiscVarType logical FirstWarn_Clamp - .true. - "used to avoid too many 'Position has been clamped to the grid boundary' warning messages " - diff --git a/modules/nwtc-library/src/GridInterp_Types.f90 b/modules/nwtc-library/src/GridInterp_Types.f90 new file mode 100644 index 0000000000..f8a89950f6 --- /dev/null +++ b/modules/nwtc-library/src/GridInterp_Types.f90 @@ -0,0 +1,148 @@ +!STARTOFREGISTRYGENERATEDFILE 'GridInterp_Types.f90' +! +! WARNING This file is generated automatically by the FAST registry. +! Do not edit. Your changes to this file will be lost. +! +! FAST Registry +!********************************************************************************************************************************* +! GridInterp_Types +!................................................................................................................................. +! This file is part of GridInterp. +! +! Copyright (C) 2012-2016 National Renewable Energy Laboratory +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +! +! +! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. +! +!********************************************************************************************************************************* +!> This module contains the user-defined types needed in GridInterp. It also contains copy, destroy, pack, and +!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. +MODULE GridInterp_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE NWTC_Library +IMPLICIT NONE +! ========= GridInterp_ParameterType ======= + TYPE, PUBLIC :: GridInterp_ParameterType + INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of evenly-spaced grid points in each dimension [-] + REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction [-] + REAL(ReKi) , DIMENSION(1:4) :: pZero = 0.0_ReKi !< fixed position of the grid starting corner (i.e., XYZW coordinates of m%V(0,0,0,0,:)) [-] + LOGICAL , DIMENSION(1:4) :: IsPeriodic = .false. !< flag to indicate whether this dimension should be treated as periodic [-] + END TYPE GridInterp_ParameterType +! ======================= +! ========= GridInterp_MiscVarType ======= + TYPE, PUBLIC :: GridInterp_MiscVarType + REAL(ReKi) , DIMENSION(1:4,1:4,1:4) :: N3D = 0.0_ReKi !< this is the weights for 3D grid values [-] + REAL(ReKi) , DIMENSION(1:4,1:4,1:4,1:4) :: N4D = 0.0_ReKi !< this is the weights for 4D grid values [-] + INTEGER(IntKi) , DIMENSION(1:4,1:4) :: Indx = 0_IntKi !< this is the neighboring node index into the grid [-] + LOGICAL :: FirstWarn_Clamp = .true. !< used to avoid too many 'Position has been clamped to the grid boundary' warning messages [-] + END TYPE GridInterp_MiscVarType +! ======================= +CONTAINS + +subroutine GridInterp_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(GridInterp_ParameterType), intent(in) :: SrcParamData + type(GridInterp_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'GridInterp_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%n = SrcParamData%n + DstParamData%delta = SrcParamData%delta + DstParamData%pZero = SrcParamData%pZero + DstParamData%IsPeriodic = SrcParamData%IsPeriodic +end subroutine + +subroutine GridInterp_DestroyParam(ParamData, ErrStat, ErrMsg) + type(GridInterp_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'GridInterp_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine GridInterp_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(GridInterp_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'GridInterp_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%n) + call RegPack(RF, InData%delta) + call RegPack(RF, InData%pZero) + call RegPack(RF, InData%IsPeriodic) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine GridInterp_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(GridInterp_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'GridInterp_UnPackParam' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%delta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pZero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IsPeriodic); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine GridInterp_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(GridInterp_MiscVarType), intent(in) :: SrcMiscData + type(GridInterp_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'GridInterp_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%N3D = SrcMiscData%N3D + DstMiscData%N4D = SrcMiscData%N4D + DstMiscData%Indx = SrcMiscData%Indx + DstMiscData%FirstWarn_Clamp = SrcMiscData%FirstWarn_Clamp +end subroutine + +subroutine GridInterp_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(GridInterp_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'GridInterp_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine GridInterp_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(GridInterp_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'GridInterp_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%N3D) + call RegPack(RF, InData%N4D) + call RegPack(RF, InData%Indx) + call RegPack(RF, InData%FirstWarn_Clamp) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine GridInterp_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(GridInterp_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'GridInterp_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%N3D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%N4D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FirstWarn_Clamp); if (RegCheckErr(RF, RoutineName)) return +end subroutine +END MODULE GridInterp_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/ModMesh.f90 b/modules/nwtc-library/src/ModMesh.f90 index 5a34676be6..f925485228 100644 --- a/modules/nwtc-library/src/ModMesh.f90 +++ b/modules/nwtc-library/src/ModMesh.f90 @@ -2928,7 +2928,7 @@ SUBROUTINE PackMotionMesh(M, Ary, indx_first, FieldMask, TrimOP) if (PackForTrimSolution) then do i=1,M%NNodes - call DCM_logMap(M%Orientation(:,:,i), logmap, ErrStat2, ErrMsg2) !NOTE: we cannot use GetSmllRotAngs because we CANNOT assume that all DCMs in the code are small. + logmap = EulerExtract(M%Orientation(:,:,i)) !NOTE: we cannot use GetSmllRotAngs because we CANNOT assume that all DCMs in the code are small. do k=1,3 Ary(indx_first) = logmap(k) indx_first = indx_first + 1 diff --git a/modules/nwtc-library/src/NWTC_C_Binding.f90 b/modules/nwtc-library/src/NWTC_C_Binding.f90 index 3677433dac..fa95c356c5 100644 --- a/modules/nwtc-library/src/NWTC_C_Binding.f90 +++ b/modules/nwtc-library/src/NWTC_C_Binding.f90 @@ -21,69 +21,167 @@ MODULE NWTC_C_Binding USE ISO_C_BINDING USE Precision -USE NWTC_Base, ONLY: ErrMsgLen +USE NWTC_Base, ONLY: ErrMsgLen, ErrID_None, ErrID_Info, ErrID_Warn, ErrID_Severe, ErrID_Fatal, SetErrStat + +IMPLICIT NONE !------------------------------------------------------------------------------------ ! Error handling ! This must exactly match the value in the python-lib. If ErrMsgLen changes at ! some point in the nwtc-library, this should be updated, but the logic exists ! to correctly handle different lengths of the strings -INTEGER(IntKi), PARAMETER :: ErrMsgLen_C = 1025 -INTEGER(IntKi), PARAMETER :: IntfStrLen = 1025 ! length of other strings through the C interface +INTEGER(IntKi), PARAMETER :: ErrMsgLen_C = ErrMsgLen + 1 ! Currently, this is 8197 +INTEGER(IntKi), PARAMETER :: IntfStrLen = 1025 ! length of other strings through the C interface such as file paths +integer(c_int), PARAMETER :: AbortErrLev_C = 4_c_int CONTAINS !> This routine sets the error status in C_CHAR for export to calling code. -!! Make absolutely certain that we do not overrun the end of ErrMsg_C. That is hard coded to 1025, -!! but ErrMsgLen is set in the nwtc_library, and could change without updates here. We don't want an -!! inadvertant buffer overrun -- that can lead to bad things. -SUBROUTINE SetErr(ErrStat, ErrMsg, ErrStat_C, ErrMsg_C) - INTEGER, INTENT(IN ) :: ErrStat !< aggregated error message (fortran type) - CHARACTER(ErrMsgLen), INTENT(IN ) :: ErrMsg !< aggregated error message (fortran type) +SUBROUTINE SetErrStat_F2C(ErrStat_F, ErrMsg_F, ErrStat_C, ErrMsg_C) + INTEGER(IntKi), INTENT(IN ) :: ErrStat_F !< aggregated error status (fortran type) + CHARACTER(ErrMsgLen), INTENT(IN ) :: ErrMsg_F !< aggregated error message (fortran type) INTEGER(C_INT), INTENT( OUT) :: ErrStat_C CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_C(ErrMsgLen_C) - ErrStat_C = ErrStat ! We will send back the same error status that is used in OpenFAST + ErrStat_C = int(ErrStat_F,c_int) ! We will send back the same error status that is used in OpenFAST if (ErrMsgLen > ErrMsgLen_C-1) then ! If ErrMsgLen is > the space in ErrMsg_C, do not copy everything over - ErrMsg_C = TRANSFER( TRIM(ErrMsg(1:ErrMsgLen_C-1))//C_NULL_CHAR, ErrMsg_C ) + ErrMsg_C = TRANSFER( TRIM(ErrMsg_F(1:ErrMsgLen_C-1))//C_NULL_CHAR, ErrMsg_C ) else - ErrMsg_C = TRANSFER( TRIM(ErrMsg)//C_NULL_CHAR, ErrMsg_C ) + ErrMsg_C = TRANSFER( TRIM(ErrMsg_F)//C_NULL_CHAR, ErrMsg_C ) endif -END SUBROUTINE SetErr +END SUBROUTINE SetErrStat_F2C + +!> This subroutine incorporates the local error status and error messages into the global error +!! status and message. It expects both local and global error messages to be null-terminated +!! C strings. +!! The routine name must be a Fortran string with assumed length. +SUBROUTINE SetErrStat_C(ErrStatLocal_C, ErrMessLocal_C, ErrStatGlobal_C, ErrMessGlobal_C, RoutineName_F) + + INTEGER(C_INT), INTENT(IN ) :: ErrStatLocal_C ! Error status of the operation + CHARACTER(KIND=C_CHAR), INTENT(IN ) :: ErrMessLocal_C(ErrMsgLen_C) ! Error message if ErrStat /= ErrID_None + INTEGER(C_INT), INTENT(INOUT) :: ErrStatGlobal_C ! Error status of the operation + CHARACTER(KIND=C_CHAR), INTENT(INOUT) :: ErrMessGlobal_C(ErrMsgLen_C) ! Error message if ErrStat /= ErrID_None + CHARACTER(*), INTENT(IN ) :: RoutineName_F ! Name of the routine error occurred in + + INTEGER(IntKi) :: ErrStatLocal_F, ErrStatGlobal_F + character(len=ErrMsgLen) :: ErrMessLocal_F, ErrMessGlobal_F + + ! Convert C strings to Fortran for easier processing within this subroutine + CALL StringConvert_C2F(ErrMessLocal_C, ErrMessLocal_F) + CALL StringConvert_C2F(ErrMessGlobal_C, ErrMessGlobal_F) + ErrStatLocal_F = INT(ErrStatLocal_C, IntKi) + ErrStatGlobal_F = INT(ErrStatGlobal_C, IntKi) + + ! Return with no-op if the local error status is None + IF ( ErrStatLocal_F == ErrID_None ) RETURN + + ! Call the standard NWTC Library error handling routine + CALL SetErrStat(ErrStatLocal_F, ErrMessLocal_F, ErrStatGlobal_F, ErrMessGlobal_F, RoutineName_F) + + ! Convert outputs back to C types + ErrStatGlobal_C = INT(ErrStatGlobal_F, C_INT) + CALL StringConvert_F2C(ErrMessGlobal_F, ErrMessGlobal_C) + +END SUBROUTINE + +SUBROUTINE StringConvert_F2C(String_F, String_C) + + ! Convert a Fortran string into a null-terminated C-string + ! NOTE this does not check whether String_C is long enough to hold the Fortran string + ! If not, it will simply overrun String_C, so the calling code must be sure. + + ! This was inspired by https://github.com/vmagnin/gtk-fortran/blob/gtk4/src/gtk-sup.f90. + + CHARACTER(LEN=*), INTENT(IN) :: String_F + CHARACTER(KIND=C_CHAR), INTENT(OUT) :: String_C(:) + + INTEGER :: i + INTEGER :: STRING_LEN + LOGICAL :: ADD_NULL + + ! Determine if the null terminator needs to be added + STRING_LEN = LEN_TRIM(String_F) -FUNCTION RemoveCStringNullChar(String_C, StringLength_C) + ! If the string is empty, add a null terminator + IF (STRING_LEN == 0) THEN + STRING_LEN = STRING_LEN + 1 + ADD_NULL = .true. + + ! Otherwise, if the last character is not a null terminator, then add it + ELSE IF (String_F(STRING_LEN:STRING_LEN) /= C_NULL_CHAR) THEN + STRING_LEN = STRING_LEN + 1 + ADD_NULL = .true. + + ! Otherwise, do not add a null terminator + ELSE + ADD_NULL = .false. + + END IF + + DO i = 1, STRING_LEN - 1 + String_C(i) = String_F(i:i) + END DO + + IF (ADD_NULL) String_C(STRING_LEN) = C_NULL_CHAR + +END SUBROUTINE + +SUBROUTINE StringConvert_C2F(String_C, String_F) + ! Convert a null-terminated C-string to a Fortran string + ! If the C string is longer than the Fortran string, it will be truncated. + + ! This was inspired by https://github.com/vmagnin/gtk-fortran/blob/gtk4/src/gtk-sup.f90. + + CHARACTER(KIND=C_CHAR), INTENT(IN) :: String_C(:) + CHARACTER(LEN=*), INTENT(OUT) :: String_F + + INTEGER :: i + + DO i = 1, SIZE(String_C) + IF (String_C(i) == C_NULL_CHAR) EXIT + IF (i > LEN(String_F)) RETURN + String_F(i:i) = String_C(i) + END DO + + String_F(i:) = '' + +END SUBROUTINE + +FUNCTION RemoveCStringNullChar(StringLength_C, String_C) INTEGER(C_INT), INTENT(IN) :: StringLength_C - CHARACTER(KIND=C_CHAR, LEN=StringLength_C), INTENT(IN) :: String_C + CHARACTER(KIND=C_CHAR), INTENT(IN) :: String_C(StringLength_C) CHARACTER(LEN=StringLength_C) :: RemoveCStringNullChar - RemoveCStringNullChar = String_C + integer :: i + + CALL StringConvert_C2F(String_C, RemoveCStringNullChar) ! if this has a c null character at the end, remove it i = INDEX(RemoveCStringNullChar, C_NULL_CHAR) - 1 - if ( i > 0 ) RemoveCStringNullChar = RemoveCStringNullChar(1:I) + IF ( i > 0 ) RemoveCStringNullChar = RemoveCStringNullChar(1:i) RETURN END FUNCTION -FUNCTION FileNameFromCString(FileString_C, FileStringLength_C) +FUNCTION FileNameFromCString(String_C, StringLength_C) !> This function takes a string from the C interface and returns a file name !> that is compatible with the Fortran interface. The C string may have !> trailing null characters that need to be removed. !> By convention, the filename must have fewer characters than IntfStrLen. - INTEGER(C_INT), INTENT(IN) :: FileStringLength_C !< length of input string from C interface - CHARACTER(KIND=C_CHAR, LEN=FileStringLength_C), INTENT(IN) :: FileString_C !< input string from C interface - CHARACTER(LEN=IntfStrLen) :: FileNameFromCString !< output file name (fortran type) + INTEGER(C_INT), INTENT(IN) :: StringLength_C !< length of input string from C interface + CHARACTER(KIND=C_CHAR, LEN=StringLength_C), INTENT(IN) :: String_C !< input string from C interface + CHARACTER(LEN=IntfStrLen) :: FileNameFromCString !< output file name (fortran type) INTEGER :: i FileNameFromCString = '' - i = MIN(IntfStrLen, FileStringLength_C) - FileNameFromCString(1:i) = FileString_C(1:i) + i = MIN(IntfStrLen, StringLength_C) + FileNameFromCString(1:i) = String_C(1:i) - FileNameFromCString = RemoveCStringNullChar(FileNameFromCString, IntfStrLen) + FileNameFromCString = RemoveCStringNullChar(IntfStrLen, FileNameFromCString) RETURN END FUNCTION -END MODULE \ No newline at end of file +END MODULE diff --git a/modules/nwtc-library/src/NWTC_IO.f90 b/modules/nwtc-library/src/NWTC_IO.f90 index 204db312bf..1fbe24a6cc 100644 --- a/modules/nwtc-library/src/NWTC_IO.f90 +++ b/modules/nwtc-library/src/NWTC_IO.f90 @@ -2354,6 +2354,8 @@ SUBROUTINE NWTC_DisplaySyntax( DefaultInputFile, ThisProgName ) //TRIM( DefaultInputFile )//'".' ) END IF CALL WrScr ( NewLine//' Note: values enclosed in square brackets [] are optional. Do not enter the brackets.') + CALL WrScr ( NewLine//' For more information and documentation, visit:' ) + CALL WrScr ( ' https://openfast.readthedocs.io/' ) CALL WrScr ( ' ') END SUBROUTINE NWTC_DisplaySyntax @@ -2398,8 +2400,9 @@ SUBROUTINE OpenBInpFile ( Un, InFile, ErrStat, ErrMsg ) OPEN( Un, FILE=TRIM( InFile ), STATUS='OLD', FORM='UNFORMATTED', ACCESS='STREAM', IOSTAT=ErrStat, ACTION='READ' ) IF ( ErrStat /= 0 ) THEN + ErrMsg = 'OpenBInpFile:Cannot open file "'//TRIM( InFile )//'" for reading. Another program may have locked it.' & + //' (IOSTAT is '//TRIM(Num2LStr(ErrStat))//')' ErrStat = ErrID_Fatal - ErrMsg = 'OpenBInpFile:Cannot open file "'//TRIM( InFile )//'" for reading. Another program may have locked it.' ELSE ErrStat = ErrID_None ErrMsg = '' @@ -2427,9 +2430,9 @@ SUBROUTINE OpenBOutFile ( Un, OutFile, ErrStat, ErrMsg ) OPEN( Un, FILE=TRIM( OutFile ), STATUS='UNKNOWN', FORM='UNFORMATTED' , ACCESS='STREAM', IOSTAT=ErrStat, ACTION='WRITE' ) IF ( ErrStat /= 0 ) THEN - ErrStat = ErrID_Fatal ErrMsg = 'OpenBOutFile:Cannot open file "'//TRIM( OutFile )//'". Another program may have locked it for writing.' & //' (IOSTAT is '//TRIM(Num2LStr(ErrStat))//')' + ErrStat = ErrID_Fatal ELSE ErrStat = ErrID_None ErrMsg = '' @@ -3038,7 +3041,7 @@ END SUBROUTINE ParseChVar !! !! WARNING: This routine assumes the "words" containing the variable name and value are <= 20 characters. !! Use ParseVarWDefault (nwtc_io::parsevarwdefault) instead of directly calling a specific routine in the generic interface. - SUBROUTINE ParseChVarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, ErrStat, ErrMsg, UnEc ) + SUBROUTINE ParseChVarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, ErrStat, ErrMsg, UnEcIn ) ! Arguments declarations. @@ -3046,7 +3049,7 @@ SUBROUTINE ParseChVarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error status. INTEGER(IntKi), INTENT(INOUT) :: LineNum !< The number of the line to parse. - INTEGER, INTENT(IN), OPTIONAL :: UnEc !< I/O unit for echo file. If present and > 0, write to UnEc. + INTEGER, INTENT(IN), OPTIONAL :: UnEcIn ! I/O unit for echo file. If present and > 0, write to UnEc. CHARACTER(*), INTENT(OUT) :: Var !< The variable to receive the input value. CHARACTER(*), INTENT(IN) :: VarDefault !< The default value for the variable. @@ -3058,6 +3061,7 @@ SUBROUTINE ParseChVarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, ! Local declarations. + INTEGER :: UnEc ! I/O unit for echo file. INTEGER(IntKi) :: ErrStatLcl ! Error status local to this routine. CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3066,6 +3070,12 @@ SUBROUTINE ParseChVarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, ErrStat=ErrID_None ErrMsg = "" + + if (PRESENT(UnEcIn)) then + UnEc = UnEcIn + else + UnEc = 0 + end if ! First parse this as a string CALL ParseVar ( FileInfo, LineNum, ExpVarName, defaultStr, ErrStatLcl, ErrMsg2, UnEc ) @@ -3218,7 +3228,7 @@ SUBROUTINE ParseR8Var ( FileInfo, LineNum, ExpVarName, Var, ErrStat, ErrMsg, UnE END SUBROUTINE ParseR8Var !======================================================================= !> \copydoc nwtc_io::parsechvarwdefault - SUBROUTINE ParseR8VarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, ErrStat, ErrMsg, UnEc ) + SUBROUTINE ParseR8VarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, ErrStat, ErrMsg, UnEcIn ) ! Arguments declarations. @@ -3226,7 +3236,7 @@ SUBROUTINE ParseR8VarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, INTEGER(IntKi), INTENT(OUT) :: ErrStat ! The error status. INTEGER(IntKi), INTENT(INOUT) :: LineNum ! The number of the line to parse. - INTEGER, INTENT(IN), OPTIONAL :: UnEc ! I/O unit for echo file. If present and > 0, write to UnEc. + INTEGER, INTENT(IN), OPTIONAL :: UnEcIn ! I/O unit for echo file. If present and > 0, write to UnEc. REAL(R8Ki), INTENT(OUT) :: Var ! The double-precision REAL variable to receive the input value. REAL(R8Ki), INTENT(IN) :: VarDefault ! The double-precision REAL used as the default. @@ -3238,6 +3248,7 @@ SUBROUTINE ParseR8VarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, ! Local declarations. + INTEGER :: UnEc ! I/O unit for echo file. INTEGER(IntKi) :: ErrStatLcl ! Error status local to this routine. CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3247,6 +3258,12 @@ SUBROUTINE ParseR8VarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, ErrStat=ErrID_None ErrMsg = "" + if (PRESENT(UnEcIn)) then + UnEc = UnEcIn + else + UnEc = 0 + end if + ! First parse this as a string CALL ParseVar ( FileInfo, LineNum, ExpVarName, defaultStr, ErrStatLcl, ErrMsg2, UnEc ) CALL SetErrStat(ErrStatLcl, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -3515,7 +3532,7 @@ SUBROUTINE ParseInVar ( FileInfo, LineNum, ExpVarName, Var, ErrStat, ErrMsg, UnE END SUBROUTINE ParseInVar !======================================================================= !> \copydoc nwtc_io::parsechvarwdefault - SUBROUTINE ParseInVarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, ErrStat, ErrMsg, UnEc ) + SUBROUTINE ParseInVarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, ErrStat, ErrMsg, UnEcIn ) ! This subroutine parses the specified line of text for two words. One should be a ! the name of a integer variable and the other an integer value. @@ -3530,7 +3547,7 @@ SUBROUTINE ParseInVarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, INTEGER(IntKi), INTENT(OUT) :: ErrStat ! The error status. INTEGER(IntKi), INTENT(INOUT) :: LineNum ! The number of the line to parse. - INTEGER, INTENT(IN), OPTIONAL :: UnEc ! I/O unit for echo file. If present and > 0, write to UnEc. + INTEGER, INTENT(IN), OPTIONAL :: UnEcIn ! I/O unit for echo file. If present and > 0, write to UnEc. INTEGER(IntKi), INTENT(OUT) :: Var ! The INTEGER variable to receive the input value. INTEGER(IntKi), INTENT(IN) :: VarDefault ! The INTEGER used as the default. @@ -3542,6 +3559,7 @@ SUBROUTINE ParseInVarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, ! Local declarations. + INTEGER :: UnEc ! I/O unit for echo file. INTEGER(IntKi) :: ErrStatLcl ! Error status local to this routine. CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3550,6 +3568,12 @@ SUBROUTINE ParseInVarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, ErrStat=ErrID_None ErrMsg = "" + + if (PRESENT(UnEcIn)) then + UnEc = UnEcIn + else + UnEc = 0 + end if ! First parse this as a string CALL ParseVar ( FileInfo, LineNum, ExpVarName, defaultStr, ErrStatLcl, ErrMsg2, UnEc ) @@ -3702,7 +3726,7 @@ SUBROUTINE ParseLoVar ( FileInfo, LineNum, ExpVarName, Var, ErrStat, ErrMsg, UnE END SUBROUTINE ParseLoVar !======================================================================= !> \copydoc nwtc_io::parsechvarwdefault - SUBROUTINE ParseLoVarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, ErrStat, ErrMsg, UnEc ) + SUBROUTINE ParseLoVarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, ErrStat, ErrMsg, UnEcIn ) ! Arguments declarations. @@ -3710,7 +3734,7 @@ SUBROUTINE ParseLoVarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, INTEGER(IntKi), INTENT(OUT) :: ErrStat ! The error status. INTEGER(IntKi), INTENT(INOUT) :: LineNum ! The number of the line to parse. - INTEGER, INTENT(IN), OPTIONAL :: UnEc ! I/O unit for echo file. If present and > 0, write to UnEc. + INTEGER, INTENT(IN), OPTIONAL :: UnEcIn ! I/O unit for echo file. If present and > 0, write to UnEc. LOGICAL, INTENT(OUT) :: Var ! The LOGICAL variable to receive the input value. LOGICAL, INTENT(IN) :: VarDefault ! The LOGICAL used as the default. @@ -3722,6 +3746,7 @@ SUBROUTINE ParseLoVarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, ! Local declarations. + INTEGER :: UnEc ! I/O unit for echo file. INTEGER(IntKi) :: ErrStatLcl ! Error status local to this routine. CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3731,6 +3756,12 @@ SUBROUTINE ParseLoVarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, ErrStat=ErrID_None ErrMsg = "" + if (PRESENT(UnEcIn)) then + UnEc = UnEcIn + else + UnEc = 0 + end if + ! First parse this as a string CALL ParseVar ( FileInfo, LineNum, ExpVarName, defaultStr, ErrStatLcl, ErrMsg2, UnEc ) CALL SetErrStat(ErrStatLcl, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -3881,7 +3912,7 @@ SUBROUTINE ParseSiVar ( FileInfo, LineNum, ExpVarName, Var, ErrStat, ErrMsg, UnE END SUBROUTINE ParseSiVar !======================================================================= !> \copydoc nwtc_io::parsechvarwdefault - SUBROUTINE ParseSiVarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, ErrStat, ErrMsg, UnEc ) + SUBROUTINE ParseSiVarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, ErrStat, ErrMsg, UnEcIn ) ! Arguments declarations. @@ -3889,7 +3920,7 @@ SUBROUTINE ParseSiVarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, INTEGER(IntKi), INTENT(OUT) :: ErrStat ! The error status. INTEGER(IntKi), INTENT(INOUT) :: LineNum ! The number of the line to parse. - INTEGER, INTENT(IN), OPTIONAL :: UnEc ! I/O unit for echo file. If present and > 0, write to UnEc. + INTEGER, INTENT(IN), OPTIONAL :: UnEcIn ! I/O unit for echo file. If present and > 0, write to UnEc. REAL(SiKi), INTENT(OUT) :: Var ! The single-precision REAL variable to receive the input value. REAL(SiKi), INTENT(IN) :: VarDefault ! The single-precision REAL used as the default. @@ -3901,6 +3932,7 @@ SUBROUTINE ParseSiVarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, ! Local declarations. + INTEGER :: UnEc ! I/O unit for echo file. INTEGER(IntKi) :: ErrStatLcl ! Error status local to this routine. CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3909,6 +3941,12 @@ SUBROUTINE ParseSiVarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, ErrStat=ErrID_None ErrMsg = "" + + if (PRESENT(UnEcIn)) then + UnEc = UnEcIn + else + UnEc = 0 + end if ! First parse this as a string CALL ParseVar ( FileInfo, LineNum, ExpVarName, defaultStr, ErrStatLcl, ErrMsg2, UnEc ) diff --git a/modules/nwtc-library/src/NWTC_Num.f90 b/modules/nwtc-library/src/NWTC_Num.f90 index 928321affb..5cafdc9498 100644 --- a/modules/nwtc-library/src/NWTC_Num.f90 +++ b/modules/nwtc-library/src/NWTC_Num.f90 @@ -301,18 +301,24 @@ SUBROUTINE AddOrSub2Pi_R4 ( OldAngle, NewAngle ) ! Local declarations: REAL(SiKi) :: DelAngle ! The difference between OldAngle and NewAngle, rad. - + integer :: n, i ! Add or subtract 2*Pi in order to convert NewAngle two within Pi of OldAngle: + DelAngle = OldAngle - NewAngle + n = int(DelAngle / TwoPi_R4) + NewAngle = NewAngle + n * TwoPi_R4 DelAngle = OldAngle - NewAngle + - DO WHILE ( ABS( DelAngle ) > Pi_R4 ) + i = 0 + DO WHILE ( ABS( DelAngle ) > Pi_R4 .and. .not. EqualRealNos(OldAngle, NewAngle) .and. i < 10) NewAngle = NewAngle + SIGN( TwoPi_R4, DelAngle ) DelAngle = OldAngle - NewAngle + i = i + 1 END DO @@ -331,6 +337,7 @@ SUBROUTINE AddOrSub2Pi_R8 ( OldAngle, NewAngle ) ! Local declarations: REAL(R8Ki) :: DelAngle ! The difference between OldAngle and NewAngle, rad. + integer :: n, i @@ -339,17 +346,23 @@ SUBROUTINE AddOrSub2Pi_R8 ( OldAngle, NewAngle ) DelAngle = OldAngle - NewAngle - DO WHILE ( ABS( DelAngle ) > Pi_R8 ) + n = int(DelAngle / TwoPi_R8) + NewAngle = NewAngle + n * TwoPi_R8 + DelAngle = OldAngle - NewAngle + + i = 0 + DO WHILE ( ABS( DelAngle ) > Pi_R8 .and. .not. EqualRealNos(OldAngle, NewAngle) .and. i < 10) NewAngle = NewAngle + SIGN( TwoPi_R8, DelAngle ) DelAngle = OldAngle - NewAngle + i = i + 1 END DO RETURN END SUBROUTINE AddOrSub2Pi_R8 !======================================================================= - FUNCTION BlendCosine( x, LowerBound, UpperBound ) RESULT(S) + PURE FUNCTION BlendCosine( x, LowerBound, UpperBound ) RESULT(S) REAL(ReKi), INTENT(IN) :: x ! REAL(ReKi), INTENT(IN) :: LowerBound !< if x <= LowerBound, S=0 @@ -1006,12 +1019,7 @@ END FUNCTION CubicSplineInterp ! ( X, AryLen, XAry, YAry, Coef, ErrStat, ErrMsg !! One must call cubicsplineinit first to compute the coefficients of the cubics. !! This routine does not require that the XAry be regularly spaced. !! This version of the routine works with multiple curves that share the same X values. - FUNCTION CubicSplineInterpM ( X, XAry, YAry, Coef, ErrStat, ErrMsg ) RESULT( Res ) - - ! Function declaration. - - REAL(ReKi), ALLOCATABLE :: Res(:) ! The result of this function - + SUBROUTINE CubicSplineInterpM ( X, XAry, YAry, Coef, Res ) ! Argument declarations: @@ -1019,46 +1027,31 @@ FUNCTION CubicSplineInterpM ( X, XAry, YAry, Coef, ErrStat, ErrMsg ) RESULT( Res REAL(ReKi), INTENT(IN) :: X !< The value we are trying to interpolate for REAL(ReKi), INTENT(IN) :: XAry (:) !< Input array of regularly spaced x values REAL(ReKi), INTENT(IN) :: YAry (:,:) !< Input array of y values with multiple curves - - INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status - - CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message + REAL(ReKi), INTENT(OUT) :: Res(:) !< The result of this function ! Local declarations. REAL(ReKi) :: XOff ! The distance from X to XAry(ILo). + REAL(ReKi) :: XOff2 ! The distance from X to XAry(ILo). + REAL(ReKi) :: XOff3 ! The distance from X to XAry(ILo). - INTEGER(IntKi) :: ErrStatLcL ! Local error status. INTEGER :: ILo ! The index into the array for which X is just above or equal to XAry(ILo). - INTEGER :: NumCrvs ! Number of curves to be interpolated. INTEGER :: NumPts ! Number of points in each curve. - CHARACTER(*), PARAMETER :: RoutineName = 'RegCubicSplineInterpM' ! How big are the arrays? NumPts = SIZE( XAry ) - NumCrvs = SIZE( YAry, 2 ) - - ALLOCATE ( Res( NumCrvs ) , STAT=ErrStatLcl ) - IF ( ErrStatLcl /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = RoutineName//':Error allocating memory for the function result array.' - RETURN - ELSE - ErrStat = ErrID_None - ErrMsg = "" - ENDIF ! See if X is within the range of XAry. Return the end point if it is not. IF ( X <= XAry(1) ) THEN - Res(:) = YAry(1,:) + Res = YAry(1,:) RETURN ELSEIF ( X >= XAry(NumPts) ) THEN - Res(:) = YAry(NumPts,:) + Res = YAry(NumPts,:) RETURN ENDIF ! ( X <= XAry(1) ) @@ -1068,12 +1061,14 @@ FUNCTION CubicSplineInterpM ( X, XAry, YAry, Coef, ErrStat, ErrMsg ) RESULT( Res CALL LocateBin( X, XAry, ILo, NumPts ) XOff = X - XAry(ILo) + XOff2 = XOff * XOff + XOff3 = XOff2 * XOff - Res(:) = Coef(ILo,:,0) + XOff*( Coef(ILo,:,1) + XOff*( Coef(ILo,:,2) + XOff*Coef(ILo,:,3) ) ) + Res = Coef(ILo,:,0) + Coef(ILo,:,1)*XOff + Coef(ILo,:,2) * XOff2 + Coef(ILo,:,3)*XOff3 RETURN - END FUNCTION CubicSplineInterpM ! ( X, XAry, YAry, Coef, ErrStat, ErrMsg ) + END SUBROUTINE CubicSplineInterpM !======================================================================= !> This function returns the matrix exponential, \f$\Lambda = \exp(\lambda)\f$, of an input skew-symmetric matrix, \f$\lambda\f$. !! @@ -1265,18 +1260,18 @@ END FUNCTION DCM_expR !! Use DCM_logMap (nwtc_num::dcm_logmap) instead of directly calling a specific routine in the generic interface. SUBROUTINE DCM_logMapD(DCM, logMap, ErrStat, ErrMsg, thetaOut) - REAL(DbKi), INTENT(IN) :: DCM(3,3) !< the direction cosine matrix, \f$\Lambda\f$ - REAL(DbKi), INTENT( OUT) :: logMap(3) !< vector containing \f$\lambda_1\f$, \f$\lambda_2\f$, and \f$\lambda_3\f$, the unique components of skew-symmetric matrix \f$\lambda\f$ - REAL(DbKi),OPTIONAL,INTENT( OUT) :: thetaOut !< the angle of rotation, \f$\theta\f$; output only for debugging + REAL(R8Ki), INTENT(IN) :: DCM(3,3) !< the direction cosine matrix, \f$\Lambda\f$ + REAL(R8Ki), INTENT( OUT) :: logMap(3) !< vector containing \f$\lambda_1\f$, \f$\lambda_2\f$, and \f$\lambda_3\f$, the unique components of skew-symmetric matrix \f$\lambda\f$ + REAL(R8Ki),OPTIONAL,INTENT( OUT) :: thetaOut !< the angle of rotation, \f$\theta\f$; output only for debugging INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: theta - REAL(DbKi) :: cosTheta - REAL(DbKi) :: TwoSinTheta - REAL(DbKi) :: v(3) - REAL(DbKi) :: divisor + REAL(R8Ki) :: theta + REAL(R8Ki) :: cosTheta + REAL(R8Ki) :: TwoSinTheta + REAL(R8Ki) :: v(3) + REAL(R8Ki) :: divisor INTEGER(IntKi) :: indx_max ! initialization @@ -1284,8 +1279,8 @@ SUBROUTINE DCM_logMapD(DCM, logMap, ErrStat, ErrMsg, thetaOut) ErrMsg = "" - cosTheta = 0.5_DbKi*( trace(DCM) - 1.0_DbKi ) - cosTheta = min( max(cosTheta,-1.0_DbKi), 1.0_DbKi ) !make sure it's in a valid range (to avoid cases where this is slightly outside the +/-1 range) + cosTheta = 0.5_DbKi*( trace(DCM) - 1.0_R8Ki ) + cosTheta = min( max(cosTheta,-1.0_R8Ki), 1.0_R8Ki ) !make sure it's in a valid range (to avoid cases where this is slightly outside the +/-1 range) theta = ACOS( cosTheta ) ! Eq. 25 ( 0<=theta<=pi ) IF ( PRESENT( thetaOut ) ) THEN @@ -1341,13 +1336,13 @@ SUBROUTINE DCM_logMapD(DCM, logMap, ErrStat, ErrMsg, thetaOut) v(3) = -DCM(2,1) + DCM(1,2) !-skewSym(2,1) = 2*sin(theta)/theta * lambda(3) = (small positive value with theta near pi) * lambda(3) indx_max = maxloc( abs(v), 1 ) ! find component with largest magnitude - if ( .not. EqualRealNos( sign(1.0_DbKi,v(indx_max)), sign(1.0_DbKi,logMap(indx_max)) )) logMap = -logMap + if ( .not. EqualRealNos( sign(1.0_R8Ki,v(indx_max)), sign(1.0_R8Ki,logMap(indx_max)) )) logMap = -logMap ELSE - TwoSinTheta = 2.0_DbKi*sin(theta) + TwoSinTheta = 2.0_R8Ki*sin(theta) - IF ( EqualRealNos(0.0_DbKi, theta) .or. EqualRealNos( 0.0_DbKi, TwoSinTheta ) ) THEN + IF ( EqualRealNos(0.0_R8Ki, theta) .or. EqualRealNos( 0.0_DbKi, TwoSinTheta ) ) THEN !skewSym = DCM - TRANSPOSE(DCM) ! @@ -1490,13 +1485,13 @@ END SUBROUTINE DCM_logMapR !! Use DCM_SetLogMapForInterp (nwtc_num::dcm_setlogmapforinterp) instead of directly calling a specific routine in the generic interface. SUBROUTINE DCM_SetLogMapForInterpD( tensor ) - REAL(DbKi), INTENT(INOUT) :: tensor(:,:) !< a 3xn matrix, whose columns represent individual skew-symmetric matrices. On exit, + REAL(R8Ki), INTENT(INOUT) :: tensor(:,:) !< a 3xn matrix, whose columns represent individual skew-symmetric matrices. On exit, !! each column will be within \f$2\pi\f$ of the previous column, allowing for interpolation !! of the quantities. - REAL(DbKi) :: diff1, diff2 ! magnitude-squared of difference between two adjacent values - REAL(DbKi) :: temp(3), temp1(3) ! difference between two tensors - REAL(DbKi) :: period(3) ! the period to add to the rotational parameters + REAL(R8Ki) :: diff1, diff2 ! magnitude-squared of difference between two adjacent values + REAL(R8Ki) :: temp(3), temp1(3) ! difference between two tensors + REAL(R8Ki) :: period(3) ! the period to add to the rotational parameters INTEGER(IntKi) :: nc ! size of the tensors matrix INTEGER(IntKi) :: ic ! loop counters for each array dimension @@ -1765,7 +1760,7 @@ END FUNCTION EulerConstructR4 FUNCTION EulerConstructR8(theta) result(M) ! this function creates a rotation matrix, M, from a 3-2-1 intrinsic rotation -!! sequence of the 3 Tait-Bryan angles (1-2-3 extrinsic rotation), theta_x, theta_y, and theta_z, in radians. + ! sequence of the 3 Tait-Bryan angles (1-2-3 extrinsic rotation), theta_x, theta_y, and theta_z, in radians. ! M represents a change of basis (from global to local coordinates; ! not a physical rotation of the body). it is the inverse of EulerExtract (nwtc_num::eulerextract). ! @@ -4159,17 +4154,18 @@ subroutine kernelSmoothing(x, f, kernelType, radius, fNew) REAL(ReKi) :: k REAL(ReKi) :: k_sum REAL(ReKi) :: w + REAL(ReKi) :: RadiusFix INTEGER(IntKi) :: Exp1 INTEGER(IntKi) :: Exp2 REAL(ReKi) :: u(size(x)) INTEGER :: i, j INTEGER :: n - ! check that radius > 0 ! check that size(x) = size(f)=size(fNew) ! check that kernelType is a valid number n = size(x) + RadiusFix = max(abs(radius),epsilon(radius)) ! ensure radius is a positive number ! make sure that the value of u is in [-1 and 1] for these kernels: @@ -4197,7 +4193,7 @@ subroutine kernelSmoothing(x, f, kernelType, radius, fNew) fNew = 0.0_ReKi ! whole array operation do j=1,n ! for each value in f: - u = (x - x(j)) / radius ! whole array operation + u = (x - x(j)) / RadiusFix ! whole array operation do i=1,n u(i) = min( 1.0_ReKi, max( -1.0_ReKi, u(i) ) ) end do @@ -4220,7 +4216,7 @@ subroutine kernelSmoothing(x, f, kernelType, radius, fNew) fNew = 0.0_ReKi ! whole array operation do j=1,n ! for each value in f: - u = (x - x(j)) / radius ! whole array operation + u = (x - x(j)) / RadiusFix ! whole array operation k_sum = 0.0_ReKi do i=1,n @@ -5411,7 +5407,7 @@ END SUBROUTINE RombergInt !======================================================================= !> This routine displays a message that gives that status of the simulation and the predicted end time of day. !! It is intended to be used with SimStatus (nwtc_num::simstatus) and SimStatus_FirstTime (nwtc_num::simstatus_firsttime). - SUBROUTINE RunTimes( StrtTime, UsrTime1, SimStrtTime, UsrTime2, ZTime, UnSum, UsrTime_out, DescStrIn ) + SUBROUTINE RunTimes( StrtTime, UsrTime1, SimStrtTime, UsrTime2, ZTime, UnSum, UsrTime_out, DescStrIn, useCases ) IMPLICIT NONE @@ -5423,6 +5419,7 @@ SUBROUTINE RunTimes( StrtTime, UsrTime1, SimStrtTime, UsrTime2, ZTime, UnSum, Us REAL(ReKi), INTENT(IN) :: UsrTime2 !< User CPU time for simulation (without initialization) REAL(DbKi), INTENT(IN) :: ZTime !< The final simulation time (not necessarially TMax) INTEGER(IntKi), INTENT(IN), OPTIONAL:: UnSum !< optional unit number of file. If present and > 0, + LOGICAL, INTENT(IN), OPTIONAL:: useCases !< optional number of cases. If present and > 0, ZTime represents number of cases, not time (for steady-state outputs) REAL(ReKi), INTENT(OUT),OPTIONAL:: UsrTime_out !< User CPU time for entire run - optional value returned to calling routine CHARACTER(*), INTENT(IN), OPTIONAL :: DescStrIn !< optional additional string to print for SimStatus @@ -5441,7 +5438,8 @@ SUBROUTINE RunTimes( StrtTime, UsrTime1, SimStrtTime, UsrTime2, ZTime, UnSum, Us CHARACTER( 8) :: TimePer CHARACTER(MaxWrScrLen) :: BlankLine - CHARACTER(10) :: DescStr !< optional additional string to print for SimStatus + CHARACTER(10) :: DescStr !< optional additional string to print for SimStatus + LOGICAL :: UseCaseStr !< use cases if (present(DescStrIn)) then @@ -5450,6 +5448,13 @@ SUBROUTINE RunTimes( StrtTime, UsrTime1, SimStrtTime, UsrTime2, ZTime, UnSum, Us DescStr = "" end if + if (present(useCases)) then + UseCaseStr = useCases + else + UseCaseStr = .false. + end if + + ! Get the end times to compare with start times. CALL DATE_AND_TIME ( VALUES=EndTimes ) @@ -5494,9 +5499,14 @@ SUBROUTINE RunTimes( StrtTime, UsrTime1, SimStrtTime, UsrTime2, ZTime, UnSum, Us CALL WrScr ( ' Total CPU Time: '//TRIM( Num2LStr( Factor*UsrTime ) )//TRIM( TimePer ) ) ! CALL WrScr ( ' ') ! CALL WrScr ( ' Simulation Real Time: '//TRIM( Num2LStr( Factor*ClckTimeSim ) )//TRIM( TimePer ) ) - CALL WrScr ( ' Simulation CPU Time: '//TRIM( Num2LStr( Factor*UsrTimeSim ) )//TRIM( TimePer ) ) - CALL WrScr ( ' Simulated Time: '//TRIM( Num2LStr( Factor*REAL( ZTime ) ) )//TRIM( TimePer ) ) - CALL WrScr ( ' Time Ratio (Sim/CPU): '//TRIM( Num2LStr( TRatio ) ) ) + CALL WrScr ( ' Simulation CPU Time: '//TRIM( Num2LStr( Factor*UsrTimeSim ) )//TRIM( TimePer ) ) + if (UseCaseStr) then + CALL WrScr ( ' Simulated Cases: '//TRIM( Num2LStr( REAL( ZTime ) ) ) ) + CALL WrScr ( ' Time Ratio (CPU/case): '//TRIM( Num2LStr( Factor/TRatio ) )//TRIM(TimePer)//' per case' ) + else + CALL WrScr ( ' Simulated Time: '//TRIM( Num2LStr( Factor*REAL( ZTime ) ) )//TRIM( TimePer ) ) + CALL WrScr ( ' Time Ratio (Sim/CPU): '//TRIM( Num2LStr( TRatio ) ) ) + end if IF (PRESENT(UnSum)) THEN IF (UnSum>0) THEN @@ -5504,8 +5514,13 @@ SUBROUTINE RunTimes( StrtTime, UsrTime1, SimStrtTime, UsrTime2, ZTime, UnSum, Us WRITE( UnSum, '(A)') ' Total Real Time: '//TRIM( Num2LStr( Factor*ClckTime ) )//TRIM( TimePer ) WRITE( UnSum, '(A)') ' Total CPU Time: '//TRIM( Num2LStr( Factor*UsrTime ) )//TRIM( TimePer ) WRITE( UnSum, '(A)') ' Simulation CPU Time: '//TRIM( Num2LStr( Factor*UsrTimeSim ) )//TRIM( TimePer ) - WRITE( UnSum, '(A)') ' Simulated Time: '//TRIM( Num2LStr( Factor*REAL( ZTime ) ) )//TRIM( TimePer ) - WRITE( UnSum, '(A)') ' Time Ratio (Sim/CPU): '//TRIM( Num2LStr( TRatio ) ) + if (UseCaseStr) then + WRITE( UnSum, '(A)') ' Simulated Cases: '//TRIM( Num2LStr( REAL( ZTime ) ) ) + WRITE( UnSum, '(A)') ' Time Ratio (CPU/case): '//TRIM( Num2LStr( Factor/TRatio ) )//TRIM(TimePer)//' per case' + else + WRITE( UnSum, '(A)') ' Simulated Time: '//TRIM( Num2LStr( Factor*REAL( ZTime ) ) )//TRIM( TimePer ) + WRITE( UnSum, '(A)') ' Time Ratio (Sim/CPU): '//TRIM( Num2LStr( TRatio ) ) + end if END IF END IF @@ -5624,7 +5639,7 @@ END SUBROUTINE SetConstants !======================================================================= !> This routine displays a message that gives that status of the simulation. !! It is intended to be used with RunTimes (nwtc_num::runtimes) and SimStatus (nwtc_num::simstatus). - SUBROUTINE SimStatus_FirstTime( PrevSimTime, PrevClockTime, SimStrtTime, UsrTimeSim, ZTime, TMax, DescStrIn ) + SUBROUTINE SimStatus_FirstTime( PrevSimTime, PrevClockTime, SimStrtTime, UsrTimeSim, ZTime, TMax, DescStrIn, useCases) IMPLICIT NONE @@ -5637,12 +5652,12 @@ SUBROUTINE SimStatus_FirstTime( PrevSimTime, PrevClockTime, SimStrtTime, UsrTime REAL(ReKi), INTENT( OUT) :: UsrTimeSim !< User CPU time for simulation (without initialization) CHARACTER(*), INTENT(IN), OPTIONAL :: DescStrIn !< optional additional string to print for SimStatus - - ! Local variables. + LOGICAL, INTENT(IN), OPTIONAL :: useCases !< optional number of cases. If present and > 0, ZTime represents number of cases, not time (for steady-state outputs) + ! Local variables REAL(ReKi) :: CurrClockTime ! Current time in seconds past midnight. - CHARACTER(10) :: DescStr !< optional additional string to print for SimStatus - + CHARACTER(10) :: DescStr !< optional additional string to print for SimStatus + LOGICAL :: UseCaseStr !< use cases if (present(DescStrIn)) then DescStr = DescStrIn @@ -5650,6 +5665,11 @@ SUBROUTINE SimStatus_FirstTime( PrevSimTime, PrevClockTime, SimStrtTime, UsrTime DescStr = "" end if + if (present(useCases)) then + UseCaseStr = useCases + else + UseCaseStr = .false. + end if ! How many seconds past midnight? @@ -5659,7 +5679,7 @@ SUBROUTINE SimStatus_FirstTime( PrevSimTime, PrevClockTime, SimStrtTime, UsrTime CurrClockTime = TimeValues2Seconds( SimStrtTime ) - + if (.NOT. UseCaseStr) & CALL WrScr ( trim(DescStr)//' Time: '//TRIM( Num2LStr( NINT( ZTime ) ) )//' of '//TRIM( Num2LStr( TMax ) )//' seconds.') diff --git a/modules/nwtc-library/src/NetLib/slatec/NWTC_SLATEC.f90 b/modules/nwtc-library/src/NetLib/slatec/NWTC_SLATEC.f90 index bd95760387..efd7665864 100644 --- a/modules/nwtc-library/src/NetLib/slatec/NWTC_SLATEC.f90 +++ b/modules/nwtc-library/src/NetLib/slatec/NWTC_SLATEC.f90 @@ -45,11 +45,11 @@ MODULE NWTC_SLATEC !> Single precision wrapper for the qk61 integration routine from the slatec library - !! Note that the qk61 routine follows -fdefault-real-8 setting, so it is of type ReKi + !! Note that the qk61 routine follows -fdefault-real-4 setting, so it is of type ReKi subroutine wrap_qk61(func,low,hi,answer,abserr,resabs,resasc) real(R4Ki), intent(in ) :: low,hi ! integration limits real(R4Ki), intent( out) :: answer - real(R4Ki), intent(in ) :: abserr,resabs,resasc + real(R4Ki), intent( out) :: abserr,resabs,resasc real(R4Ki), external :: func ! function call qk61(func,low,hi,answer,abserr,resabs,resasc) end subroutine wrap_qk61 @@ -59,7 +59,7 @@ end subroutine wrap_qk61 subroutine wrap_dqk61(func,low,hi,answer,abserr,resabs,resasc) real(R8Ki), intent(in ) :: low,hi ! integration limits real(R8Ki), intent( out) :: answer - real(R8Ki), intent(in ) :: abserr,resabs,resasc + real(R8Ki), intent( out) :: abserr,resabs,resasc real(R8Ki), external :: func ! function call dqk61(func,low,hi,answer,abserr,resabs,resasc) end subroutine wrap_dqk61 diff --git a/modules/nwtc-library/src/SysFlangLinux.f90 b/modules/nwtc-library/src/SysFlangLinux.f90 index 42f04c2d60..621e405528 100644 --- a/modules/nwtc-library/src/SysFlangLinux.f90 +++ b/modules/nwtc-library/src/SysFlangLinux.f90 @@ -55,7 +55,7 @@ MODULE SysSubs END INTERFACE INTEGER, PARAMETER :: ConRecL = 120 ! The record length for console output. - INTEGER, PARAMETER :: CU = 6 ! The I/O unit for the console. Unit 6 causes ADAMS to crash. + INTEGER, PUBLIC :: CU = 6 ! The I/O unit for the console. Unit 6 causes ADAMS to crash. INTEGER, PARAMETER :: MaxWrScrLen = 98 ! The maximum number of characters allowed to be written to a line in WrScr LOGICAL, PARAMETER :: KBInputOK = .TRUE. ! A flag to tell the program that keyboard input is allowed in the environment. CHARACTER(*), PARAMETER :: NewLine = ACHAR(10) ! The delimiter for New Lines [ Windows is CHAR(13)//CHAR(10); MAC is CHAR(13); Unix is CHAR(10) {CHAR(13)=\r is a line feed, CHAR(10)=\n is a new line}] @@ -107,7 +107,15 @@ FUNCTION dlClose(handle) BIND(C,NAME="dlclose") CONTAINS - + !======================================================================= + SUBROUTINE SetConsoleUnit( Unit ) + ! This subroutine sets the console unit for output. + + INTEGER, INTENT(IN) :: Unit !< The new I/O unit number for the console. + CU = Unit + + END SUBROUTINE SetConsoleUnit + !======================================================================= FUNCTION Is_NaN( DblNum ) ! This routine determines if a REAL(DbKi) variable holds a proper number. @@ -458,4 +466,4 @@ SUBROUTINE FreeDynamicLib ( DLL, ErrStat, ErrMsg ) END SUBROUTINE FreeDynamicLib !======================================================================= END MODULE SysSubs - \ No newline at end of file + diff --git a/modules/nwtc-library/src/SysGnuLinux.f90 b/modules/nwtc-library/src/SysGnuLinux.f90 index d45d88b3c4..0fb51921b3 100644 --- a/modules/nwtc-library/src/SysGnuLinux.f90 +++ b/modules/nwtc-library/src/SysGnuLinux.f90 @@ -56,7 +56,7 @@ MODULE SysSubs END INTERFACE INTEGER, PARAMETER :: ConRecL = 120 ! The record length for console output. - INTEGER, PARAMETER :: CU = 6 ! The I/O unit for the console. + INTEGER, PUBLIC :: CU = 6 ! The I/O unit for the console (Can be changed with SetConsoleUnit subroutine) INTEGER, PARAMETER :: MaxWrScrLen = 98 ! The maximum number of characters allowed to be written to a line in WrScr LOGICAL, PARAMETER :: KBInputOK = .TRUE. ! A flag to tell the program that keyboard input is allowed in the environment. CHARACTER(*), PARAMETER :: NewLine = ACHAR(10) ! The delimiter for New Lines [ Windows is CHAR(13)//CHAR(10); MAC is CHAR(13); Unix is CHAR(10) {CHAR(13)=\r is a line feed, CHAR(10)=\n is a new line}] @@ -89,6 +89,14 @@ FUNCTION FileSize( Unit ) RETURN END FUNCTION FileSize ! ( Unit ) !======================================================================= +SUBROUTINE SetConsoleUnit( Unit ) + ! This subroutine sets the console unit for output. + +INTEGER, INTENT(IN) :: Unit !< The new I/O unit number for the console. +CU = Unit + +END SUBROUTINE SetConsoleUnit +!======================================================================= FUNCTION Is_NaN( DblNum ) ! This routine determines if a REAL(DbKi) variable holds a proper number. diff --git a/modules/nwtc-library/src/SysGnuWin.f90 b/modules/nwtc-library/src/SysGnuWin.f90 index 0905792bbc..95794cf195 100644 --- a/modules/nwtc-library/src/SysGnuWin.f90 +++ b/modules/nwtc-library/src/SysGnuWin.f90 @@ -56,7 +56,7 @@ MODULE SysSubs END INTERFACE INTEGER, PARAMETER :: ConRecL = 120 ! The record length for console output. - INTEGER, PARAMETER :: CU = 6 ! The I/O unit for the console. + INTEGER, PUBLIC :: CU = 6 ! The I/O unit for the console (Can be changed with SetConsoleUnit subroutine) INTEGER, PARAMETER :: MaxWrScrLen = 98 ! The maximum number of characters allowed to be written to a line in WrScr LOGICAL, PARAMETER :: KBInputOK = .TRUE. ! A flag to tell the program that keyboard input is allowed in the environment. CHARACTER(*), PARAMETER :: NewLine = ACHAR(10) ! The delimiter for New Lines [ Windows is CHAR(13)//CHAR(10); MAC is CHAR(13); Unix is CHAR(10) {CHAR(13)=\r is a line feed, CHAR(10)=\n is a new line}] @@ -89,6 +89,14 @@ FUNCTION FileSize( Unit ) RETURN END FUNCTION FileSize ! ( Unit ) !======================================================================= +SUBROUTINE SetConsoleUnit( Unit ) + ! This subroutine sets the console unit for output. + +INTEGER, INTENT(IN) :: Unit !< The new I/O unit number for the console. +CU = Unit + +END SUBROUTINE SetConsoleUnit +!======================================================================= FUNCTION Is_NaN( DblNum ) ! This routine determines if a REAL(DbKi) variable holds a proper number. diff --git a/modules/nwtc-library/src/SysIFL.f90 b/modules/nwtc-library/src/SysIFL.f90 index c6c439e890..f2ccbe1cde 100644 --- a/modules/nwtc-library/src/SysIFL.f90 +++ b/modules/nwtc-library/src/SysIFL.f90 @@ -56,7 +56,7 @@ MODULE SysSubs END INTERFACE INTEGER, PARAMETER :: ConRecL = 120 ! The record length for console output. - INTEGER, PARAMETER :: CU = 6 ! The I/O unit for the console. + INTEGER, PUBLIC :: CU = 6 ! The I/O unit for the console (Can be changed with SetConsoleUnit subroutine) INTEGER, PARAMETER :: MaxWrScrLen = 98 ! The maximum number of characters allowed to be written to a line in WrScr LOGICAL, PARAMETER :: KBInputOK = .TRUE. ! A flag to tell the program that keyboard input is allowed in the environment. CHARACTER(*), PARAMETER :: NewLine = ACHAR(10) ! The delimiter for New Lines [ Windows is CHAR(13)//CHAR(10); MAC is CHAR(13); Unix is CHAR(10) {CHAR(13)=\r is a line feed, CHAR(10)=\n is a new line}] @@ -91,6 +91,14 @@ FUNCTION FileSize( Unit ) RETURN END FUNCTION FileSize ! ( Unit ) !======================================================================= +SUBROUTINE SetConsoleUnit( Unit ) + ! This subroutine sets the console unit for output. + +INTEGER, INTENT(IN) :: Unit !< The new I/O unit number for the console. +CU = Unit + +END SUBROUTINE SetConsoleUnit +!======================================================================= FUNCTION Is_NaN( DblNum ) ! This routine determines if a REAL(DbKi) variable holds a proper number. diff --git a/modules/nwtc-library/src/SysIVF.f90 b/modules/nwtc-library/src/SysIVF.f90 index 2a6304dbdb..d0e7227657 100644 --- a/modules/nwtc-library/src/SysIVF.f90 +++ b/modules/nwtc-library/src/SysIVF.f90 @@ -56,7 +56,7 @@ MODULE SysSubs END INTERFACE INTEGER, PARAMETER :: ConRecL = 120 ! The record length for console output. - INTEGER, PARAMETER :: CU = 7 ! The I/O unit for the console. + INTEGER, PUBLIC :: CU = 7 ! The I/O unit for the console (Can be changed with SetConsoleUnit subroutine) INTEGER, PARAMETER :: MaxWrScrLen = 98 ! The maximum number of characters allowed to be written to a line in WrScr LOGICAL, PARAMETER :: KBInputOK = .TRUE. ! A flag to tell the program that keyboard input is allowed in the environment. CHARACTER(*), PARAMETER :: NewLine = ACHAR(10) ! The delimiter for New Lines [ Windows is CHAR(13)//CHAR(10); MAC is CHAR(13); Unix is CHAR(10) {CHAR(13)=\r is a line feed, CHAR(10)=\n is a new line}]; Note: NewLine change to ACHAR(10) here on Windows to fix issues with C/Fortran interoperability using WrScr @@ -90,6 +90,14 @@ FUNCTION FileSize( Unit ) RETURN END FUNCTION FileSize ! ( Unit ) !======================================================================= +SUBROUTINE SetConsoleUnit( Unit ) + ! This subroutine sets the console unit for output. + +INTEGER, INTENT(IN) :: Unit !< The new I/O unit number for the console. +CU = Unit + +END SUBROUTINE SetConsoleUnit +!======================================================================= FUNCTION Is_NaN( DblNum ) ! This routine determines if a REAL(DbKi) variable holds a NaN (not-a-number) value. diff --git a/modules/nwtc-library/src/SysIVF_Labview.f90 b/modules/nwtc-library/src/SysIVF_Labview.f90 index 529ed52f32..ac42539000 100644 --- a/modules/nwtc-library/src/SysIVF_Labview.f90 +++ b/modules/nwtc-library/src/SysIVF_Labview.f90 @@ -73,7 +73,7 @@ MODULE SysSubs INTEGER, PARAMETER :: ConRecL = 120 ! The record length for console output. - INTEGER, PARAMETER :: CU = 7 ! The I/O unit for the console. + INTEGER, PUBLIC :: CU = 7 ! The I/O unit for the console (Can be changed with SetConsoleUnit subroutine) INTEGER, PARAMETER :: MaxWrScrLen = 98 ! The maximum number of characters allowed to be written to a line in WrScr LOGICAL, PARAMETER :: KBInputOK = .FALSE. ! A flag to tell the program that keyboard input is allowed in the environment. @@ -125,6 +125,14 @@ FUNCTION FileSize( Unit ) RETURN END FUNCTION FileSize ! ( Unit ) +!======================================================================= + SUBROUTINE SetConsoleUnit( Unit ) + ! This subroutine sets the console unit for output. + + INTEGER, INTENT(IN) :: Unit !< The new I/O unit number for the console. + CU = Unit + + END SUBROUTINE SetConsoleUnit !======================================================================= SUBROUTINE FlushOut ( Unit ) diff --git a/modules/nwtc-library/src/SysMatlabLinuxGnu.f90 b/modules/nwtc-library/src/SysMatlabLinuxGnu.f90 index d69f227433..6b2a847d24 100644 --- a/modules/nwtc-library/src/SysMatlabLinuxGnu.f90 +++ b/modules/nwtc-library/src/SysMatlabLinuxGnu.f90 @@ -59,7 +59,7 @@ MODULE SysSubs END INTERFACE INTEGER, PARAMETER :: ConRecL = 120 ! The record length for console output. - INTEGER, PARAMETER :: CU = 6 ! The I/O unit for the console. + INTEGER, PUBLIC :: CU = 6 ! The I/O unit for the console (Can be changed with SetConsoleUnit subroutine) INTEGER, PARAMETER :: MaxWrScrLen = 98 ! The maximum number of characters allowed to be written to a line in WrScr LOGICAL, PARAMETER :: KBInputOK = .FALSE. ! A flag to tell the program that keyboard input is allowed in the environment. CHARACTER(*), PARAMETER :: NewLine = ACHAR(10) ! The delimiter for New Lines [ Windows is CHAR(13)//CHAR(10); MAC is CHAR(13); Unix is CHAR(10) {CHAR(13)=\r is a line feed, CHAR(10)=\n is a new line}] @@ -92,6 +92,14 @@ FUNCTION FileSize( Unit ) RETURN END FUNCTION FileSize ! ( Unit ) !======================================================================= +SUBROUTINE SetConsoleUnit( Unit ) + ! This subroutine sets the console unit for output. + +INTEGER, INTENT(IN) :: Unit !< The new I/O unit number for the console. +CU = Unit + +END SUBROUTINE SetConsoleUnit +!======================================================================= FUNCTION Is_NaN( DblNum ) ! This routine determines if a REAL(DbKi) variable holds a proper number. diff --git a/modules/nwtc-library/src/SysMatlabLinuxIntel.f90 b/modules/nwtc-library/src/SysMatlabLinuxIntel.f90 index c521e449f0..a31dc15cad 100644 --- a/modules/nwtc-library/src/SysMatlabLinuxIntel.f90 +++ b/modules/nwtc-library/src/SysMatlabLinuxIntel.f90 @@ -59,7 +59,7 @@ MODULE SysSubs END INTERFACE INTEGER, PARAMETER :: ConRecL = 120 ! The record length for console output. - INTEGER, PARAMETER :: CU = 6 ! The I/O unit for the console. + INTEGER, PUBLIC :: CU = 6 ! The I/O unit for the console (Can be changed with SetConsoleUnit subroutine) INTEGER, PARAMETER :: MaxWrScrLen = 98 ! The maximum number of characters allowed to be written to a line in WrScr LOGICAL, PARAMETER :: KBInputOK = .FALSE. ! A flag to tell the program that keyboard input is allowed in the environment. CHARACTER(*), PARAMETER :: NewLine = ACHAR(10) ! The delimiter for New Lines [ Windows is CHAR(13)//CHAR(10); MAC is CHAR(13); Unix is CHAR(10) {CHAR(13)=\r is a line feed, CHAR(10)=\n is a new line}] @@ -94,6 +94,14 @@ FUNCTION FileSize( Unit ) RETURN END FUNCTION FileSize ! ( Unit ) !======================================================================= +SUBROUTINE SetConsoleUnit( Unit ) + ! This subroutine sets the console unit for output. + +INTEGER, INTENT(IN) :: Unit !< The new I/O unit number for the console. +CU = Unit + +END SUBROUTINE SetConsoleUnit +!======================================================================= FUNCTION Is_NaN( DblNum ) ! This routine determines if a REAL(DbKi) variable holds a proper number. diff --git a/modules/nwtc-library/src/SysMatlabWindows.f90 b/modules/nwtc-library/src/SysMatlabWindows.f90 index 09c931aff2..c462d92df9 100644 --- a/modules/nwtc-library/src/SysMatlabWindows.f90 +++ b/modules/nwtc-library/src/SysMatlabWindows.f90 @@ -47,7 +47,7 @@ MODULE SysSubs !======================================================================= - INTEGER, PARAMETER :: CU = 6 ! The I/O unit for the console. + INTEGER, PUBLIC :: CU = 6 ! The I/O unit for the console (Can be changed with SetConsoleUnit subroutine) INTEGER, PARAMETER :: MaxWrScrLen = 98 ! The maximum number of characters allowed to be written to a line in WrScr LOGICAL, PARAMETER :: KBInputOK = .FALSE. ! A flag to tell the program that keyboard input is allowed in the environment. @@ -82,6 +82,14 @@ FUNCTION FileSize( Unit ) RETURN END FUNCTION FileSize ! ( Unit ) +!======================================================================= +SUBROUTINE SetConsoleUnit( Unit ) + ! This subroutine sets the console unit for output. + +INTEGER, INTENT(IN) :: Unit !< The new I/O unit number for the console. +CU = Unit + +END SUBROUTINE SetConsoleUnit !======================================================================= SUBROUTINE FlushOut ( Unit ) diff --git a/modules/nwtc-library/src/VTK.f90 b/modules/nwtc-library/src/VTK.f90 index e4ffc614d0..fc48a1ef7d 100644 --- a/modules/nwtc-library/src/VTK.f90 +++ b/modules/nwtc-library/src/VTK.f90 @@ -162,8 +162,8 @@ SUBROUTINE ReadVTK_SP_info( FileName, descr, dims, origin, gridSpacing, vecLabel END IF !$OMP critical(fileopenNWTCio_critical) - CALL GetNewUnit( Un, ErrStat2, ErrMsg2 ) - CALL OpenFInpFile ( Un, TRIM(FileName), ErrStat, ErrMsg ) + CALL GetNewUnit( Un, ErrStat, ErrMsg ) + CALL OpenFInpFile ( Un, TRIM(FileName), ErrStat2, ErrMsg2 ) !$OMP end critical(fileopenNWTCio_critical) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) return diff --git a/modules/nwtc-library/tests/NWTC_Library_test_tools.F90 b/modules/nwtc-library/tests/NWTC_Library_test_tools.F90 index 01df14383a..685cefcff1 100644 --- a/modules/nwtc-library/tests/NWTC_Library_test_tools.F90 +++ b/modules/nwtc-library/tests/NWTC_Library_test_tools.F90 @@ -12,16 +12,14 @@ module nwtc_library_test_tools character(11), parameter :: terminal="/dev/stdout" #endif -integer, parameter :: stdout=CU - contains subroutine hide_terminal_output() - open(unit=stdout, file=trim(nullfile)) + open(unit=CU, file=trim(nullfile)) end subroutine subroutine show_terminal_output() - open(unit=stdout, file=terminal, status="old") + open(unit=CU, file=terminal, status="old") end subroutine end module diff --git a/modules/nwtc-library/tests/test_NWTC_C_Binding.F90 b/modules/nwtc-library/tests/test_NWTC_C_Binding.F90 index eaae1ad79c..cb1a20ff47 100644 --- a/modules/nwtc-library/tests/test_NWTC_C_Binding.F90 +++ b/modules/nwtc-library/tests/test_NWTC_C_Binding.F90 @@ -8,41 +8,220 @@ module test_NWTC_C_Binding private public :: test_NWTC_C_Binding_suite + ! C string for testing + integer(c_int), parameter :: test_c_string_len = 10 + 1 ! +1 for null terminator + character(kind=c_char) :: test_c_string(test_c_string_len) = (/ "1", "2", "3", "4", "5", "6", "7", "8", "9", "0", C_NULL_CHAR /) + contains !> Collect all exported unit tests subroutine test_NWTC_C_Binding_suite(testsuite) type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & - new_unittest("test_FileNameFromCString", test_FileNameFromCString) & !, & - ! new_unittest("test_initfileinfo2", test_initfileinfo2) & + new_unittest("test_SetErrStat_F2C", test_SetErrStat_F2C), & + new_unittest("test_SetErrStat_C", test_SetErrStat_C), & + new_unittest("test_StringConvert_F2C", test_StringConvert_F2C), & + new_unittest("test_StringConvert_C2F", test_StringConvert_C2F), & + new_unittest("test_RemoveCStringNullChar", test_RemoveCStringNullChar), & + new_unittest("test_FileNameFromCString", test_FileNameFromCString) & !, & ] end subroutine + + subroutine test_SetErrStat_F2C(error) + type(error_type), allocatable, intent(out) :: error - subroutine test_FileNameFromCString(error) + ! This case should result in error status 0. + ! It tests that the Fortran ErrStat and ErrMsg are appropriately converted to C-based types + + ! Fortran-based inputs + integer :: error_status_f = 11 + character(ErrMsgLen) :: error_message_f = "Error message" + + ! C-based outputs to test against inputs + integer(c_int) :: error_status_c + character(kind=c_char) :: error_message_c(ErrMsgLen_C) + + call SetErrStat_F2C(error_status_f, error_message_f, error_status_c, error_message_c) + + call check(error, error_status_f, error_status_c) + ! call check(error, "Error message", error_message_c) + + + !!! + + end subroutine + + subroutine test_SetErrStat_C(error) type(error_type), allocatable, intent(out) :: error ! This case should result in error status 0. - ! It tests that FileNameFromString extracts the filename from a string correctly. + ! It tests that the local error status and error message are incorporated into + ! the global error status and error message variables. + ! All data types are C-based. + + integer(c_int) :: error_status_local + integer(c_int) :: error_status_global + character(kind=c_char) :: error_message_local(ErrMsgLen_C) + character(kind=c_char) :: error_message_global(ErrMsgLen_C) + character(IntfStrLen) :: routine_name + + character(len=ErrMsgLen) :: error_message_f + integer :: loc_global, loc_local, loc_routine + + error_message_local = ""//C_NULL_CHAR + error_message_global = ""//C_NULL_CHAR + routine_name = "test_SetErrStat_C" + + ! Check ErrStat handling + + ! If the local error status is 0, the global variables should not change + error_status_local = 0 + error_status_global = 1 + call SetErrStat_C(error_status_local, error_message_local, error_status_global, error_message_global, routine_name) + call check(error, 1, error_status_global) + + ! If the local error status is larger than the global, the global should be updated to the local + error_status_global = 0 + error_status_local = 1 + call SetErrStat_C(error_status_local, error_message_local, error_status_global, error_message_global, routine_name) + call check(error, 1, error_status_global) + + ! If the local error status is smaller than the global, the global should not change + error_status_global = 1 + error_status_local = 0 + call SetErrStat_C(error_status_local, error_message_local, error_status_global, error_message_global, routine_name) + call check(error, 1, error_status_global) + + ! Check ErrMsg handling + + error_status_local = 1 + error_status_global = 2 + CALL StringConvert_F2C("Global error message", error_message_global) ! Store a Fortran string into the C string test variable + + ! The local error message should be appended to the global error message + + CALL StringConvert_F2C("Local error message", error_message_local) + CALL SetErrStat_C(error_status_local, error_message_local, error_status_global, error_message_global, routine_name) + CALL StringConvert_C2F(error_message_global, error_message_f) ! Convert the C string back to Fortran for checking + + loc_global = INDEX(error_message_f, "Global error message") + loc_local = INDEX(error_message_f, "Local error message") + loc_routine = INDEX(error_message_f, "test_SetErrStat_C") + call check(error, .TRUE., loc_global > 0) + call check(error, .TRUE., loc_local > 0) + call check(error, .TRUE., loc_routine > 0) + call check(error, 1, loc_global) ! The global error message should be first + call check(error, .TRUE., loc_routine < loc_local) ! Then the routine name should be appended + + end subroutine + + subroutine test_StringConvert_F2C(error) + type(error_type), allocatable, intent(out) :: error + + ! This case should result in error status 0. + ! It tests that the Fortran string is converted to a C string correctly. + + character(len=test_c_string_len - 1) :: f_string + character(kind=c_char) :: c_string(test_c_string_len) + ! character(len=test_c_string_len + 3) :: f_string_longer - integer(IntKi) :: error_status - character(ErrMsgLen) :: error_message - character(len=IntfStrLen+8) :: input_string ! Make the input string slightly longer than IntfStrLen to check that it truncates correctly - character(len=IntfStrLen) :: file_name + integer :: i + integer :: index_array(11) - ! Each long line below has 256 characters - input_string = & - "asdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdf"& - "asdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdf"& - "asdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdf"& - "asdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdf"& - "asdfasdf" + ! Create an array to test for where the C null character should be in the C string + ! Note that INDEX of a C string returns the index of the substring for each character in the string + ! It essentially looks like a binary result for each element of the string + index_array = 0 + index_array(11) = 1 - file_name = FileNameFromCString(input_string, IntfStrLen+8) + f_string = "1234567890" + call StringConvert_F2C(f_string, c_string) + do i=1, 11 + call check(error, index_array(i), index(c_string(i), C_NULL_CHAR)) ! Check that the C null character is added + if (i<11) then + call check(error, f_string(i:i), c_string(i)) ! Check that the C string matches the original Fortran string + end if + end do + + ! Fortran string is longer than C string + ! f_string_longer = "12345678901234" + ! call StringConvert_F2C(f_string_longer, c_string) + ! Note this case is not handled in the subroutine. It MUST be handled in the calling code. + ! As is, the subroutine will write past the c string array and there is no error. + + end subroutine + + subroutine test_StringConvert_C2F(error) + type(error_type), allocatable, intent(out) :: error + + ! This case should result in error status 0. + ! It tests that the C string is converted to Fortran correctly. + + character(len=test_c_string_len - 1) :: f_string + character(len=test_c_string_len - 2) :: f_string_shorter + + ! Convert the C string to Fortran + call StringConvert_C2F(test_c_string, f_string) + call check(error, 0, index(f_string, C_NULL_CHAR)) ! Check that the C null character is removed + call check(error, "1234567890", f_string) ! Check that the Fortran string matches the original C string + + ! Verify that the C string is truncated when it is longer than the Fortran string + call StringConvert_C2F(test_c_string, f_string_shorter) + call check(error, "123456789", f_string_shorter) ! Check that the Fortran string matches the original C string + + end subroutine + + subroutine test_RemoveCStringNullChar(error) + type(error_type), allocatable, intent(out) :: error - call check(error, file_name, input_string(1:IntfStrLen)) + ! This case should result in error status 0. + ! It tests that RemoveCStringNullChar indeed removes the C null character. + + ! Make this longer than test_c_string so that we don't accidentally chop off + ! the null terminator without checking that the function removed it + integer, parameter :: result_length = test_c_string_len + 10 + character(len=result_length) :: result_string + + result_string = RemoveCStringNullChar(test_c_string_len, test_c_string) + call check(error, 0, INDEX(result_string, C_NULL_CHAR)) end subroutine + subroutine test_FileNameFromCString(error) + type(error_type), allocatable, intent(out) :: error + + ! This case should result in error status 0. + ! It tests that FileNameFromString extracts the filename from a C string correctly. + + integer, parameter :: input_string_len = IntfStrLen + 8 ! Make the input string slightly longer than IntfStrLen to check that it truncates correctly + character(kind=c_char, len=input_string_len) :: input_string + character(len=IntfStrLen) :: file_name + + integer :: i + + ! Fill the test string with 'A's + do i=1, input_string_len + input_string(i:i) = "A" + end do + + ! Assign the character at IntfStrLen to 'B' + input_string(IntfStrLen:IntfStrLen) = "B" + + ! Terminate with C null character + input_string(input_string_len:input_string_len) = C_NULL_CHAR + + ! Get the FileName from the C string + file_name = FileNameFromCString(input_string, IntfStrLen+8) + + ! Check that the extracted filename matches the input up to the IntfStrLen + call check(error, input_string(1:IntfStrLen), file_name) + + ! Check that the test string is truncated at the IntfStrLen correctly + call check(error, "B", input_string(IntfStrLen:IntfStrLen)) + + ! Check the C_NULL_CHAR is removed + call check(error, 0, index(file_name, C_NULL_CHAR)) + + end subroutine end module diff --git a/modules/openfast-library/src/FAST_Library.f90 b/modules/openfast-library/src/FAST_Library.f90 index e3ff240d7f..2c672e0be9 100644 --- a/modules/openfast-library/src/FAST_Library.f90 +++ b/modules/openfast-library/src/FAST_Library.f90 @@ -1200,6 +1200,10 @@ subroutine FAST_CFD_WriteOutput(iTurb_c, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAS CALL FAST_WriteOutput_T( t_initial, n_t_global, Turbine(iTurb), ErrStat, ErrMsg ) + ErrStat_c = ErrStat + ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + end subroutine FAST_CFD_WriteOutput !================================================================================================================================== subroutine FAST_CFD_Step(iTurb_c, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_Step') diff --git a/modules/openfast-library/src/FAST_Lin.f90 b/modules/openfast-library/src/FAST_Lin.f90 index 7aba34117c..db4a637fff 100644 --- a/modules/openfast-library/src/FAST_Lin.f90 +++ b/modules/openfast-library/src/FAST_Lin.f90 @@ -3925,7 +3925,7 @@ SUBROUTINE Linear_MAP_InputSolve_dy( p_FAST, y_FAST, u_MAP, p_ED, y_ED, y_SD, Me call Linearize_Point_to_Point( SubstructureMotion, u_MAP%PtFairDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) FieldMask = .false. FieldMask(MASKID_TRANSLATIONDISP) = .true. - call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_MAP%PtFairDisplacement, MeshMapData%Structure_2_Mooring, MAP_Start, SubStructure_Out_Start, dUdy, FieldMask) + call Assemble_dUdy_Motions(SubstructureMotion, u_MAP%PtFairDisplacement, MeshMapData%Structure_2_Mooring, MAP_Start, SubStructure_Out_Start, dUdy, FieldMask) END IF END SUBROUTINE Linear_MAP_InputSolve_dy @@ -6928,10 +6928,16 @@ SUBROUTINE ComputeOutputRanges(p_FAST, y_FAST, m_FAST, y_SrvD) ! note that op_y may be larger than SizeLin if there are orientations; also, we are NOT including the WriteOutputs - do indx = 1,y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL) - m_FAST%Lin%y_ref(indx) = maxval( m_FAST%Lin%Y_prevRot( indx, : ) ) - minval( m_FAST%Lin%Y_prevRot( indx, : ) ) - m_FAST%Lin%y_ref(indx) = max( m_FAST%Lin%y_ref(indx), 0.01_ReKi ) - end do + if (p_FAST%NLinTimes == 1) then ! NOTE: maxval( m_FAST%Lin%Y_prevRot( indx, : ) ) - minval( m_FAST%Lin%Y_prevRot( indx, : ) ) = 0 in this case + do indx = 1,y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL) + m_FAST%Lin%y_ref(indx) = max( abs(m_FAST%Lin%Y_prevRot( indx, p_FAST%NLinTimes )), 0.01_ReKi ) + end do + else + do indx = 1,y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL) + m_FAST%Lin%y_ref(indx) = maxval( m_FAST%Lin%Y_prevRot( indx, : ) ) - minval( m_FAST%Lin%Y_prevRot( indx, : ) ) + m_FAST%Lin%y_ref(indx) = max( m_FAST%Lin%y_ref(indx), 0.01_ReKi ) + end do + end if ! special case for angles: indx = Indx_y_Yaw_Start(y_FAST, Module_ED) ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) diff --git a/modules/openfast-library/src/FAST_SS_Subs.f90 b/modules/openfast-library/src/FAST_SS_Subs.f90 index 82b7c85846..9a6245cb11 100644 --- a/modules/openfast-library/src/FAST_SS_Subs.f90 +++ b/modules/openfast-library/src/FAST_SS_Subs.f90 @@ -102,8 +102,20 @@ SUBROUTINE FAST_InitializeSteadyState_T( Turbine, ErrStat, ErrMsg ) Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, & Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg ) + if (ErrStat >= AbortErrLev) return + + ! If BeamDyn blades are being used, return error + if (Turbine%p_FAST%CompElast == Module_BD) then + ErrStat = ErrID_Fatal + ErrMsg = "AeroMap does not currently work with BeamDyn blades, support will be added in a future version of OpenFAST" + return + end if call InitFlowField() + + CALL SimStatus_FirstTime( Turbine%m_FAST%TiLstPrn, Turbine%m_FAST%PrevClockTime, Turbine%m_FAST%SimStrtTime, Turbine%m_FAST%UsrTime2, & + t_initial, Turbine%p_FAST%TMax, Turbine%p_FAST%TDesc, useCases=Turbine%p_FAST%CompAeroMaps) + contains !> AD15 now directly accesses FlowField data from IfW. Since we don't use IfW, we need to manually set the FlowField data diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index f45a789a47..7975b3d57f 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -586,6 +586,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S Init%InData_SeaSt%hasIce = p_FAST%CompIce /= Module_None Init%InData_SeaSt%InputFile = p_FAST%SeaStFile Init%InData_SeaSt%OutRootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_SeaSt)) + Init%InData_SeaSt%WaveTimeShift = 0.0_DbKi ! for phase shifting wave field in time (positive value only) ! these values support wave field handling Init%InData_SeaSt%WaveFieldMod = p_FAST%WaveFieldMod @@ -1133,13 +1134,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S IF (p_FAST%CompMooring == Module_MAP) THEN !bjj: until we modify this, MAP requires HydroDyn to be used. (perhaps we could send air density from AeroDyn or something...) - ! If mode shape visualization requested when MAP is active, set error and return - if (p_FAST%WrVTK == VTK_ModeShapes) then - call SetErrStat(ErrID_Fatal, "Mode shape visualization is not supported when using MAP.", ErrStat, ErrMsg, RoutineName) - call Cleanup() - return - end if - CALL WrScr(NewLine) !bjj: I'm printing two blank lines here because MAP seems to be writing over the last line on the screen. ! Init%InData_MAP%rootname = p_FAST%OutFileRoot ! Output file name @@ -2087,7 +2081,7 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) IF ( p%TMax < 0.0_DbKi ) THEN CALL SetErrStat( ErrID_Fatal, 'TMax must not be a negative number.', ErrStat, ErrMsg, RoutineName ) ELSE IF ( p%TMax < p%TStart ) THEN - CALL SetErrStat( ErrID_Fatal, 'TStart ('//trim(num2lstr(p%TStart))//') should be greater than TMax ('//trim(num2lstr(p%TMax))//') in OpenFAST input file.', ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrID_Fatal, 'TMax ('//trim(num2lstr(p%TMax))//') should be greater than TStart ('//trim(num2lstr(p%TStart))//') in the OpenFAST input file.', ErrStat, ErrMsg, RoutineName ) END IF IF ( p%n_ChkptTime < p%n_TMax_m1 ) THEN @@ -9554,7 +9548,7 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, end if IF (p_FAST%WrSttsTime .and. PrintRunTimes) THEN - CALL RunTimes( m_FAST%StrtTime, m_FAST%UsrTime1, m_FAST%SimStrtTime, m_FAST%UsrTime2, m_FAST%t_global, UnSum=y_FAST%UnSum, DescStrIn=p_FAST%TDesc ) + CALL RunTimes( m_FAST%StrtTime, m_FAST%UsrTime1, m_FAST%SimStrtTime, m_FAST%UsrTime2, m_FAST%t_global, UnSum=y_FAST%UnSum, DescStrIn=p_FAST%TDesc, useCases=p_FAST%CompAeroMaps ) END IF IF (y_FAST%UnSum > 0) THEN CLOSE(y_FAST%UnSum) @@ -10002,13 +9996,7 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, ! init error status ErrStat = ErrID_None ErrMsg = "" - - ! Writing checkpoint files is not supported when using MAP - if (Turbine%p_FAST%CompMooring == Module_MAP) then - call SetErrStat(ErrID_Fatal, "Writing checkpoint files is not supported when using MAP.", ErrStat, ErrMsg, RoutineName) - return - end if - + FileName = TRIM(CheckpointRoot)//'.chkp' DLLFileName = TRIM(CheckpointRoot)//'.dll.chkp' diff --git a/modules/openfast-registry/src/registry.hpp b/modules/openfast-registry/src/registry.hpp index f615fb7a15..0232f8c5bc 100644 --- a/modules/openfast-registry/src/registry.hpp +++ b/modules/openfast-registry/src/registry.hpp @@ -438,9 +438,11 @@ struct Registry std::map, ci_less> interface_map; std::map, ci_less> modules; std::map, ci_less> data_types; + std::map, ci_less> data_types_isocbinding; bool gen_c_code = false; bool no_extrap_interp = false; bool gen_inc_subs = false; + bool use_isocbinding = false; Registry() { @@ -453,6 +455,10 @@ struct Registry auto R8Ki = std::make_shared("R8Ki", "REAL(R8Ki)", DataType::Tag::Real, 64); auto DbKi = std::make_shared("DbKi", "REAL(DbKi)", DataType::Tag::Real, 64); auto logical = std::make_shared("Logical", "LOGICAL", DataType::Tag::Logical); + auto c_int = std::make_shared("c_int", "INTEGER(c_int)", DataType::Tag::Integer, 32); + auto c_float = std::make_shared("c_float", "REAL(c_float)", DataType::Tag::Real, 32); + auto c_double = std::make_shared("c_double","REAL(c_double)", DataType::Tag::Real, 64); + auto c_char = std::make_shared("c_char", "CHARACTER(c_char)", DataType::Tag::Character); // Derived types auto mesh = std::make_shared(nullptr, "MeshType", "MeshType", "MeshType"); @@ -473,6 +479,10 @@ struct Registry {"logical", logical}, {"meshtype", mesh}, {"dll_type", dll}, + {"c_int",c_int}, + {"c_float",c_float}, + {"c_double",c_double}, + {"c_char",c_char}, }; this->interface_map = std::map, ci_less>{ @@ -500,6 +510,15 @@ struct Registry {"PartialConstrStatePInputType", std::make_shared("PartialConstrStatePInputType", "dZdu", true)}, }; + + // Map of ISO_C_BINDING types (for checks only) + this->data_types_isocbinding = std::map, ci_less>{ + {"c_int",c_int}, + {"c_float",c_float}, + {"c_double",c_double}, + {"c_char",c_char}, + }; + } // Parsing @@ -512,12 +531,20 @@ struct Registry // Pointer to type std::shared_ptr data_type; + // if using ISO_C_BINDING, search these types first + auto it = data_types_isocbinding.find(type_name); + if (it != data_types_isocbinding.end()) + { + this->use_isocbinding = true; + return it->second; + } + // Get map of data types to search // If module was provided, search it; otherwise, search registry auto &data_types = mod == nullptr ? this->data_types : mod->data_types; // Search for type in registry, return if found - auto it = data_types.find(type_name); + it = data_types.find(type_name); if (it != data_types.end()) { return it->second; diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index 00b103cea0..e440e90cc6 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -97,6 +97,10 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) // Write preamble w << std::regex_replace(FAST_preamble, std::regex("ModuleName"), mod.name); + // Output USE statements for literal passthroughs (i.e. ISO_C_BINDING) + if (this->use_isocbinding) + w << "USE ISO_C_BINDING\n"; + // Output USE statements for non-root modules for (auto const &mod : this->use_modules) if (tolower(mod).compare("nwtc_library") != 0) @@ -673,15 +677,6 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, w << indent << "if (RF%ErrStat >= AbortErrLev) return"; - if (gen_c_code) - { - w << indent << "if (c_associated(InData%C_obj%object)) then"; - w << indent << " RF%ErrStat = ErrID_Fatal"; - w << indent << " RF%ErrMsg = RoutineName//': C_obj%object cannot be packed.'"; - w << indent << " return"; - w << indent << "end if"; - } - // Pack data for (auto &field : ddt.fields) { diff --git a/modules/seastate/CMakeLists.txt b/modules/seastate/CMakeLists.txt index 9900facf14..2b834f0e8d 100644 --- a/modules/seastate/CMakeLists.txt +++ b/modules/seastate/CMakeLists.txt @@ -39,22 +39,39 @@ add_library(seastlib STATIC ) target_link_libraries(seastlib nwtclibs versioninfolib) + # C-bindings interface library -add_library(seastate_c_binding SHARED - src/SeaState_C_Binding.f90 -) -target_link_libraries(seastate_c_binding seastlib versioninfolib) +# create object instead of directly linking into shared and static -- causes issues in parallel builds +# This is only required because we are static linking the library for wavetank +# NOTE: target linking at the object, static, and shared libraries. Different CMake versions handle this +# slightly differently with unpredictable results if I don't. +add_library(seastate_c_binding_object OBJECT src/SeaState_C_Binding.f90) +target_link_libraries(seastate_c_binding_object seastlib nwtclibs versioninfolib) +set_property(TARGET seastate_c_binding_object PROPERTY POSITION_INDEPENDENT_CODE 1) # required for shared libs + +# shared +add_library(seastate_c_binding SHARED $) +target_link_libraries(seastate_c_binding seastlib nwtclibs versioninfolib) if(APPLE OR UNIX) target_compile_definitions(seastate_c_binding PRIVATE IMPLICIT_DLLEXPORT) endif() +# C-bindings static interface +# This is a workaround for building wavetank into a single DLL (also allows setting CU globaly for sending screen to file for labview integration) +add_library(seastate_c_bind_static STATIC $) +target_link_libraries(seastate_c_bind_static seastlib nwtclibs versioninfolib) +if(APPLE OR UNIX) + target_compile_definitions(seastate_c_bind_static PRIVATE IMPLICIT_DLLEXPORT) +endif() + + # Driver add_executable(seastate_driver src/SeaState_DriverCode.f90 ) target_link_libraries(seastate_driver seastlib) -install(TARGETS seastate_driver seastlib seastate_c_binding +install(TARGETS seastate_driver seastlib seastate_c_binding seastate_c_bind_static EXPORT "${CMAKE_PROJECT_NAME}Libraries" RUNTIME DESTINATION bin LIBRARY DESTINATION lib diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index 0c1fb951e2..04d66270d8 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -1,6 +1,8 @@ MODULE SeaSt_WaveField +USE GridInterp USE SeaSt_WaveField_Types +USE GridInterp_Types IMPLICIT NONE @@ -10,20 +12,18 @@ MODULE SeaSt_WaveField PUBLIC WaveField_GetNodeWaveElev1 PUBLIC WaveField_GetNodeWaveElev2 PUBLIC WaveField_GetNodeTotalWaveElev +PUBLIC WaveField_GetMinMaxWaveElevEstimate PUBLIC WaveField_GetNodeWaveNormal PUBLIC WaveField_GetNodeWaveKin -PUBLIC WaveField_GetNodeWaveVel - +PUBLIC WaveField_GetNodeWaveVelAcc PUBLIC WaveField_GetWaveKin -public WaveField_Interp_Setup3D, WaveField_Interp_Setup4D - CONTAINS !-------------------- Subroutine for wave elevation ------------------! function WaveField_GetNodeWaveElev1( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg ) type(SeaSt_WaveFieldType), intent(in ) :: WaveField - type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + type(GridInterp_MiscVarType), intent(inout) :: WaveField_m real(DbKi), intent(in ) :: Time real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. integer(IntKi), intent( out) :: ErrStat ! Error status of the operation @@ -39,9 +39,9 @@ function WaveField_GetNodeWaveElev1( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg = "" IF (ALLOCATED(WaveField%WaveElev1)) THEN - CALL WaveField_Interp_Setup3D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ) + CALL WaveField_Interp_Setup3D( Time+WaveField%WaveTimeShift, pos, WaveField%SrfGridParams, WaveField_m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Zeta = WaveField_Interp_3D( WaveField%WaveElev1, WaveField_m ) + Zeta = GridInterp3D(WaveField%WaveElev1,WaveField_m) ELSE Zeta = 0.0_SiKi END IF @@ -53,7 +53,7 @@ end function WaveField_GetNodeWaveElev1 function WaveField_GetNodeWaveElev2( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg ) type(SeaSt_WaveFieldType), intent(in ) :: WaveField - type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + type(GridInterp_MiscVarType), intent(inout) :: WaveField_m real(DbKi), intent(in ) :: Time real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. integer(IntKi), intent( out) :: ErrStat ! Error status of the operation @@ -69,9 +69,9 @@ function WaveField_GetNodeWaveElev2( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg = "" IF (ALLOCATED(WaveField%WaveElev2)) THEN - CALL WaveField_Interp_Setup3D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ) + CALL WaveField_Interp_Setup3D( Time+WaveField%WaveTimeShift, pos, WaveField%SrfGridParams, WaveField_m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Zeta = WaveField_Interp_3D( WaveField%WaveElev2, WaveField_m ) + Zeta = GridInterp3D(WaveField%WaveElev2,WaveField_m) ELSE Zeta = 0.0_SiKi END IF @@ -83,7 +83,7 @@ end function WaveField_GetNodeWaveElev2 FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg ) type(SeaSt_WaveFieldType), intent(in ) :: WaveField - type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + type(GridInterp_MiscVarType), intent(inout) :: WaveField_m real(DbKi), intent(in ) :: Time real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. integer(IntKi), intent( out) :: ErrStat ! Error status of the operation @@ -110,18 +110,47 @@ logical function Failed() END FUNCTION WaveField_GetNodeTotalWaveElev -SUBROUTINE WaveField_GetNodeWaveNormal( WaveField, WaveField_m, Time, pos, r, n, ErrStat, ErrMsg ) +!> Gives an estimate of the min and max wave elevation. It will overshoot for second order +subroutine WaveField_GetMinMaxWaveElevEstimate( WaveField, MinElev, MaxElev, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), pointer, intent(in ) :: WaveField + real(SiKi), intent( out) :: MinElev + real(SiKi), intent( out) :: MaxElev + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + character(*), parameter :: RoutineName = 'WaveField_GetMinMaxWaveElevEstimate' + + ErrStat = ErrID_None + ErrMsg = "" + MinElev = 0.0_SiKi + MaxElev = 0.0_SiKi + + ! Check that data exists + if (.not. associated(WaveField)) then + ErrStat = ErrID_Fatal + ErrMsg = trim(RoutineName)//": WaveField data does not exist." + return + endif + + if (allocated(WaveField%WaveElev1)) then + MinElev = minval(WaveField%WaveElev1) + MaxElev = maxval(WaveField%WaveElev1) + endif + if (allocated(WaveField%WaveElev2)) then + MinElev = MinElev + minval(WaveField%WaveElev2) + MaxElev = MaxElev + maxval(WaveField%WaveElev2) + endif +end subroutine WaveField_GetMinMaxWaveElevEstimate + +SUBROUTINE WaveField_GetNodeWaveNormal( WaveField, WaveField_m, Time, pos, n, ErrStat, ErrMsg ) type(SeaSt_WaveFieldType), intent(in ) :: WaveField - type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + type(GridInterp_MiscVarType), intent(inout) :: WaveField_m real(DbKi), intent(in ) :: Time real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface normal is to be calculated. Third entry ignored if present. - real(ReKi), intent(in ) :: r ! Distance for central differencing real(ReKi), intent( out) :: n(3) ! Free-surface normal vector integer(IntKi), intent( out) :: ErrStat ! Error status of the operation character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None - real(SiKi) :: ZetaP,ZetaM - real(ReKi) :: r1,dZetadx,dZetady + real(SiKi) :: slope(2) character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveNormal' integer(IntKi) :: errStat2 character(ErrMsgLen) :: errMsg2 @@ -129,18 +158,14 @@ SUBROUTINE WaveField_GetNodeWaveNormal( WaveField, WaveField_m, Time, pos, r, n, ErrStat = ErrID_None ErrMsg = "" - r1 = MAX(r,real(1.0e-6,ReKi)) ! In case r is zero - - ZetaP = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, (/pos(1)+r1,pos(2)/), ErrStat2, ErrMsg2 ); if (Failed()) return; - ZetaM = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, (/pos(1)-r1,pos(2)/), ErrStat2, ErrMsg2 ); if (Failed()) return; - dZetadx = REAL(ZetaP-ZetaM,ReKi)/(2.0_ReKi*r1) - - ZetaP = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, (/pos(1),pos(2)+r1/), ErrStat2, ErrMsg2 ); if (Failed()) return; - ZetaM = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, (/pos(1),pos(2)-r1/), ErrStat2, ErrMsg2 ); if (Failed()) return; - dZetady = REAL(ZetaP-ZetaM,ReKi)/(2.0_ReKi*r1) + call GridInterpSetupN( (/Real(Time+WaveField%WaveTimeShift,ReKi),pos(1),pos(2)/), WaveField%SrfGridParams, WaveField_m, ErrStat2, ErrMsg2 ) + slope = GridInterpS( WaveField%WaveElev1, WaveField%SrfGridParams, WaveField_m ) + if (ALLOCATED(WaveField%WaveElev2)) then + slope = slope + GridInterpS( WaveField%WaveElev2, WaveField%SrfGridParams, WaveField_m ) + end if - n = (/-dZetadx,-dZetady,1.0_ReKi/) - n = n / SQRT(Dot_Product(n,n)) + n = Real( (/-slope(1),-slope(2),1.0_SiKi/), ReKi) + n = n / TwoNorm(n) contains logical function Failed() @@ -153,7 +178,7 @@ END SUBROUTINE WaveField_GetNodeWaveNormal !-------------------- Subroutine for full wave field kinematics --------------------! SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNodeInWater, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) type(SeaSt_WaveFieldType), intent(in ) :: WaveField - type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + type(GridInterp_MiscVarType), intent(inout) :: WaveField_m real(DbKi), intent(in ) :: Time real(ReKi), intent(in ) :: pos(3) logical, intent(in ) :: forceNodeInWater @@ -190,12 +215,12 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNod IF ( pos(3) <= 0.0_ReKi) THEN ! Node is at or below the SWL nodeInWater = 1_IntKi ! Use location to obtain interpolated values of kinematics - CALL WaveField_Interp_Setup4D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) - FA(:) = WaveField_Interp_4D_Vec( WaveField%WaveAcc, WaveField_m ) - FDynP = WaveField_Interp_4D ( WaveField%WaveDynP, WaveField_m ) + CALL WaveField_Interp_Setup4D( Time+WaveField%WaveTimeShift, pos, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = GridInterp4DVec( WaveField%WaveVel, WaveField_m ) + FA(:) = GridInterp4DVec( WaveField%WaveAcc, WaveField_m ) + FDynP = GridInterp4D ( WaveField%WaveDynP, WaveField_m ) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = WaveField_Interp_4D_Vec( WaveField%WaveAccMCF, WaveField_m ) + FAMCF(:) = GridInterp4DVec( WaveField%WaveAccMCF, WaveField_m ) END IF ELSE ! Node is above the SWL nodeInWater = 0_IntKi @@ -216,33 +241,33 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNod IF ( pos(3) <= 0.0_SiKi) THEN ! Node is below the SWL - evaluate wave dynamics as usual ! Use location to obtain interpolated values of kinematics - CALL WaveField_Interp_Setup4D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) - FA(:) = WaveField_Interp_4D_Vec( WaveField%WaveAcc, WaveField_m ) - FDynP = WaveField_Interp_4D ( WaveField%WaveDynP, WaveField_m ) + CALL WaveField_Interp_Setup4D( Time+WaveField%WaveTimeShift, pos, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = GridInterp4DVec( WaveField%WaveVel, WaveField_m ) + FA(:) = GridInterp4DVec( WaveField%WaveAcc, WaveField_m ) + FDynP = GridInterp4D ( WaveField%WaveDynP, WaveField_m ) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = WaveField_Interp_4D_Vec( WaveField%WaveAccMCF, WaveField_m ) + FAMCF(:) = GridInterp4DVec( WaveField%WaveAccMCF, WaveField_m ) END IF ELSE ! Node is above SWL - need wave stretching ! Vertical wave stretching - CALL WaveField_Interp_Setup4D( Time, posXY0, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = WaveField_Interp_4D_vec( WaveField%WaveVel, WaveField_m ) - FA(:) = WaveField_Interp_4D_vec( WaveField%WaveAcc, WaveField_m ) - FDynP = WaveField_Interp_4D ( WaveField%WaveDynP, WaveField_m ) + CALL WaveField_Interp_Setup4D( Time+WaveField%WaveTimeShift, posXY0, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = GridInterp4DVec( WaveField%WaveVel, WaveField_m ) + FA(:) = GridInterp4DVec( WaveField%WaveAcc, WaveField_m ) + FDynP = GridInterp4D ( WaveField%WaveDynP, WaveField_m ) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = WaveField_Interp_4D_vec( WaveField%WaveAccMCF, WaveField_m ) + FAMCF(:) = GridInterp4DVec( WaveField%WaveAccMCF, WaveField_m ) END IF ! Extrapoled wave stretching IF (WaveField%WaveStMod == 2) THEN - CALL WaveField_Interp_Setup3D( Time, posXY, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = FV(:) + WaveField_Interp_3D_vec( WaveField%PWaveVel0, WaveField_m ) * pos(3) - FA(:) = FA(:) + WaveField_Interp_3D_vec( WaveField%PWaveAcc0, WaveField_m ) * pos(3) - FDynP = FDynP + WaveField_Interp_3D ( WaveField%PWaveDynP0, WaveField_m ) * pos(3) + CALL WaveField_Interp_Setup3D( Time+WaveField%WaveTimeShift, posXY, WaveField%SrfGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = FV(:) + GridInterp3DVec( WaveField%PWaveVel0, WaveField_m ) * pos(3) + FA(:) = FA(:) + GridInterp3DVec( WaveField%PWaveAcc0, WaveField_m ) * pos(3) + FDynP = FDynP + GridInterp3D ( WaveField%PWaveDynP0, WaveField_m ) * pos(3) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = FAMCF(:) + WaveField_Interp_3D_vec( WaveField%PWaveAccMCF0, WaveField_m ) * pos(3) + FAMCF(:) = FAMCF(:) + GridInterp3DVec( WaveField%PWaveAccMCF0, WaveField_m ) * pos(3) END IF END IF @@ -256,12 +281,12 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNod posPrime(3) = MIN( posPrime(3), 0.0_ReKi) ! Clamp z-position to zero. Needed when forceNodeInWater=.TRUE. ! Obtain the wave-field variables by interpolation with the mapped position. - CALL WaveField_Interp_Setup4D( Time, posPrime, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) - FA(:) = WaveField_Interp_4D_Vec( WaveField%WaveAcc, WaveField_m ) - FDynP = WaveField_Interp_4D ( WaveField%WaveDynP, WaveField_m ) + CALL WaveField_Interp_Setup4D( Time+WaveField%WaveTimeShift, posPrime, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = GridInterp4DVec( WaveField%WaveVel, WaveField_m ) + FA(:) = GridInterp4DVec( WaveField%WaveAcc, WaveField_m ) + FDynP = GridInterp4D ( WaveField%WaveDynP, WaveField_m ) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = WaveField_Interp_4D_Vec( WaveField%WaveAccMCF, WaveField_m ) + FAMCF(:) = GridInterp4DVec( WaveField%WaveAccMCF, WaveField_m ) END IF END IF @@ -286,14 +311,15 @@ END SUBROUTINE WaveField_GetNodeWaveKin !-------------------- Subroutine for wave field velocity only --------------------! -SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNodeInWater, nodeInWater, FV, ErrStat, ErrMsg ) +SUBROUTINE WaveField_GetNodeWaveVelAcc( WaveField, WaveField_m, Time, pos, forceNodeInWater, nodeInWater, FV, FA, ErrStat, ErrMsg ) type(SeaSt_WaveFieldType), intent(in ) :: WaveField - type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + type(GridInterp_MiscVarType), intent(inout) :: WaveField_m real(DbKi), intent(in ) :: Time real(ReKi), intent(in ) :: pos(3) logical, intent(in ) :: forceNodeInWater integer(IntKi), intent( out) :: nodeInWater real(SiKi), intent( out) :: FV(3) + real(SiKi), intent( out) :: FA(3) integer(IntKi), intent( out) :: ErrStat ! Error status of the operation character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None @@ -317,11 +343,13 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNod IF ( pos(3) <= 0.0_ReKi) THEN ! Node is at or below the SWL nodeInWater = 1_IntKi ! Use location to obtain interpolated values of kinematics - CALL WaveField_Interp_Setup4D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) + CALL WaveField_Interp_Setup4D( Time+WaveField%WaveTimeShift, pos, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = GridInterp4DVec( WaveField%WaveVel, WaveField_m ) + FA(:) = GridInterp4DVec( WaveField%WaveAcc, WaveField_m ) ELSE ! Node is above the SWL nodeInWater = 0_IntKi FV(:) = 0.0 + FA(:) = 0.0 END IF ELSE ! Wave stretching enabled @@ -335,19 +363,22 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNod IF ( pos(3) <= 0.0_SiKi) THEN ! Node is below the SWL - evaluate wave dynamics as usual ! Use location to obtain interpolated values of kinematics - CALL WaveField_Interp_Setup4D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) + CALL WaveField_Interp_Setup4D( Time+WaveField%WaveTimeShift, pos, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = GridInterp4DVec( WaveField%WaveVel, WaveField_m ) + FA(:) = GridInterp4DVec( WaveField%WaveAcc, WaveField_m ) ELSE ! Node is above SWL - need wave stretching ! Vertical wave stretching - CALL WaveField_Interp_Setup4D( Time, posXY0, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = WaveField_Interp_4D_vec( WaveField%WaveVel, WaveField_m ) + CALL WaveField_Interp_Setup4D( Time, posXY0, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = GridInterp4DVec( WaveField%WaveVel, WaveField_m ) + FA(:) = GridInterp4DVec( WaveField%WaveAcc, WaveField_m ) ! Extrapoled wave stretching IF (WaveField%WaveStMod == 2) THEN - CALL WaveField_Interp_Setup3D( Time, posXY, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = FV(:) + WaveField_Interp_3D_vec( WaveField%PWaveVel0, WaveField_m ) * pos(3) + CALL WaveField_Interp_Setup3D( Time+WaveField%WaveTimeShift, posXY, WaveField%SrfGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = FV(:) + GridInterp3DVec( WaveField%PWaveVel0, WaveField_m ) * pos(3) + FA(:) = FA(:) + GridInterp3DVec( WaveField%PWaveAcc0, WaveField_m ) * pos(3) END IF END IF ! Node is submerged @@ -360,8 +391,9 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNod posPrime(3) = MIN( posPrime(3), 0.0_ReKi) ! Clamp z-position to zero. Needed when forceNodeInWater=.TRUE. ! Obtain the wave-field variables by interpolation with the mapped position. - CALL WaveField_Interp_Setup4D( Time, posPrime, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) + CALL WaveField_Interp_Setup4D( Time+WaveField%WaveTimeShift, posPrime, WaveField%GridDepth, WaveField%VolGridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = GridInterp4DVec( WaveField%WaveVel, WaveField_m ) + FA(:) = GridInterp4DVec( WaveField%WaveAcc, WaveField_m ) END IF @@ -369,6 +401,7 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNod nodeInWater = 0_IntKi FV(:) = 0.0 + FA(:) = 0.0 END IF ! If node is in or out of water @@ -379,12 +412,12 @@ logical function Failed() call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) Failed = ErrStat >= AbortErrLev end function -END SUBROUTINE WaveField_GetNodeWaveVel +END SUBROUTINE WaveField_GetNodeWaveVelAcc SUBROUTINE WaveField_GetWaveKin( WaveField, WaveField_m, Time, pos, forceNodeInWater, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) type(SeaSt_WaveFieldType), intent(in ) :: WaveField - type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + type(GridInterp_MiscVarType), intent(inout) :: WaveField_m real(DbKi), intent(in ) :: Time real(ReKi), intent(in ) :: pos(:,:) logical, intent(in ) :: forceNodeInWater @@ -433,460 +466,62 @@ end subroutine WaveField_GetWaveKin ! Interpolation related functions !---------------------------------------------------------------------------------------------------- -subroutine SetCartesianXYIndex(p, pZero, delta, nMax, Indx_Lo, Indx_Hi, isopc, FirstWarn, ErrStat, ErrMsg) - REAL(ReKi), intent(in ) :: p - REAL(ReKi), intent(in ) :: pZero - REAL(ReKi), intent(in ) :: delta - INTEGER(IntKi), intent(in ) :: nMax - INTEGER(IntKi), intent(inout) :: Indx_Lo - INTEGER(IntKi), intent(inout) :: Indx_Hi - real(SiKi), intent(inout) :: isopc - logical, intent(inout) :: FirstWarn - INTEGER(IntKi), intent( out) :: ErrStat - CHARACTER(*), intent( out) :: ErrMsg - - real(ReKi) :: Tmp - - ErrStat = ErrID_None - ErrMsg = "" - - isopc = -1.0 - Indx_Lo = 0 - Indx_Hi = 0 - - if ( nMax .EQ. 1_IntKi ) then ! Only one grid point - Indx_Lo = 1_IntKi - Indx_Hi = 1_IntKi - isopc = 0_SiKi - return - end if - - Tmp = (p-pZero) / delta - Indx_Lo = INT( Tmp ) + 1 ! convert REAL to INTEGER, then add one since our grid indices start at 1, not 0 - isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo - 1, ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 - - if ( Indx_Lo < 1 ) then - Indx_Lo = 1 - isopc = -1.0 - if (FirstWarn) then - call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianXYIndex') !error out if time is outside the lower bounds - FirstWarn = .false. - end if - end if - - Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, zero-based - - if ( Indx_Lo >= Indx_Hi ) then - ! Need to clamp to grid boundary - if (FirstWarn .and. Indx_Lo /= Indx_Hi) then ! don't warn if we are exactly at the boundary - call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianXYIndex') !error out if time is outside the lower bounds - FirstWarn = .false. - end if - Indx_Lo = max(Indx_Hi - 1, 1) - isopc = 1.0 - end if - - !------------------------------------------------------------------------------------------------- - ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) - !------------------------------------------------------------------------------------------------- - isopc = min( 1.0_SiKi, isopc ) - isopc = max(-1.0_SiKi, isopc ) - -end subroutine SetCartesianXYIndex - - -subroutine SetCartesianZIndex(p, z_depth, delta, nMax, Indx_Lo, Indx_Hi, isopc, FirstWarn, ErrStat, ErrMsg) - real(ReKi), intent(in ) :: p - real(ReKi), intent(in ) :: z_depth - real(ReKi), intent(in ) :: delta - integer(IntKi), intent(in ) :: nMax - integer(IntKi), intent(inout) :: Indx_Lo - integer(IntKi), intent(inout) :: Indx_Hi - real(SiKi), intent(inout) :: isopc - logical, intent(inout) :: FirstWarn - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - - real(ReKi) :: Tmp - - ErrStat = ErrID_None - ErrMsg = "" - - isopc = -1.0 - Indx_Lo = 0 - Indx_Hi = 0 - - - !Tmp = acos(-p / z_depth) / delta - Tmp = acos( max(-1.0_ReKi, min(1.0_ReKi, 1+(p / z_depth)) ) ) / delta - Tmp = nmax - 1 - Tmp - Indx_Lo = INT( Tmp ) + 1 ! convert REAL to INTEGER, then add one since our grid indices start at 1, not 0 - isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo - 1, ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 - - if ( Indx_Lo < 1 ) then - Indx_Lo = 1 - isopc = -1.0 - if (FirstWarn) then - call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianZIndex') !error out if z is outside the lower bounds - FirstWarn = .false. - end if - end if - - Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, one-based - - if ( Indx_Lo >= Indx_Hi ) then - ! Need to clamp to grid boundary - if (FirstWarn .and. Indx_Lo /= Indx_Hi) then ! don't warn if we are exactly at the boundary - call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianZIndex') !error out if z is outside the upper bounds - FirstWarn = .false. - end if - Indx_Lo = max(Indx_Hi - 1, 1) - isopc = 1.0 - end if - - !------------------------------------------------------------------------------------------------- - ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) - !------------------------------------------------------------------------------------------------- - isopc = min( 1.0_SiKi, isopc ) - isopc = max(-1.0_SiKi, isopc ) - -end subroutine SetCartesianZIndex - - -subroutine SetTimeIndex(Time, deltaT, nMax, Indx_Lo, Indx_Hi, isopc, ErrStat, ErrMsg) - real(DbKi), intent(in ) :: Time !< time from the start of the simulation - real(ReKi), intent(in ) :: deltaT - integer(IntKi), intent(in ) :: nMax - integer(IntKi), intent(inout) :: Indx_Lo - integer(IntKi), intent(inout) :: Indx_Hi - real(SiKi), intent(inout) :: isopc - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - - real(ReKi) :: Tmp - - ErrStat = ErrID_None - ErrMsg = "" - - isopc = -1.0 - Indx_Lo = 0 - Indx_Hi = 0 - if ( Time < 0.0_DbKi ) then - CALL SetErrStat(ErrID_Fatal,'Time value must be greater than or equal to zero!',ErrStat,ErrMsg,'SetTimeIndex') !error out if time is outside the lower bounds - RETURN - end if - - ! if there are no timesteps, don't proceed - if (EqualRealNos(deltaT,0.0_ReKi) .or. deltaT < 0.0_ReKi) return; - -! NOTE: nMax is the total number of time values in the grid, since this is zero-based indexing, the max index is nMax-1 -! for example: in a time grid with 11 grid points, the indices run from 0,1,2,3,4,5,6,7,8,9,10 -! for the repeating waves feature, index 10 is the same as index 0, so if Indx_Lo = 10 then we want to -! wrap it back to index 0, if Indx_Lo = 11 we want to wrap back to index 1. - - Tmp = real( (Time/ real(deltaT,DbKi)) ,ReKi) - Tmp = MOD(Tmp,real((nMax), ReKi)) - Indx_Lo = INT( Tmp ) ! convert REAL to INTEGER - - isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo , ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 - - !------------------------------------------------------------------------------------------------- - ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) - !------------------------------------------------------------------------------------------------- - isopc = min( 1.0_SiKi, isopc ) - isopc = max(-1.0_SiKi, isopc ) - - Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, zero-based - -end subroutine SetTimeIndex - - !==================================================================================================== !> This routine sets up interpolation of a 3-d or 4-d dataset. !! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf -subroutine WaveField_Interp_Setup4D( Time, Position, p, m, ErrStat, ErrMsg ) - real(DbKi), intent(in ) :: Time !< time from the start of the simulation - real(ReKi), intent(in ) :: Position(3) !< Array of XYZ coordinates, 3 - type(SeaSt_WaveField_ParameterType), intent(in ) :: p !< Parameters - type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< MiscVars +subroutine WaveField_Interp_Setup3D( Time, Position, p, m, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: Time !< Time from the start of the simulation + real(ReKi), intent(in ) :: Position(2) !< Array of XY coordinates, 2 + type(GridInterp_ParameterType), intent(in ) :: p !< Parameters + type(GridInterp_MiscVarType), intent(inout) :: m !< MiscVars integer(IntKi), intent( out) :: ErrStat !< Error status character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - character(*), parameter :: RoutineName = 'WaveField_Interp_Setup4D' - integer(IntKi) :: i - real(SiKi) :: isopc(4) ! isoparametric coordinates + character(*), parameter :: RoutineName = 'WaveField_Interp_Setup3D' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 ErrStat = ErrID_None ErrMsg = "" - ! Find the bounding indices for time - call SetTimeIndex(Time, p%delta(1), p%n(1), m%Indx_Lo(1), m%Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) - if (Failed()) return; - - ! Find the bounding indices for XY position - do i=2,3 ! x and y components - call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), m%Indx_Lo(i), m%Indx_Hi(i), isopc(i), m%FirstWarn_Clamp, ErrStat2, ErrMsg2) - if (Failed()) return; - enddo - - ! Find the bounding indices for Z position - i=4 ! z component - if (p%Z_Depth>0) then - call SetCartesianZIndex(Position(i-1), p%Z_Depth, p%delta(i), p%n(i), m%Indx_Lo(i), m%Indx_Hi(i), isopc(i), m%FirstWarn_Clamp, ErrStat2, ErrMsg2) - if (Failed()) return; - else ! Regular z-grid - call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), m%Indx_Lo(i), m%Indx_Hi(i), isopc(i), m%FirstWarn_Clamp, ErrStat2, ErrMsg2) - if (Failed()) return; - end if - - ! compute weighting factors - m%N4D( 1) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D( 2) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D( 3) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D( 4) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D( 5) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D( 6) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D( 7) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D( 8) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D( 9) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D(10) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D(11) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D(12) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D(13) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D(14) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D(15) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D(16) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D = m%N4D / REAL( SIZE(m%N4D), SiKi ) ! normalize + CALL GridInterpSetup3D((/Real(Time,ReKi),Position(1),Position(2)/), p, m, ErrStat2, ErrMsg2 ) + if (Failed()) return; contains logical function Failed() call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) Failed = ErrStat >= AbortErrLev end function -END Subroutine WaveField_Interp_Setup4D - +END Subroutine WaveField_Interp_Setup3D -subroutine WaveField_Interp_Setup3D( Time, Position, p, m, ErrStat, ErrMsg ) - real(DbKi), intent(in ) :: Time !< time from the start of the simulation - real(ReKi), intent(in ) :: Position(2) !< Array of XYZ coordinates, 3 - type(SeaSt_WaveField_ParameterType), intent(in ) :: p !< Parameters - type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< MiscVars +subroutine WaveField_Interp_Setup4D( Time, Position, GridDepth, p, m, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: Time !< Time from the start of the simulation + real(ReKi), intent(in ) :: Position(3) !< Array of XYZ coordinates, 3 + real(SiKi), intent(in ) :: GridDepth !< Depth (>0) of the wave grid below SWL + type(GridInterp_ParameterType), intent(in ) :: p !< Parameters + type(GridInterp_MiscVarType), intent(inout) :: m !< MiscVars integer(IntKi), intent( out) :: ErrStat !< Error status character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - character(*), parameter :: RoutineName = 'WaveField_Interp_Setup3D' - integer(IntKi) :: i - real(SiKi) :: isopc(4) ! isoparametric coordinates + real(ReKi) :: kz + + character(*), parameter :: RoutineName = 'WaveField_Interp_Setup4D' integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 ErrStat = ErrID_None ErrMsg = "" - ! Find the bounding indices for time - call SetTimeIndex(Time, p%delta(1), p%n(1), m%Indx_Lo(1), m%Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) - if (Failed()) return; - - ! Find the bounding indices for XY position - do i=2,3 ! x and y components - call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), m%Indx_Lo(i), m%Indx_Hi(i), isopc(i), m%FirstWarn_Clamp, ErrStat2, ErrMsg2) - if (Failed()) return; - enddo - - ! compute weighting factors - m%N3D(1) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - m%N3D(2) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - m%N3D(3) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - m%N3D(4) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - m%N3D(5) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - m%N3D(6) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - m%N3D(7) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - m%N3D(8) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - m%N3D = m%N3D / REAL( SIZE(m%N3D), ReKi ) ! normalize + ! Map physical z-coordinate to grid index space + kz = 0.5_ReKi*Pi - acos( max( -1.0_ReKi, min( 1.0_ReKi, 1.0_ReKi + (Position(3) / GridDepth) ) ) ) + call GridInterpSetup4D( (/Real(Time,ReKi),Position(1),Position(2),kz/), p, m, ErrStat, ErrMsg ) contains logical function Failed() call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) Failed = ErrStat >= AbortErrLev end function -END Subroutine WaveField_Interp_Setup3D - - -!==================================================================================================== -!> This routine interpolates a 4-d dataset. -!! This method is described here: http://rjwagner49.com/Mathematics/WaveFieldolation.pdf -function WaveField_Interp_4D( pKinXX, m ) - real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) - type(SeaSt_WaveField_MiscVarType), intent(in ) :: m - - real(SiKi) :: WaveField_Interp_4D - real(SiKi) :: u(16) ! size 2^n - - ! interpolate - u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - WaveField_Interp_4D = SUM ( m%N4D * u ) -end function WaveField_Interp_4D - - -!==================================================================================================== -!> This routine interpolates a 4-d dataset. -!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf -function WaveField_Interp_4D_Vec( pKinXX, m) - real(SiKi), intent(in ) :: pKinXX(0:,:,:,:,:) - type(SeaSt_WaveField_MiscVarType), intent(in ) :: m !< misc vars for interpolation - - real(SiKi) :: WaveField_Interp_4D_Vec(3) - real(SiKi) :: u(16) ! size 2^n - integer(IntKi) :: iDir - - ! interpolate - do iDir = 1,3 - u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - WaveField_Interp_4D_Vec(iDir) = SUM ( m%N4D * u ) - end do -END FUNCTION WaveField_Interp_4D_Vec - - -!==================================================================================================== -!> This routine interpolates a 4-d dataset. -!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf -function WaveField_Interp_4D_Vec6( pKinXX, m) - real(SiKi), intent(in ) :: pKinXX(0:,:,:,:,:) - type(SeaSt_WaveField_MiscVarType), intent(in ) :: m !< misc vars for interpolation - - real(SiKi) :: WaveField_Interp_4D_Vec6(6) - real(SiKi) :: u(16) ! size 2^n - integer(IntKi) :: iDir - - ! interpolate - do iDir = 1,6 - u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - WaveField_Interp_4D_Vec6(iDir) = SUM ( m%N4D * u ) - end do -END FUNCTION WaveField_Interp_4D_Vec6 - - -!==================================================================================================== -!> This routine interpolates a 3-d dataset with index 1 = time (zero-based indexing), 2 = x-coordinate (1-based indexing), 3 = y-coordinate (1-based indexing) -!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf -!FIXME: do like the above and call the WaveField_Interp_Setup3D routine ahead -function WaveField_Interp_3D( pKinXX, m ) - real(SiKi), intent(in ) :: pKinXX(0:,:,:) !< 3D Wave elevation data (SiKi for storage space reasons) - type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< MiscVars - - character(*), parameter :: RoutineName = 'WaveField_Interp_3D' - real(SiKi) :: WaveField_Interp_3D - real(SiKi) :: u(8) - integer(IntKi) :: i - - ! interpolate - u(1) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3) ) - u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3) ) - u(3) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3) ) - u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3) ) - u(5) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3) ) - u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3) ) - u(7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3) ) - u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3) ) - WaveField_Interp_3D = SUM ( m%N3D * u ) -end function WaveField_Interp_3D - - -FUNCTION WaveField_Interp_3D_VEC( pKinXX, m ) - real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) - type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< MiscVars - - character(*), parameter :: RoutineName = 'WaveField_Interp_3D_VEC' - real(SiKi) :: WaveField_Interp_3D_VEC(3) - real(SiKi) :: u(8) - integer(IntKi) :: i - - ! interpolate - do i = 1,3 - u(1) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) - u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) - u(3) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) - u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) - u(5) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) - u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) - u(7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) - u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) - WaveField_Interp_3D_VEC(i) = SUM ( m%N3D * u ) - end do -end function WaveField_Interp_3D_VEC - - -function Wavefield_Interp_3D_VEC6( pKinXX, m ) - real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) - type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< Miscvars - - character(*), parameter :: RoutineName = 'Wavefield_Interp_3D_VEC6' - real(SiKi) :: Wavefield_Interp_3D_VEC6(6) - real(SiKi) :: u(8) - integer(IntKi) :: i - - ! interpolate - do i = 1,6 - u(1) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) - u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) - u(3) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) - u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) - u(5) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) - u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) - u(7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) - u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) - Wavefield_Interp_3D_VEC6(i) = SUM ( m%N3D * u ) - end do -end function Wavefield_Interp_3D_VEC6 - +END Subroutine WaveField_Interp_Setup4D END MODULE SeaSt_WaveField diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index 4dc9ba0732..d7ab572f09 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -1,5 +1,6 @@ # ...... Include files ..... usefrom Current.txt +usefrom GridInterp.txt #--------------------------------------------------------------------------------------------------------------------------------------------------------- # Data structures for representing wave fields. # @@ -23,11 +24,6 @@ param SeaSt_WaveField - INTEGER ConstWaveMod #--------------------------------------------------------------------------------------------------------------------------------------------------------- # #--------------------------------------------------------------------------------------------------------------------------------------------------------- -typedef ^ ParameterType IntKi n 4 - - "number of evenly-spaced grid points in the t, x, y, and z directions" - -typedef ^ ParameterType ReKi delta 4 - - "size between 2 consecutive grid points in each grid direction" "s,m,m,m" -typedef ^ ParameterType ReKi pZero 4 - - "fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:))" "m" -typedef ^ ParameterType ReKi Z_Depth - - - "grid depth" m - typedef ^ MiscVarType SiKi N3D {8} - - "this is the weighting function for 3-d velocity field" - typedef ^ MiscVarType SiKi N4D {16} - - "this is the weighting function for 4-d velocity field" - typedef ^ MiscVarType integer Indx_Lo 4 - - "this is the index into the 4-d velocity field for each wave component" - @@ -47,7 +43,8 @@ typedef ^ ^ SiKi PWaveVel0 typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point (NOTE THAT THIS CAN GET MODIFIED IN WAMIT)" (m) typedef ^ ^ SiKi WaveElev1 {:}{:}{:} - - "First order wave elevation" (m) typedef ^ ^ SiKi WaveElev2 {:}{:}{:} - - "Second order wave elevation" (m) -typedef ^ ^ SeaSt_WaveField_ParameterType GridParams - - - "Parameters for grid spacing" (-) +typedef ^ ^ GridInterp_ParameterType SrfGridParams - - - "Parameters of the wave free surface grid needed for interpolation" - +typedef ^ ^ GridInterp_ParameterType VolGridParams - - - "Parameters of the wave field volume grid needed for interpolation" - typedef ^ ^ IntKi WaveStMod - - - "Wave stretching model" typedef ^ ^ ReKi EffWtrDpth - - - "Water depth" (-) typedef ^ ^ ReKi MSL2SWL - - - "Vertical distance from mean sea level to still water level" (m) @@ -74,4 +71,6 @@ typedef ^ ^ INTEGER WaveMod typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - +typedef ^ ^ SiKi GridDepth - - - "Depth (>0) of wave grid below SWL" m +typedef ^ ^ DbKi WaveTimeShift - 0 - "Add this to the time to effectively phase shift the wave (useful for hybrid tank testing). Positive value only (advance time)" (s) typedef ^ ^ Current_InitInputType Current_InitInput - - - "InitInputs in the Current Module. For coupling with MD." - diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 6db5590929..a7493d67e6 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -32,6 +32,7 @@ MODULE SeaSt_WaveField_Types !--------------------------------------------------------------------------------------------------------------------------------- USE Current_Types +USE GridInterp_Types USE NWTC_Library IMPLICIT NONE INTEGER(IntKi), PUBLIC, PARAMETER :: WaveDirMod_None = 0 ! WaveDirMod = 0 [Directional spreading function is NONE] [-] @@ -48,14 +49,6 @@ MODULE SeaSt_WaveField_Types INTEGER(IntKi), PUBLIC, PARAMETER :: ConstWaveMod_None = 0 ! ConstWaveMod = 0 [Constrained wave model: No constrained waves] [-] INTEGER(IntKi), PUBLIC, PARAMETER :: ConstWaveMod_CrestElev = 1 ! ConstWaveMod = 1 [Constrained wave model: Constrained wave with specified crest elevation, alpha] [-] INTEGER(IntKi), PUBLIC, PARAMETER :: ConstWaveMod_Peak2Trough = 2 ! ConstWaveMod = 2 [Constrained wave model: Constrained wave with guaranteed peak-to-trough crest height, HCrest] [-] -! ========= SeaSt_WaveField_ParameterType ======= - TYPE, PUBLIC :: SeaSt_WaveField_ParameterType - INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of evenly-spaced grid points in the t, x, y, and z directions [-] - REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction [s,m,m,m] - REAL(ReKi) , DIMENSION(1:4) :: pZero = 0.0_ReKi !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] - REAL(ReKi) :: Z_Depth = 0.0_ReKi !< grid depth [m] - END TYPE SeaSt_WaveField_ParameterType -! ======================= ! ========= SeaSt_WaveField_MiscVarType ======= TYPE, PUBLIC :: SeaSt_WaveField_MiscVarType REAL(SiKi) , DIMENSION(1:8) :: N3D = 0.0_R4Ki !< this is the weighting function for 3-d velocity field [-] @@ -79,7 +72,8 @@ MODULE SeaSt_WaveField_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point (NOTE THAT THIS CAN GET MODIFIED IN WAMIT) [(m)] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElev1 !< First order wave elevation [(m)] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElev2 !< Second order wave elevation [(m)] - TYPE(SeaSt_WaveField_ParameterType) :: GridParams !< Parameters for grid spacing [(-)] + TYPE(GridInterp_ParameterType) :: SrfGridParams !< Parameters of the wave free surface grid needed for interpolation [-] + TYPE(GridInterp_ParameterType) :: VolGridParams !< Parameters of the wave field volume grid needed for interpolation [-] INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Wave stretching model [-] REAL(ReKi) :: EffWtrDpth = 0.0_ReKi !< Water depth [(-)] REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Vertical distance from mean sea level to still water level [(m)] @@ -104,58 +98,13 @@ MODULE SeaSt_WaveField_Types INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model: See valid values in SeaSt_WaveField module parameters. [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] + REAL(SiKi) :: GridDepth = 0.0_R4Ki !< Depth (>0) of wave grid below SWL [m] + REAL(DbKi) :: WaveTimeShift = 0 !< Add this to the time to effectively phase shift the wave (useful for hybrid tank testing). Positive value only (advance time) [(s)] TYPE(Current_InitInputType) :: Current_InitInput !< InitInputs in the Current Module. For coupling with MD. [-] END TYPE SeaSt_WaveFieldType ! ======================= CONTAINS -subroutine SeaSt_WaveField_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) - type(SeaSt_WaveField_ParameterType), intent(in) :: SrcParamData - type(SeaSt_WaveField_ParameterType), intent(inout) :: DstParamData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_WaveField_CopyParam' - ErrStat = ErrID_None - ErrMsg = '' - DstParamData%n = SrcParamData%n - DstParamData%delta = SrcParamData%delta - DstParamData%pZero = SrcParamData%pZero - DstParamData%Z_Depth = SrcParamData%Z_Depth -end subroutine - -subroutine SeaSt_WaveField_DestroyParam(ParamData, ErrStat, ErrMsg) - type(SeaSt_WaveField_ParameterType), intent(inout) :: ParamData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_WaveField_DestroyParam' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine SeaSt_WaveField_PackParam(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SeaSt_WaveField_ParameterType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SeaSt_WaveField_PackParam' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%n) - call RegPack(RF, InData%delta) - call RegPack(RF, InData%pZero) - call RegPack(RF, InData%Z_Depth) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_WaveField_UnPackParam(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SeaSt_WaveField_ParameterType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SeaSt_WaveField_UnPackParam' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%delta); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%pZero); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Z_Depth); if (RegCheckErr(RF, RoutineName)) return -end subroutine - subroutine SeaSt_WaveField_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) type(SeaSt_WaveField_MiscVarType), intent(in) :: SrcMiscData type(SeaSt_WaveField_MiscVarType), intent(inout) :: DstMiscData @@ -362,7 +311,10 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if DstSeaSt_WaveFieldTypeData%WaveElev2 = SrcSeaSt_WaveFieldTypeData%WaveElev2 end if - call SeaSt_WaveField_CopyParam(SrcSeaSt_WaveFieldTypeData%GridParams, DstSeaSt_WaveFieldTypeData%GridParams, CtrlCode, ErrStat2, ErrMsg2) + call GridInterp_CopyParam(SrcSeaSt_WaveFieldTypeData%SrfGridParams, DstSeaSt_WaveFieldTypeData%SrfGridParams, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call GridInterp_CopyParam(SrcSeaSt_WaveFieldTypeData%VolGridParams, DstSeaSt_WaveFieldTypeData%VolGridParams, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstSeaSt_WaveFieldTypeData%WaveStMod = SrcSeaSt_WaveFieldTypeData%WaveStMod @@ -422,6 +374,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveMod = SrcSeaSt_WaveFieldTypeData%WaveMod DstSeaSt_WaveFieldTypeData%NStepWave = SrcSeaSt_WaveFieldTypeData%NStepWave DstSeaSt_WaveFieldTypeData%NStepWave2 = SrcSeaSt_WaveFieldTypeData%NStepWave2 + DstSeaSt_WaveFieldTypeData%GridDepth = SrcSeaSt_WaveFieldTypeData%GridDepth + DstSeaSt_WaveFieldTypeData%WaveTimeShift = SrcSeaSt_WaveFieldTypeData%WaveTimeShift call Current_CopyInitInput(SrcSeaSt_WaveFieldTypeData%Current_InitInput, DstSeaSt_WaveFieldTypeData%Current_InitInput, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -472,7 +426,9 @@ subroutine SeaSt_WaveField_DestroySeaSt_WaveFieldType(SeaSt_WaveFieldTypeData, E if (allocated(SeaSt_WaveFieldTypeData%WaveElev2)) then deallocate(SeaSt_WaveFieldTypeData%WaveElev2) end if - call SeaSt_WaveField_DestroyParam(SeaSt_WaveFieldTypeData%GridParams, ErrStat2, ErrMsg2) + call GridInterp_DestroyParam(SeaSt_WaveFieldTypeData%SrfGridParams, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call GridInterp_DestroyParam(SeaSt_WaveFieldTypeData%VolGridParams, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(SeaSt_WaveFieldTypeData%WaveElevC)) then deallocate(SeaSt_WaveFieldTypeData%WaveElevC) @@ -504,7 +460,8 @@ subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, Indata) call RegPackAlloc(RF, InData%WaveElev0) call RegPackAlloc(RF, InData%WaveElev1) call RegPackAlloc(RF, InData%WaveElev2) - call SeaSt_WaveField_PackParam(RF, InData%GridParams) + call GridInterp_PackParam(RF, InData%SrfGridParams) + call GridInterp_PackParam(RF, InData%VolGridParams) call RegPack(RF, InData%WaveStMod) call RegPack(RF, InData%EffWtrDpth) call RegPack(RF, InData%MSL2SWL) @@ -529,6 +486,8 @@ subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, Indata) call RegPack(RF, InData%WaveMod) call RegPack(RF, InData%NStepWave) call RegPack(RF, InData%NStepWave2) + call RegPack(RF, InData%GridDepth) + call RegPack(RF, InData%WaveTimeShift) call Current_PackInitInput(RF, InData%Current_InitInput) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -553,7 +512,8 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(RF, OutData) call RegUnpackAlloc(RF, OutData%WaveElev0); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WaveElev1); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WaveElev2); if (RegCheckErr(RF, RoutineName)) return - call SeaSt_WaveField_UnpackParam(RF, OutData%GridParams) ! GridParams + call GridInterp_UnpackParam(RF, OutData%SrfGridParams) ! SrfGridParams + call GridInterp_UnpackParam(RF, OutData%VolGridParams) ! VolGridParams call RegUnpack(RF, OutData%WaveStMod); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%EffWtrDpth); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return @@ -578,6 +538,8 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(RF, OutData) call RegUnpack(RF, OutData%WaveMod); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NStepWave); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NStepWave2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GridDepth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveTimeShift); if (RegCheckErr(RF, RoutineName)) return call Current_UnpackInitInput(RF, OutData%Current_InitInput) ! Current_InitInput end subroutine END MODULE SeaSt_WaveField_Types diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index af5d0b15bf..6bce2063b9 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -32,6 +32,7 @@ MODULE SeaState USE SeaState_Output USE Current USE Waves2 + USE GridInterp IMPLICIT NONE PRIVATE @@ -170,6 +171,13 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Initialize Waves module (Note that this may change InputFileData%Waves%WaveDT) CALL Waves_Init(InputFileData%Waves, Waves_InitOut, p%WaveField, ErrStat2, ErrMsg2 ); if(Failed()) return; + ! Store the WaveTimeShift + p%WaveField%WaveTimeShift = InitInp%WaveTimeShift + if (p%WaveField%WaveTimeShift < 0.0_DbKi) then + call SetErrStat(ErrID_Fatal, 'WaveTimeShift from driver code cannot be negative', ErrStat, ErrMsg, RoutineName) + return + endif + ! Copy Waves initialization output into the initialization input type for the WAMIT module p%WaveDT = InputFileData%Waves%WaveDT @@ -260,16 +268,28 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init CALL SeaStOut_WrSummaryFile(InitInp, InputFileData, p, ErrStat2, ErrMsg2); if(Failed()) return; - - ! Setup the 4D grid information for the Interpolation Module - p%WaveField%GridParams%n = (/p%WaveField%NStepWave,p%nGrid(1),p%nGrid(2),p%nGrid(3)/) - p%WaveField%GridParams%delta = (/real(p%WaveDT,ReKi),p%deltaGrid(1),p%deltaGrid(2),p%deltaGrid(3)/) - p%WaveField%GridParams%pZero(1) = 0.0 !Time - p%WaveField%GridParams%pZero(2) = -InputFileData%X_HalfWidth - p%WaveField%GridParams%pZero(3) = -InputFileData%Y_HalfWidth - p%WaveField%GridParams%pZero(4) = -InputFileData%Z_Depth ! zi - p%WaveField%GridParams%Z_Depth = InputFileData%Z_Depth + ! Setup the 3D and 4D grid information for the Interpolation Module + p%WaveField%GridDepth = InputFileData%Z_Depth + + ! Set the parameters of the 3D free surface grid + CALL GridInterp_SetParams(3_IntKi, & ! dimension + (/p%WaveField%NStepWave,p%nGrid(1),p%nGrid(2)/), & ! n + (/real(p%WaveDT,ReKi),p%deltaGrid(1),p%deltaGrid(2)/), & ! delta + (/0.0,-InputFileData%X_HalfWidth,-InputFileData%Y_HalfWidth/), & ! pZero + (/.true.,.false.,.false./), & ! periodicity + p%WaveField%SrfGridParams, ErrStat2, ErrMsg2 ) + if(Failed()) return; + + ! Set the parameters of the 4D volume grid + CALL GridInterp_SetParams(4_IntKi, & ! dimension + (/p%WaveField%NStepWave,p%nGrid(1),p%nGrid(2),p%nGrid(3)/), & ! n + (/real(p%WaveDT,ReKi),p%deltaGrid(1),p%deltaGrid(2),p%deltaGrid(3)/), & ! delta + (/0.0,-InputFileData%X_HalfWidth,-InputFileData%Y_HalfWidth,0.0/), & ! pZero + (/.true.,.false.,.false.,.false./), & ! periodicity + p%WaveField%VolGridParams, ErrStat2, ErrMsg2 ) + if(Failed()) return; + IF ( p%OutSwtch == 1 ) THEN ! Only SeaSt-level output writing ! HACK WE can tell FAST not to write any SeaState outputs by simply deallocating the WriteOutputHdr array! @@ -390,15 +410,15 @@ subroutine SurfaceVisGenerate(ErrStat3, ErrMsg3) ErrMsg3 = "" ! Grid half width from the WaveField - HWidX = (real(p%WaveField%GridParams%n(2)-1,SiKi)) / 2.0_SiKi * p%WaveField%GridParams%delta(2) - HWidY = (real(p%WaveField%GridParams%n(3)-1,SiKi)) / 2.0_SiKi * p%WaveField%GridParams%delta(3) + HWidX = (real(p%WaveField%SrfGridParams%n(2)-1,SiKi)) / 2.0_SiKi * p%WaveField%SrfGridParams%delta(2) + HWidY = (real(p%WaveField%SrfGridParams%n(3)-1,SiKi)) / 2.0_SiKi * p%WaveField%SrfGridParams%delta(3) if ((InitInp%SurfaceVisNx <= 0) .or. (InitInp%SurfaceVisNy <= 0))then ! use the SeaState points exactly ! Set number of points to the number of seastate grid points in each direction - Nx = p%WaveField%GridParams%n(2) - Ny = p%WaveField%GridParams%n(3) - dx = p%WaveField%GridParams%delta(2) - dy = p%WaveField%GridParams%delta(3) + Nx = p%WaveField%SrfGridParams%n(2) + Ny = p%WaveField%SrfGridParams%n(3) + dx = p%WaveField%SrfGridParams%delta(2) + dy = p%WaveField%SrfGridParams%delta(3) call SetErrStat(ErrID_Info,"Setting wavefield visualization grid to "//trim(Num2LStr(Nx))//" x "//trim(Num2LStr(Ny))//"points",ErrStat3,ErrMsg3,RoutineName) elseif ((InitInp%SurfaceVisNx < 3) .or. (InitInp%SurfaceVisNx < 3)) then ! Set to 3 for minimum Nx = 3 diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index f38dfdf231..67d328588a 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -72,6 +72,7 @@ typedef ^ ^ ReKi def typedef ^ ^ ReKi defWtrDpth - - - "Default water depth from the driver; may be overwritten " "m" typedef ^ ^ ReKi defMSL2SWL - - - "Default mean sea level to still water level from the driver; may be overwritten" "m" typedef ^ ^ DbKi TMax - - - "Supplied by Driver: The total simulation time" "(sec)" +typedef ^ ^ DbKi WaveTimeShift - 0 - "Add this to the time to effectively phase shift the wave (useful for hybrid tank testing). Positive value only (advance time)" (s) typedef ^ ^ INTEGER WaveFieldMod - - - "Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin" - typedef ^ ^ ReKi PtfmLocationX - - - "Supplied by Driver: X coordinate of platform location in the wave field" "m" typedef ^ ^ ReKi PtfmLocationY - - - "Supplied by Driver: Y coordinate of platform location in the wave field" "m" @@ -126,7 +127,7 @@ typedef ^ OtherStateType R8Ki Unu typedef ^ MiscVarType INTEGER Decimate - - - "The output decimation counter" - typedef ^ ^ DbKi LastOutTime - - - "Last time step which was written to the output file (sec)" - typedef ^ ^ INTEGER LastIndWave - - - "The last index used in the wave kinematics arrays, used to optimize interpolation" - -typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - +typedef ^ ^ GridInterp_MiscVarType WaveField_m - - - "misc var information from the Grid Interpolation module" - # .... Linearization params ....................................................................................................... # NOTE: This is overkill given how limited linearization is. For completeness and similarity to other modules, keeping all this here. Also note some diff --git a/modules/seastate/src/SeaState_C_Binding.f90 b/modules/seastate/src/SeaState_C_Binding.f90 index a23a79f77f..1a7a6d81d9 100644 --- a/modules/seastate/src/SeaState_C_Binding.f90 +++ b/modules/seastate/src/SeaState_C_Binding.f90 @@ -19,289 +19,1023 @@ !********************************************************************************************************************************** MODULE SeaState_C_Binding - USE ISO_C_BINDING - USE SeaState - USE SeaState_Types - USE SeaState_Output - USE NWTC_Library - USE NWTC_C_Binding, ONLY: ErrMsgLen_C, IntfStrLen, SetErr, FileNameFromCString - USE VersionInfo - - IMPLICIT NONE - SAVE - - PUBLIC :: SeaSt_C_Init - PUBLIC :: SeaSt_C_CalcOutput - PUBLIC :: SeaSt_C_End - - !------------------------------------------------------------------------------------ - ! Version info for display - TYPE(ProgDesc), PARAMETER :: version = SeaSt_ProgDesc - - !------------------------------------------------------------------------------------ - ! Debugging: DebugLevel -- passed at PreInit - ! 0 - none - ! 1 - some summary info - ! 2 - above + all position/orientation info - ! 3 - above + input files (if direct passed) - ! 4 - above + meshes - INTEGER(IntKi) :: DebugLevel = 0 - - !------------------------------ - ! Primary derived types - TYPE(SeaSt_InputType) :: InputData !< Inputs to SeaState - TYPE(SeaSt_InitInputType) :: InitInp - TYPE(SeaSt_InitOutputType) :: InitOutData !< Initial output data -- Names, units, and version info. - TYPE(SeaSt_ParameterType) :: p !< Parameters - TYPE(SeaSt_OutputType) :: y !< Initial output (outputs are not calculated; only the output mesh is initialized) - TYPE(SeaSt_MiscVarType) :: m !< Misc variables for optimization (not copied in glue code) - -CONTAINS - - -SUBROUTINE SeaSt_C_Init(InputFile_C, OutRootName_C, Gravity_C, WtrDens_C, WtrDpth_C, MSL2SWL_C, NSteps_C, TimeInterval_C, WaveElevSeriesFlag_C, WrWvKinMod_C, NumChannels_C, OutputChannelNames_C, OutputChannelUnits_C, ErrStat_C, ErrMsg_C) BIND (C, NAME='SeaSt_C_Init') -IMPLICIT NONE + USE ISO_C_BINDING + USE SeaSt_WaveField + USE SeaState + USE SeaState_Types + USE SeaState_Output + USE NWTC_Library + USE NWTC_C_Binding, ONLY: ErrMsgLen_C, IntfStrLen, SetErrStat_F2C, FileNameFromCString + USE VersionInfo + + implicit none + save + + PUBLIC :: SeaSt_C_PreInit + PUBLIC :: SeaSt_C_Init + PUBLIC :: SeaSt_C_CalcOutput + PUBLIC :: SeaSt_C_End + PUBLIC :: SeaSt_C_GetWaveFieldPointer + PUBLIC :: SeaSt_C_SetWaveFieldPointer + PUBLIC :: SeaSt_C_GetFluidVelAcc + PUBLIC :: SeaSt_C_GetSurfElev + PUBLIC :: SeaSt_C_GetSurfNorm + PUBLIC :: SeaSt_C_GetElevMinMaxEstimate + PUBLIC :: SeaSt_C_GetDens + PUBLIC :: SeaSt_C_GetDpth + PUBLIC :: SeaSt_C_GetMSL2SWL + + !------------------------------------------------------------------------------------ + ! Debugging: DebugLevel -- passed at PreInit + ! 0 - none + ! 1 - some summary info + ! 2 - above + all position/orientation info + ! 3 - above + input files (if direct passed) + ! 4 - above + meshes + integer(IntKi) :: DebugLevel + logical :: PreInitDone = .false. + + !------------------------------------------------------------------------------------ + ! Visualization + type VTKvis + character(1024) :: outdir + character(1024) :: OutRootName ! includes directory + integer(IntKi) :: write ! 0 off, 1 init, 2 animate + real(DbKi) :: dt + integer(IntKi) :: NWaveElevPts(2) ! number of points in x/y directions + real(SiKi), allocatable :: WaveElevVisX(:),WaveElevVisY(:) ! x, y locations of points + real(SiKi), allocatable :: WaveElevVisGrid(:,:,:) ! the actual surface data for full time series + integer(IntKi) :: tWidth = 5 ! Should calculate this, but not going to + integer(IntKi) :: LastWaveIndx + integer(IntKi) :: lastCount = -1 + end type VTKvis + type(VTKvis) :: vtk + + !------------------------------ + ! Primary derived types + type(SeaSt_InputType) :: u !< inputs to SS + type(SeaSt_InitInputType) :: InitInp !< initialization input + type(SeaSt_InitOutputType) :: InitOutData !< Initial output data + type(SeaSt_ParameterType), target :: p !< Parameters + type(SeaSt_OutputType) :: y !< Initial output (outputs are not calculated; only the output mesh is initialized) + type(SeaSt_MiscVarType) :: m !< Misc variables for optimization (not copied in glue code) + type(SeaSt_ContinuousStateType) :: x !< Initial continuous states + type(SeaSt_DiscreteStateType) :: xd !< Initial discrete states + type(SeaSt_ConstraintStateType) :: z !< Initial guess of the constraint states + type(SeaSt_OtherStateType) :: OtherState !< Initial other states + +contains + + +!> Set environment variables +subroutine SeaSt_C_PreInit(Gravity_C, WtrDens_C, WtrDpth_C, MSL2SWL_C, DebugLevel_C, OutVTKDir_C, WrVTK_in, WrVTK_inDT, ErrStat_C, ErrMsg_C) BIND (C, NAME='SeaSt_C_PreInit') +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_PreInit +!GCC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_PreInit +#endif + real(c_float), intent(in ) :: Gravity_C + real(c_float), intent(in ) :: WtrDens_C + real(c_float), intent(in ) :: WtrDpth_C + real(c_float), intent(in ) :: MSL2SWL_C + integer(c_int), intent(in ) :: DebugLevel_C + character(kind=c_char), intent(in ) :: OutVTKDir_C(IntfStrLen) !< Directory to put all vtk output + integer(c_int), intent(in ) :: WrVTK_in !< Write VTK outputs [0: none, 1: init only, 2: animation] + real(c_double), intent(in ) :: WrVTK_inDT !< Timestep between VTK writes + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + + integer :: ErrStat, ErrStat2 + character(ErrMsgLen) :: ErrMsg, ErrMsg2 + integer :: i,j,k + character(*), parameter :: RoutineName = 'SeaSt_C_PreInit' + + ! Initialize error handling + ErrStat = ErrID_None + ErrMsg = "" + + call NWTC_Init( ProgNameIn= SeaSt_ProgDesc%Name ) + call DispCopyrightLicense( SeaSt_ProgDesc%Name ) + call DispCompileRuntimeInfo( SeaSt_ProgDesc%Name ) + + ! Store the out root dir - do this before ShowPassedData call + vtk%outdir = TRANSFER( OutVTKDir_C, vtk%outdir ) + i = INDEX(vtk%outdir,C_NULL_CHAR) - 1 ! if this has a c null character at the end... + if ( i > 0 ) vtk%outdir = vtk%outdir(1:I) ! remove it + + ! interface debugging + DebugLevel = int(DebugLevel_C,IntKi) + + ! check valid debug level, show passed data if >0 + if (DebugLevel < 0_IntKi) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Interface debug level must be 0 or greater"//NewLine// & + " 0 - none"//NewLine// & + " 1 - some summary info and variables passed through interface (init only)"//NewLine// & + " 2 - above + all position info on all calls" + call ShowPassedData() + if (Failed()) return; + elseif (DebugLevel > 0_IntKi) THEN + call WrScr(" Interface debugging level "//trim(Num2Lstr(DebugLevel))//" requested.") + call ShowPassedData() + endif + + ! clear memory of anything we allocate locally + call ClearMem() ! ignoring any error handling from this + + ! store environment values + InitInp%Gravity = Gravity_C + InitInp%defWtrDens = WtrDens_C + InitInp%defWtrDpth = WtrDpth_C + InitInp%defMSL2SWL = MSL2SWL_C + + !---------------------- + ! store VTK output info + vtk%write = int(WrVTK_in, IntKi) + vtk%dt = real(WrVTK_inDT, DbKi) + + if (vtk%write < 0_IntKi .or. vtk%write > 2_IntKi) then + ErrStat2 = ErrID_Warn + ErrMSg2 = "WrVTK_in must be 0 (off), 1 (init), 2 (animation), but "//trim(Num2LStr(vtk%write))//" was passed. Turning off VTK surface export." + vtk%write = 0_IntKi + if (Failed()) return + endif + + if (vtk%write > 0_IntKi) then + ! Tell SeaState to generate the visualization using default grid + InitInp%SurfaceVis = .true. + InitInp%SurfaceVisNx = 0 ! use the WaveField grid resolution + InitInp%SurfaceVisNy = 0 ! use the WaveField grid resolution + endif + + + ! If we got this far, we are initialized + PreInitDone = .true. + + call Cleanup() + return +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) call Cleanup() + end function Failed + subroutine Cleanup() ! NOTE: we are ignoring any error reporting from here + call SetErrStat_F2C(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + end subroutine Cleanup + subroutine ShowPassedData() + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: SeaSt_C_PreInit") + call WrScr(" --------------------------------------------------------") + call WrScr(" Gravity_C -> "//trim(Num2LStr(Gravity_C))) + call WrScr(" WtrDens_C -> "//trim(Num2LStr(WtrDens_C))) + call WrScr(" WtrDpth_C -> "//trim(Num2LStr(WtrDpth_C))) + call WrScr(" MSL2SWL_C -> "//trim(Num2LStr(MSL2SWL_C))) + call WrScr(" DebugLevel_C -> "//trim(Num2LStr(DebugLevel_C))) + call WrScr(" OutVTKDir_C -> "//trim(vtk%outdir)) + call WrScr(" WrVTK_in -> "//trim(Num2LStr(WrVTK_in))) + call WrScr(" WrVTK_inDT -> "//trim(Num2LStr(WrVTK_inDT))) + call WrScr("-----------------------------------------------------------") + end subroutine ShowPassedData +end subroutine SeaSt_C_PreInit + + +!> Initialize the library (PreInit must be called first) +subroutine SeaSt_C_Init(InputFile_C, OutRootName_C, TimeInterval_C, TMax_C, WaveTimeShift_C, NumChannels_C, OutputChannelNames_C, OutputChannelUnits_C, ErrStat_C, ErrMsg_C) BIND (C, NAME='SeaSt_C_Init') #ifndef IMPLICIT_DLLEXPORT !DEC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_Init !GCC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_Init #endif - TYPE(C_PTR), INTENT(IN ) :: InputFile_C - TYPE(C_PTR), INTENT(IN ) :: OutRootName_C - REAL(C_FLOAT), INTENT(IN ) :: Gravity_C - REAL(C_FLOAT), INTENT(IN ) :: WtrDens_C - REAL(C_FLOAT), INTENT(IN ) :: WtrDpth_C - REAL(C_FLOAT), INTENT(IN ) :: MSL2SWL_C - INTEGER(C_INT), INTENT(IN ) :: NSteps_C - REAL(C_FLOAT), INTENT(IN ) :: TimeInterval_C - INTEGER(C_INT), INTENT(IN ) :: WaveElevSeriesFlag_C - INTEGER(C_INT), INTENT(IN ) :: WrWvKinMod_C - INTEGER(C_INT), INTENT( OUT) :: NumChannels_C - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: OutputChannelNames_C(ChanLen*MaxOutPts+1) - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: OutputChannelUnits_C(ChanLen*MaxOutPts+1) - INTEGER(C_INT), INTENT( OUT) :: ErrStat_C - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_C(ErrMsgLen_C) - - ! Local variables - CHARACTER(KIND=C_CHAR, len=IntfStrLen), POINTER :: InputFileString !< Input file as a single string with NULL chracter separating lines - CHARACTER(KIND=C_CHAR, len=IntfStrLen), POINTER :: OutputFileString !< Input file as a single string with NULL chracter separating lines - CHARACTER(IntfStrLen) :: InputFileName - CHARACTER(IntfStrLen) :: OutRootName - TYPE(SeaSt_InputType) :: u !< An initial guess for the input; input mesh must be defined - TYPE(SeaSt_ContinuousStateType) :: x !< Initial continuous states - TYPE(SeaSt_DiscreteStateType) :: xd !< Initial discrete states - TYPE(SeaSt_ConstraintStateType) :: z !< Initial guess of the constraint states - TYPE(SeaSt_OtherStateType) :: OtherState !< Initial other states - REAL(DbKi) :: Interval !< Coupling interval in seconds: the rate that - !! (1) SeaSt_UpdateStates() is called in loose coupling & - !! (2) SeaSt_UpdateDiscState() is called in tight coupling. - !! Input is the suggested time from the glue code; - !! Output is the actual coupling interval that will be used - !! by the glue code. - - INTEGER :: ErrStat !< aggregated error status - CHARACTER(ErrMsgLen) :: ErrMsg !< aggregated error message - INTEGER :: ErrStat2 !< temporary error status from a call - CHARACTER(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call - INTEGER :: i,j,k - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_C_Init' !< for error handling - - ! Initialize error handling - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Init( ProgNameIn=version%Name ) - CALL DispCopyrightLicense( version%Name ) - CALL DispCompileRuntimeInfo( version%Name ) - - ! interface debugging - ! DebugLevel = int(DebugLevel_in,IntKi) - - ! Input files - CALL C_F_POINTER(InputFile_C, InputFileString) ! Get a pointer to the input file string - InputFileName = FileNameFromCString(InputFileString, IntfStrLen) ! convert the input file name from c_char to fortran character - - CALL C_F_POINTER(OutRootName_C, OutputFileString) ! Get a pointer to the input file string - OutRootName = FileNameFromCString(OutputFileString, IntfStrLen) ! convert the input file name from c_char to fortran character - - ! if non-zero, show all passed data here. Then check valid values - IF (DebugLevel /= 0_IntKi) THEN - CALL WrScr(" Interface debugging level "//trim(Num2Lstr(DebugLevel))//" requested.") - CALL ShowPassedData() - ENDIF - ! check valid debug level - IF (DebugLevel < 0_IntKi) THEN - ErrStat2 = ErrID_Fatal - ErrMsg2 = "Interface debug level must be 0 or greater"//NewLine// & - " 0 - none"//NewLine// & - " 1 - some summary info and variables passed through interface"//NewLine// & - " 2 - above + all position/orientation info"//NewLine// & - " 3 - above + input files (if direct passed)"//NewLine// & - " 4 - above + meshes" - IF (Failed()) RETURN; - ENDIF - - ! For debugging the interface: - IF (DebugLevel > 0) THEN - CALL ShowPassedData() - ENDIF - - ! Set other inputs for calling SeaSt_Init - InitInp%InputFile = InputFileName - InitInp%UseInputFile = .TRUE. - InitInp%OutRootName = OutRootName - InitInp%Gravity = Gravity_C - InitInp%defWtrDens = WtrDens_C - InitInp%defWtrDpth = WtrDpth_C - InitInp%defMSL2SWL = MSL2SWL_C - InitInp%TMax = (NSteps_C - 1) * TimeInterval_C ! Using this to match the SeaState driver; could otherwise get TMax directly - InitInp%WaveFieldMod = WaveElevSeriesFlag_C - ! REAL(ReKi) :: PtfmLocationX = 0.0_ReKi !< Supplied by Driver: X coordinate of platform location in the wave field [m] - ! REAL(ReKi) :: PtfmLocationY = 0.0_ReKi !< Supplied by Driver: Y coordinate of platform location in the wave field [m] - InitInp%WrWvKinMod = WrWvKinMod_C - ! LOGICAL :: HasIce = .false. !< Supplied by Driver: Whether this simulation has ice loading (flag) [-] - ! LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] - ! LOGICAL :: SurfaceVis = .FALSE. !< Turn on grid surface visualization outputs [-] - ! INTEGER(IntKi) :: SurfaceVisNx = 0 !< Number of points in X direction to output for visualization grid. Use 0 or negative to set to SeaState resolution. [-] - ! INTEGER(IntKi) :: SurfaceVisNy = 0 !< Number of points in Y direction to output for visualization grid. Use 0 or negative to set to SeaState resolution. [-] - - CALL SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOutData, ErrStat2, ErrMsg2 ) - IF (Failed()) RETURN - - ! Number of channels - NumChannels_C = size(InitOutData%WriteOutputHdr) - - ! transfer the output channel names and units to c_char arrays for returning - k=1 - DO i=1,NumChannels_C - DO j=1,ChanLen ! max length of channel name. Same for units - OutputChannelNames_C(k)=InitOutData%WriteOutputHdr(i)(j:j) - OutputChannelUnits_C(k)=InitOutData%WriteOutputUnt(i)(j:j) - k=k+1 - ENDDO - ENDDO - - ! null terminate the string - OutputChannelNames_C(k) = C_NULL_CHAR - OutputChannelUnits_C(k) = C_NULL_CHAR - - CALL SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) - -CONTAINS - LOGICAL FUNCTION Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - IF (Failed) THEN - CALL Cleanup() - CALL SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) - ENDIF - END FUNCTION Failed - - SUBROUTINE Cleanup() ! NOTE: we are ignoring any error reporting from here - END SUBROUTINE Cleanup - - SUBROUTINE ShowPassedData() - ! CHARACTER(1) :: TmpFlag - ! integer :: i,j - CALL WrSCr("") - CALL WrScr("-----------------------------------------------------------") - CALL WrScr("Interface debugging: Variables passed in through interface") - CALL WrScr(" SeaSt_C_Init") - CALL WrScr(" --------------------------------------------------------") - CALL WrScr(" FileInfo") - CALL WrScr("-----------------------------------------------------------") - END SUBROUTINE ShowPassedData -END SUBROUTINE SeaSt_C_Init - -SUBROUTINE SeaSt_C_CalcOutput(Time_C, OutputChannelValues_C, ErrStat_C, ErrMsg_C) BIND (C, NAME='SeaSt_C_CalcOutput') -IMPLICIT NONE + character(kind=c_char), intent(in ) :: InputFile_C(IntfStrLen) + character(kind=c_char), intent(in ) :: OutRootName_C(IntfStrLen) + real(c_double), intent(in ) :: TimeInterval_C + real(c_double), intent(in ) :: TMax_c + real(c_double), intent(in ) :: WaveTimeShift_C + integer(c_int), intent( out) :: NumChannels_C + character(kind=c_char), intent( out) :: OutputChannelNames_C(ChanLen*MaxOutPts+1) + character(kind=c_char), intent( out) :: OutputChannelUnits_C(ChanLen*MaxOutPts+1) + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + + ! Local variables + character(IntfStrLen) :: OutRootName + real(DbKi) :: Interval !< DT for calling + integer :: ErrStat, ErrStat2 + character(ErrMsgLen) :: ErrMsg, ErrMsg2 + integer :: i,j,k + character(*), parameter :: RoutineName = 'SeaSt_C_Init' !< for error handling + + if (.not. PreInitDone) then + ErrStat = ErrID_Fatal + ErrMSg = "SeaSt_C_PreInit must be called before SeaSt_C_Init" + call Cleanup() + endif + + ! Initialize error handling + ErrStat = ErrID_None + ErrMsg = "" + ErrStat_C = ErrID_None + ErrMsg_C = c_null_char + + ! Initialize vars in case of early return + NumChannels_C = 0_IntKi + OutputChannelNames_C = c_null_char + OutputChannelUnits_C = c_null_char + + call NWTC_Init( ProgNameIn= SeaSt_ProgDesc%Name ) + call DispCopyrightLicense( SeaSt_ProgDesc%Name ) + call DispCompileRuntimeInfo( SeaSt_ProgDesc%Name ) + + + ! Input file + InitInp%InputFile = TRANSFER( InputFile_C, InitInp%InputFile ) + i = INDEX(InitInp%InputFile,C_NULL_CHAR) - 1 ! if this has a c null character at the end... + if ( i > 0 ) InitInp%InputFile = InitInp%InputFile(1:I) ! remove it + + ! OutRootName - this should be relative to current location + InitInp%OutRootName = TRANSFER( OutRootName_C, InitInp%OutRootName ) + i = INDEX(InitInp%OutRootName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... + if ( i > 0 ) InitInp%OutRootName = InitInp%OutRootName(1:I) ! remove it + vtk%OutRootName = InitInp%OutRootName ! store for vtk (will modify below) + + ! Debugging interface + if (DebugLevel > 0_IntKi) call ShowPassedData() + + ! Set other inputs for calling SeaSt_Init + InitInp%UseInputFile = .TRUE. ! don't allow passing of full file contents as a string + InitInp%TMax = real(TMax_c, DbKi) + InitInp%WaveFieldMod = 0_IntKi + InitInp%WrWvKinMod = 0_IntKi + InitInp%Linearize = .false. + InitInp%hasIce = .false. + InitInp%WaveFieldMod = 0 ! does not currently support moving platform. Not really necessary though since can directly get data in absolute coords + InitInp%PtfmLocationX = 0.0_ReKi + InitInp%PtfmLocationY = 0.0_ReKi + InitInp%WaveTimeShift = real(WaveTimeShift_C,DbKi) + + call SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOutData, ErrStat2, ErrMsg2 ) + if (Failed()) return + + ! Number of channels + NumChannels_C = size(InitOutData%WriteOutputHdr) + + ! transfer the output channel names and units to c_char arrays for returning + k=1 + do i=1,NumChannels_C + do j=1,ChanLen ! max length of channel name. Same for units + OutputChannelNames_C(k)=InitOutData%WriteOutputHdr(i)(j:j) + OutputChannelUnits_C(k)=InitOutData%WriteOutputUnt(i)(j:j) + k=k+1 + enddo + enddo + + ! null terminate the string + OutputChannelNames_C(k) = C_NULL_CHAR + OutputChannelUnits_C(k) = C_NULL_CHAR + + if (vtk%write > 0_IntKi) then + call VTKsetup() + endif + + + + call Cleanup() + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) call Cleanup() + end function Failed + subroutine Cleanup() ! NOTE: we are ignoring any error reporting from here + call SetErrStat_F2C(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + end subroutine Cleanup + subroutine ShowPassedData() + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: SeaSt_C_Init") + call WrScr(" --------------------------------------------------------") + call WrScr(" InputFile_C -> "//trim(InitInp%InputFile)) + call WrScr(" OutRootName_C -> "//trim(InitInp%OutRootName)) + call WrScr(" TMax_C -> "//trim(Num2LStr(TMax_C))) + call WrScr(" TimeInterval_C -> "//trim(Num2LStr(TimeInterval_C))) + call WrScr(" WaveTimeShift_C -> "//trim(Num2LStr(WaveTimeShift_C))) + call WrScr("-----------------------------------------------------------") + end subroutine ShowPassedData + + subroutine VTKsetup() + ! check dt (can't check against Interval since that is never set, so just make sure it is positive) + if (vtk%dt <= 0.0) vtk%dt = 0.25 + ! move data + if (allocated(InitOutData%WaveElevVisGrid)) then + vtk%NWaveElevPts(1) = size(InitOutData%WaveElevVisX) + vtk%NWaveElevPts(2) = size(InitOutData%WaveElevVisY) + call move_alloc(InitOutData%WaveElevVisX, vtk%WaveElevVisX) + call move_alloc(InitOutData%WaveElevVisY, vtk%WaveElevVisY) + call move_alloc(InitOutData%WaveElevVisGrid,vtk%WaveElevVisGrid ) + else + vtk%NWaveElevPts = 0 + vtk%write = 0 ! FIXME throw warning if we do this + endif + ! get the name of the output directory for vtk files (in a subdirectory called "vtk" of the output directory), and + ! create the VTK directory if it does not exist + call MKDIR( trim(vtk%outdir) ) + vtk%OutRootName = trim(vtk%outdir) // PathSep //trim( vtk%OutRootName ) + call WrVTK_WaveElevVisGrid (0.0_DbKi, vtk, ErrStat2, ErrMsg2) + if (Failed()) return + end subroutine VTKsetup +end subroutine SeaSt_C_Init + +subroutine SeaSt_C_CalcOutput(Time_C, OutputChannelValues_C, ErrStat_C, ErrMsg_C) BIND (C, NAME='SeaSt_C_CalcOutput') #ifndef IMPLICIT_DLLEXPORT !DEC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_CalcOutput !GCC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_CalcOutput #endif - REAL(C_DOUBLE), INTENT(IN ) :: Time_C - REAL(C_FLOAT), INTENT( OUT) :: OutputChannelValues_C(p%NumOuts) - INTEGER(C_INT), INTENT( OUT) :: ErrStat_C - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_C(ErrMsgLen_C) - - ! Local variables - TYPE(SeaSt_InputType) :: u !< An initial guess for the input; input mesh must be defined - TYPE(SeaSt_ContinuousStateType) :: x !< Initial continuous states - TYPE(SeaSt_DiscreteStateType) :: xd !< Initial discrete states - TYPE(SeaSt_ConstraintStateType) :: z !< Initial guess of the constraint states - TYPE(SeaSt_OtherStateType) :: OtherState !< Initial other states - - REAL(DbKi) :: Time - INTEGER :: ErrStat !< aggregated error status - CHARACTER(ErrMsgLen) :: ErrMsg !< aggregated error message - INTEGER :: ErrStat2 !< temporary error status from a call - CHARACTER(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_C_End' !< for error handling - - ! Initialize error handling - ErrStat = ErrID_None - ErrMsg = "" - - ! Convert the inputs from C to Fortran - Time = REAL(Time_C,DbKi) - - CALL SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) - IF (Failed()) RETURN - - ! Get the output channel info out of y - OutputChannelValues_C = REAL(y%WriteOutput, C_FLOAT) - - CALL SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) - -CONTAINS - LOGICAL FUNCTION Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - IF (Failed) CALL SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) - END FUNCTION Failed -END SUBROUTINE - -SUBROUTINE SeaSt_C_End(ErrStat_C,ErrMsg_C) BIND (C, NAME='SeaSt_C_End') -IMPLICIT NONE + real(c_double), intent(in ) :: Time_C + real(c_float), intent( out) :: OutputChannelValues_C(p%NumOuts) + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + + ! Local variables + type(SeaSt_InputType) :: u !< An initial guess for the input; input mesh must be defined + type(SeaSt_ContinuousStateType) :: x !< Initial continuous states + type(SeaSt_DiscreteStateType) :: xd !< Initial discrete states + type(SeaSt_ConstraintStateType) :: z !< Initial guess of the constraint states + type(SeaSt_OtherStateType) :: OtherState !< Initial other states + + real(DbKi) :: Time + integer :: ErrStat, ErrStat2 + character(ErrMsgLen) :: ErrMsg, ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_C_CalcOutput' !< for error handling + + ! Initialize error handling + ErrStat = ErrID_None + ErrMsg = "" + + ! Debugging + if (DebugLevel > 1) call ShowPassedData() + + ! Convert the inputs from C to Fortran + Time = REAL(Time_C,DbKi) + + call SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) + if (Failed()) return + + ! Get the output channel info out of y + OutputChannelValues_C = REAL(y%WriteOutput, C_FLOAT) + + if (vtk%write > 1_IntKi) then + call WrVTK_WaveElevVisGrid (Time, vtk, ErrStat2, ErrMsg2) + if (Failed()) return + endif + + call Cleanup() + + ! Debugging + if (DebugLevel > 1) call ShowReturnData() + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) call Cleanup() + end function Failed + subroutine Cleanup() ! NOTE: we are ignoring any error reporting from here + CALL SetErrStat_F2C(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + end subroutine Cleanup + subroutine ShowPassedData() + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: SeaSt_C_CalcOutput") + call WrScr(" --------------------------------------------------------") + call WrScr(" Time_C -> "//trim(Num2LStr(Time_C))) + end subroutine ShowPassedData + subroutine ShowReturnData() + call WrScr(" OutputChannelValues_C <-") + call WrMatrix(OutputChannelValues_C,CU,'g15.6') + call WrScr("-----------------------------------------------------------") + end subroutine ShowReturnData +end subroutine + +subroutine SeaSt_C_End(ErrStat_C,ErrMsg_C) BIND (C, NAME='SeaSt_C_End') #ifndef IMPLICIT_DLLEXPORT !DEC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_End !GCC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_End #endif - INTEGER(C_INT), INTENT( OUT) :: ErrStat_C - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_C(ErrMsgLen_C) + integer(C_INT), intent( out) :: ErrStat_C + character(kind=C_CHAR), intent( out) :: ErrMsg_C(ErrMsgLen_C) + + integer :: ErrStat !< aggregated error status + character(ErrMsgLen) :: ErrMsg !< aggregated error message + integer :: ErrStat2 !< temporary error status from a call + character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call + character(*), parameter :: RoutineName = 'SeaSt_C_End' !< for error handling + ErrStat = ErrID_None + ErrMsg = "" + call SeaSt_End(u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call ClearMem() ! ignoring any error handling from this + call SetErrStat_F2C( ErrStat, ErrMsg, ErrStat_C, ErrMsg_C ) +end subroutine + + +!> return the pointer to the WaveField data +subroutine SeaSt_C_GetWaveFieldPointer(WaveFieldPointer_C,ErrStat_C,ErrMsg_C) BIND (C, NAME='SeaSt_C_GetWaveFieldPointer') +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_GetWaveFieldPointer +!GCC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_GetWaveFieldPointer +#endif + type(c_ptr), intent( out) :: WaveFieldPointer_C + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + integer :: ErrStat + character(ErrMsgLen) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_C_GetWaveFieldPointer' + logical :: valid + ErrStat = ErrID_None + ErrMSg = "" + WaveFieldPointer_C = C_NULL_PTR + call CheckWaveFieldPtr(RoutineName, valid, ErrStat, ErrMsg) + if (valid) WaveFieldPointer_C = C_LOC(p%WaveField) + call SetErrStat_F2C( ErrStat, ErrMsg, ErrStat_C, ErrMsg_C ) + if (DebugLevel > 1) call ShowPassedData() + return +contains + subroutine ShowPassedData() + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: SeaSt_C_GetWaveFieldPointer returns") + call WrScr(" --------------------------------------------------------") + call WrScr(" WaveFieldPointer_C <- "//trim(Num2LStr(loc(p%WaveField)))) + call WrScr("-----------------------------------------------------------") + end subroutine ShowPassedData +end subroutine + + +!> set the pointer to the WaveField data +subroutine SeaSt_C_SetWaveFieldPointer(WaveFieldPointer_C,ErrStat_C,ErrMsg_C) BIND (C, NAME='SeaSt_C_SetWaveFieldPointer') +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_SetWaveFieldPointer +!GCC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_SetWaveFieldPointer +#endif + type(c_ptr), intent(in ) :: WaveFieldPointer_C + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + integer :: ErrStat + character(ErrMsgLen) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_C_SetWaveFieldPointer' + logical :: valid + ErrStat = ErrID_None + ErrMSg = "" + call C_F_POINTER(WaveFieldPointer_C, p%WaveField) + call CheckWaveFieldPtr(RoutineName, valid, ErrStat, ErrMsg) + call SetErrStat_F2C( ErrStat, ErrMsg, ErrStat_C, ErrMsg_C ) + if (DebugLevel > 1) call ShowPassedData() + return +contains + subroutine ShowPassedData() + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: SeaSt_C_SetWaveFieldPointer inputs") + call WrScr(" --------------------------------------------------------") + call WrScr(" WaveFieldPointer_C -> "//trim(Num2LStr(loc(p%WaveField)))) + call WrScr("-----------------------------------------------------------") + end subroutine ShowPassedData +end subroutine + + +!> Get the fluid velocity, acceleration, and node-in-water status at time+position coordinate +!! NOTE: if wave stretching is turned off, the SWL is used as the cutoff for the nodeInWater and for Vel / Acc values +subroutine SeaSt_C_GetFluidVelAcc(Time_C, Pos_C, Vel_C, Acc_C, NodeInWater_C, ErrStat_C,ErrMsg_C) BIND (C, NAME='SeaSt_C_GetFluidVelAcc') +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_GetFluidVelAcc +!GCC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_GetFluidVelAcc +#endif + real(c_double), intent(in ) :: Time_C + real(c_float), intent(in ) :: Pos_c(3) + real(c_float), intent( out) :: Vel_c(3) + real(c_float), intent( out) :: Acc_c(3) + integer(c_int), intent( out) :: NodeInWater_C + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + real(DbKi) :: Time + real(ReKi) :: Pos(3) + real(SiKi) :: Vel(3) + real(SiKi) :: Acc(3) + logical :: forceNodeInWater +!FIXME:dev-tc uncomment next line +! logical :: fetchDynCurrent + integer(IntKi) :: nodeInWater + integer :: ErrStat, ErrStat2 + character(ErrMsgLen) :: ErrMsg, ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_C_GetFluidVelAcc' + logical :: valid + + ! Initialize + ErrStat = ErrID_None + ErrMsg = "" + Vel_c = 0.0_c_float + Acc_c = 0.0_c_float + + forceNodeInWater = .false. + + if (DebugLevel > 1) call ShowPassedData() + + ! convert position and time to fortran types + Time = real(Time_C, DbKi) + Pos = real(Pos_C, ReKi) + + ! verify there is actually wavefield data + call CheckWaveFieldPtr(RoutineName, valid, ErrStat, ErrMsg) + if (.not. valid) then + call SetErrStat_F2C(ErrStat, ErrMsg, ErrStat_C, ErrMsg_C) + return + endif + + ! get wave field velocity and acceleration (current is included in this) + ! Notes: + ! - if node is out of water, velocity and acceleration are zero + ! - if position is outside the wave field boundary, it will simply return boundary edge value + ! - time must be positive or a fatal error occurs + call WaveField_GetNodeWaveVelAcc( p%WaveField, m%WaveField_m, Time, pos, forceNodeInWater, nodeInWater, Vel, Acc, ErrStat, ErrMsg ) +!FIXME:dev-tc use next line instead of above +! call WaveField_GetNodeWaveVelAcc( p%WaveField, m%WaveField_m, Time, pos, forceNodeInWater, fetchDynCurrent, nodeInWater, Vel, Acc, ErrStat, ErrMsg ) + + ! Store resulting velocity and acceleration as C type + Vel_c = real(Vel,c_float) + Acc_c = real(Acc,c_float) + + ! Density value and node status to return + if (nodeInWater == 1_IntKi) then + NodeInWater_C = 1_c_int + else + NodeInWater_C = 0_c_int + endif + + call SetErrStat_F2C( ErrStat, ErrMsg, ErrStat_C, ErrMsg_C ) ! convert error from fortran to C for return + if (DebugLevel > 1) call ShowReturnData() + return +contains + subroutine ShowPassedData() + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: SeaSt_C_GetFluidVelAccDens") + call WrScr(" --------------------------------------------------------") + call WrScr(" Time_C -> "//trim(Num2LStr(Time_C))) + call WrScr(" Pos_C -> ("//trim(Num2LStr(Pos_C(1)))//","//trim(Num2LStr(Pos_C(2)))//","//trim(Num2LStr(Pos_C(3)))//")") + end subroutine ShowPassedData + subroutine ShowReturnData() + call WrScr(" Vel_C <- ("//trim(Num2LStr(Vel_C(1)))//","//trim(Num2LStr(Vel_C(2)))//","//trim(Num2LStr(Vel_C(3)))//")") + call WrScr(" Acc_C <- ("//trim(Num2LStr(Acc_C(1)))//","//trim(Num2LStr(Acc_C(2)))//","//trim(Num2LStr(Acc_C(3)))//")") + call WrScr(" NodeInWater_C <- "//trim(Num2LStr(NodeInWater_C))) + call WrScr("-----------------------------------------------------------") + end subroutine ShowReturnData +end subroutine SeaSt_C_GetFluidVelAcc + + + +!> return the surface elevation and normal vector at a point. +subroutine SeaSt_C_GetSurfElev(Time_C, Pos_C, Elev_C, ErrStat_C,ErrMsg_C) BIND (C, NAME='SeaSt_C_GetSurfElev') +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_GetSurfElev +!GCC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_GetSurfElev +#endif + real(c_double), intent(in ) :: Time_C + real(c_float), intent(in ) :: Pos_c(2) + real(c_float), intent( out) :: Elev_C + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + + real(DbKi) :: Time + real(ReKi) :: Pos(2) + real(SiKi) :: Elev + integer :: ErrStat + character(ErrMsgLen) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_C_GetSurfElev' + logical :: valid + + if (DebugLevel > 1) call ShowPassedData() + + ! convert position and time to fortran types + Time = real(Time_C, DbKi) + Pos = real(Pos_C(1:2), ReKi) + + ! verify there is actually wavefield data + call CheckWaveFieldPtr(RoutineName, valid, ErrStat, ErrMsg) + if (.not. valid) then + call Cleanup() + return + endif + + ! get wave elevation (total combined first and second order) + ! Notes: + ! - if position is outside the wave field boundary, it will simply return boundary edge value + ! - time must be positive or a fatal error occurs + Elev = WaveField_GetNodeTotalWaveElev( p%WaveField, m%WaveField_m, Time, pos, ErrStat, ErrMsg ) + + ! Store resulting elevation as C type + Elev_C = real(Elev,c_float) + + if (DebugLevel > 1) call ShowReturnData() + call Cleanup() + return +contains + subroutine Cleanup() ! NOTE: we are ignoring any error reporting from here + CALL SetErrStat_F2C(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + end subroutine Cleanup + subroutine ShowPassedData() + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: SeaSt_C_GetSurfElev") + call WrScr(" --------------------------------------------------------") + call WrScr(" Time_C -> "//trim(Num2LStr(Time_C))) + call WrScr(" Pos_C -> ("//trim(Num2LStr(Pos_C(1)))//","//trim(Num2LStr(Pos_C(2)))//")") + end subroutine ShowPassedData + subroutine ShowReturnData() + call WrScr(" Elev_C <- "//trim(Num2LStr(Elev_C))) + call WrScr("-----------------------------------------------------------") + end subroutine ShowReturnData +end subroutine SeaSt_C_GetSurfElev + + + +!> return the surface normal vector at a point. +subroutine SeaSt_C_GetSurfNorm(Time_C, Pos_C, NormVec_C, ErrStat_C,ErrMsg_C) BIND (C, NAME='SeaSt_C_GetSurfNorm') +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_GetSurfNorm +!GCC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_GetSurfNorm +#endif + real(c_double), intent(in ) :: Time_C + real(c_float), intent(in ) :: Pos_c(2) + real(c_float), intent( out) :: NormVec_C(3) + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + + real(DbKi) :: Time + real(ReKi) :: Pos(2) + real(ReKi) :: NormVec(3) + integer :: ErrStat + character(ErrMsgLen) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_C_GetSurfNorm' + logical :: valid + + if (DebugLevel > 1) call ShowPassedData() + + ! verify there is actually wavefield data + call CheckWaveFieldPtr(RoutineName, valid, ErrStat, ErrMsg) + if (.not. valid) then + call Cleanup() + return + endif + + ! convert position and time to fortran types + Time = real(Time_C, DbKi) + Pos = real(Pos_C(1:2), ReKi) + + ! get the normal vector at the point (set to vertical if outside region) + call WaveField_GetNodeWaveNormal( p%WaveField, m%WaveField_m, Time, pos, NormVec, ErrStat, ErrMsg ) + + ! Store resulting normal vector as C type + NormVec_C = real(NormVec,c_float) + + if (DebugLevel > 1) call ShowReturnData() + call Cleanup() + return +contains + subroutine Cleanup() ! NOTE: we are ignoring any error reporting from here + CALL SetErrStat_F2C(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + end subroutine Cleanup + subroutine ShowPassedData() + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: SeaSt_C_GetSurfNorm") + call WrScr(" --------------------------------------------------------") + call WrScr(" Time_C -> "//trim(Num2LStr(Time_C))) + call WrScr(" Pos_C -> ("//trim(Num2LStr(Pos_C(1)))//","//trim(Num2LStr(Pos_C(2)))//")") + end subroutine ShowPassedData + subroutine ShowReturnData() + call WrScr(" NormVec_C <- ("//trim(Num2LStr(NormVec_C(1)))//","//trim(Num2LStr(NormVec_C(2)))//","//trim(Num2LStr(NormVec_C(3)))//")") + call WrScr("-----------------------------------------------------------") + end subroutine ShowReturnData +end subroutine SeaSt_C_GetSurfNorm + + +!> return the min and max levels across entire wavefield. This only needs to be called once at the +!! start if desired +subroutine SeaSt_C_GetElevMinMaxEstimate(Min_C, Max_C, ErrStat_C,ErrMsg_C) BIND (C, NAME='SeaSt_C_GetElevMinMaxEstimate') +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_GetElevMinMaxEstimate +!GCC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_GetElevMinMaxEstimate +#endif + real(c_float), intent( out) :: Min_C + real(c_float), intent( out) :: Max_C + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + + real(SiKi) :: MinElev + real(SiKi) :: MaxElev + integer :: ErrStat + character(ErrMsgLen) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_C_GetElevMinMaxEstimate' + logical :: valid + + if (DebugLevel > 1) call ShowPassedData() + + ! verify there is actually wavefield data + call CheckWaveFieldPtr(RoutineName, valid, ErrStat, ErrMsg) + if (.not. valid) then + call Cleanup() + return + endif + + ! Measure directly from the data set (this is not ideal and will break if the layout changes) + call WaveField_GetMinMaxWaveElevEstimate( p%WaveField, MinElev, MaxElev, ErrStat, ErrMsg) + Min_C = real(MinElev, c_float) + Max_C = real(MaxElev, c_float) + + if (DebugLevel > 1) call ShowReturnData() + call Cleanup() + return +contains + subroutine Cleanup() ! NOTE: we are ignoring any error reporting from here + CALL SetErrStat_F2C(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + end subroutine Cleanup + subroutine ShowPassedData() + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: SeaSt_C_GetElevMinMaxEstimate") + call WrScr(" --------------------------------------------------------") + end subroutine ShowPassedData + subroutine ShowReturnData() + call WrScr(" Min_C <- "//trim(Num2LStr(Min_C))) + call WrScr(" Max_C <- "//trim(Num2LStr(Max_C))) + call WrScr("-----------------------------------------------------------") + end subroutine ShowReturnData +end subroutine SeaSt_C_GetElevMinMaxEstimate + + +!---------------------------------------------------------------------------------------------------------------------------------- +! Routines to return environment vars +!---------------------------------------------------------------------------------------------------------------------------------- +!> retrieve the water density +subroutine SeaSt_C_GetDens(Dens_C, ErrStat_C, ErrMsg_C) BIND (C, NAME='SeaSt_C_GetDens') +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_GetDens +!GCC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_GetDens +#endif + real(c_float), intent( out) :: Dens_C + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + integer :: ErrStat + character(ErrMsgLen) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_C_GetDens' + logical :: valid + + ! verify there is actually wavefield data + call CheckWaveFieldPtr(RoutineName, valid, ErrStat, ErrMsg) + if (.not. valid) then + call SetErrStat_F2C(ErrStat, ErrMsg, ErrStat_C, ErrMsg_C) + Dens_C = 0.0_c_float + return + endif + + Dens_C = real(p%WaveField%WtrDens, c_float) + if (DebugLevel > 1) call ShowReturnData() +contains + subroutine ShowReturnData() + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: SeaSt_C_GetDens returns") + call WrScr(" --------------------------------------------------------") + call WrScr(" Dens_C <- "//trim(Num2LStr(Dens_C))) + call WrScr(" --------------------------------------------------------") + end subroutine ShowReturnData +end subroutine + + +!> retrieve the water depth +subroutine SeaSt_C_GetDpth(Dpth_C, ErrStat_C, ErrMsg_C) BIND (C, NAME='SeaSt_C_GetDpth') +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_GetDpth +!GCC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_GetDpth +#endif + real(c_float), intent( out) :: Dpth_C + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + integer :: ErrStat + character(ErrMsgLen) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_C_GetDpth' + logical :: valid + + ! verify there is actually wavefield data + call CheckWaveFieldPtr(RoutineName, valid, ErrStat, ErrMsg) + if (.not. valid) then + call SetErrStat_F2C(ErrStat, ErrMsg, ErrStat_C, ErrMsg_C) + Dpth_C = 0.0_c_float + return + endif + + Dpth_C = real(p%WaveField%WtrDpth, c_float) + if (DebugLevel > 1) call ShowReturnData() +contains + subroutine ShowReturnData() + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: SeaSt_C_GetDpth returns") + call WrScr(" --------------------------------------------------------") + call WrScr(" Dpth_C <- "//trim(Num2LStr(Dpth_C))) + call WrScr(" --------------------------------------------------------") + end subroutine ShowReturnData +end subroutine + + +!> retrieve MSL to SWL distance +subroutine SeaSt_C_GetMSL2SWL(MSL2SWL_C, ErrStat_C, ErrMsg_C) BIND (C, NAME='SeaSt_C_GetMSL2SWL') +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_GetMSL2SWL +!GCC$ ATTRIBUTES DLLEXPORT :: SeaSt_C_GetMSL2SWL +#endif + real(c_float), intent( out) :: MSL2SWL_C + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + integer :: ErrStat + character(ErrMsgLen) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_C_GetMSL2SWL' + logical :: valid + + ! verify there is actually wavefield data + call CheckWaveFieldPtr(RoutineName, valid, ErrStat, ErrMsg) + if (.not. valid) then + call SetErrStat_F2C(ErrStat, ErrMsg, ErrStat_C, ErrMsg_C) + MSL2SWL_C = 0.0_c_float + return + endif + + MSL2SWL_C = real(p%WaveField%MSL2SWL, c_float) + if (DebugLevel > 1) call ShowReturnData() +contains + subroutine ShowReturnData() + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: SeaSt_C_GetMSL2SWL returns") + call WrScr(" --------------------------------------------------------") + call WrScr(" MSL2SWL_C <- "//trim(Num2LStr(MSL2SWL_C))) + call WrScr(" --------------------------------------------------------") + end subroutine ShowReturnData +end subroutine + + +!> routine to check if the WaveField pointer is valid. ErrStat==ErrID_None is a valid pointer +subroutine CheckWaveFieldPtr(callingRoutine,valid,ErrStat,ErrMsg) + character(*), intent(in ) :: callingRoutine + logical, intent( out) :: valid + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen), intent( out) :: ErrMsg + ErrStat = ErrID_None + ErrMsg = "" + valid = .true. + if (associated(p%WaveField)) then + ! basic sanity check + if (.not. allocated(p%WaveField%WaveTime)) then + ErrStat = ErrID_Fatal + ErrMsg = trim(callingRoutine)//":: Invalid pointer passed in, or WaveField not initialized" + valid = .false. + endif + else + ErrStat = ErrID_Fatal + ErrMsg = trim(callingRoutine)//":: Invalid pointer passed in, or WaveField not initialized" + valid = .false. + endif +end subroutine + + +!FIXME: the following visualization writer should be merged into the library vtk.f90 +! this is a modified duplicate of the routine from FAST_Subs by the same name. +!FIXME: this routine currently only grabs the closest timestep and does not do any interpolation +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine writes the wave elevation data for a given time step +subroutine WrVTK_WaveElevVisGrid(t_global, vtk, ErrStat, ErrMsg) + real(DbKi), intent(in ) :: t_global !< Current global time + type(VTKvis), intent(inout) :: vtk + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen), intent( out) :: ErrMsg + integer(IntKi) :: Un ! fortran unit number + integer(IntKi) :: n, iy, ix ! loop counters + real(SiKi) :: t + integer(IntKi) :: count ! which file is this? + character(1024) :: FileName + integer(IntKi) :: NumberOfPoints + integer(IntKi), parameter :: NumberOfLines = 0 + integer(IntKi) :: NumberOfPolys + character(1024) :: Tstr + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*),parameter :: RoutineName = 'WrVTK_WaveElevVisGrid' + + ! Initialize error handling + ErrStat = ErrID_None + ErrMsg = "" + + NumberOfPoints = vtk%NWaveElevPts(1) * vtk%NWaveElevPts(2) + ! I'm going to make triangles for now. we should probably just make this a structured file at some point + NumberOfPolys = ( vtk%NWaveElevPts(1) - 1 ) * & + ( vtk%NWaveElevPts(2) - 1 ) * 2 + + count = nint(t_global / vtk%dt) + if (count == vtk%lastCount) return ! already wrote this one + vtk%lastCount = count ! store the current number to make sure we don't write it twice + + !................................................................. + ! write the data that potentially changes each time step: + !................................................................. + ! construct the string for the zero-padded VTK write-out step + write(Tstr, '(i' // trim(Num2LStr(vtk%tWidth)) //'.'// trim(Num2LStr(vtk%tWidth)) // ')') count + + ! PolyData (.vtp) - Serial vtkPolyData (unstructured) file + FileName = TRIM(vtk%OutRootName)//'.WaveSurface.'//TRIM(Tstr)//'.vtp' - ! Local variables - TYPE(SeaSt_InputType) :: u !< An initial guess for the input; input mesh must be defined - TYPE(SeaSt_ContinuousStateType) :: x !< Initial continuous states - TYPE(SeaSt_DiscreteStateType) :: xd !< Initial discrete states - TYPE(SeaSt_ConstraintStateType) :: z !< Initial guess of the constraint states - TYPE(SeaSt_OtherStateType) :: OtherState !< Initial other states + call WrVTK_header( FileName, NumberOfPoints, NumberOfLines, NumberOfPolys, Un, ErrStat, ErrMsg ) + if (ErrStat >= AbortErrLev) return - INTEGER :: ErrStat !< aggregated error status - CHARACTER(ErrMsgLen) :: ErrMsg !< aggregated error message - INTEGER :: ErrStat2 !< temporary error status from a call - CHARACTER(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_C_End' !< for error handling +! points (nodes, augmented with NumSegments): + write(Un,'(A)') ' ' + write(Un,'(A)') ' ' - ! Initialize error handling - ErrStat = ErrID_None - ErrMsg = "" - CALL SeaSt_End(u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2) + ! I'm not going to interpolate in time; I'm just going to get the index of the closest wave time value + t = REAL(t_global,SiKi) + call GetWaveElevIndx( t, p%WaveField%WaveTime, vtk%LastWaveIndx ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SetErr( ErrStat, ErrMsg, ErrStat_C, ErrMsg_C ) + do ix=1,vtk%NWaveElevPts(1) + do iy=1,vtk%NWaveElevPts(2) + write(Un,VTK_AryFmt) vtk%WaveElevVisX(ix), vtk%WaveElevVisY(iy), vtk%WaveElevVisGrid(vtk%LastWaveIndx,ix,iy) + end do + end do -END SUBROUTINE + write(Un,'(A)') ' ' + write(Un,'(A)') ' ' + write(Un,'(A)') ' ' + write(Un,'(A)') ' ' -! SUBROUTINE get_wave_height(position) + do ix=1,vtk%NWaveElevPts(1)-1 + do iy=1,vtk%NWaveElevPts(2)-1 + n = vtk%NWaveElevPts(2)*(ix-1)+iy - 1 ! points start at 0 + write(Un,'(3(i7))') n, n+1, n+vtk%NWaveElevPts(2) + write(Un,'(3(i7))') n+1, n+1+vtk%NWaveElevPts(2), n+vtk%NWaveElevPts(2) + end do + end do + write(Un,'(A)') ' ' + write(Un,'(A)') ' ' + do n=1,NumberOfPolys + WRITE(Un,'(i7)') 3*n + end do + write(Un,'(A)') ' ' + write(Un,'(A)') ' ' + call WrVTK_footer( Un ) +contains + !---------------------------------------------------------------------------------------------------------------------------------- + !> This function returns the index, Ind, of the XAry closest to XValIn, where XAry is assumed to be periodic. It starts + !! searching at the value of Ind from a previous step. + subroutine GetWaveElevIndx( XValIn, XAry, Ind ) + integer, intent(inout) :: Ind ! Initial and final index into the arrays. + real(SiKi), intent(in) :: XAry (:) !< Array of X values to be interpolated. + real(SiKi), intent(in) :: XValIn !< X value to be found + integer :: AryLen ! Length of the arrays. + real(SiKi) :: XVal !< X to be found (wrapped/periodic) + AryLen = size(XAry) -! SUBROUTINE get_wave_field_pointer() -! pass back the internal pointer to the wave field to the calling code -! END SUBROUTINE + ! Wrap XValIn into the range XAry(1) to XAry(AryLen) + XVal = MOD(XValIn, XAry(AryLen)) -! SUBROUTINE set_flow_field_pointer() + ! Let's check the limits first. + if ( XVal <= XAry(1) ) then + Ind = 1 + return + else if ( XVal >= XAry(AryLen) ) then + Ind = AryLen + return + else + ! Set the Ind to the first index if we are at the beginning of XAry + if ( XVal <= XAry(2) ) then + Ind = 1 + end if + end if -! END SUBROUTINE + ! Let's interpolate! + Ind = MAX( MIN( Ind, AryLen-1 ), 1 ) + do + if ( XVal < XAry(Ind) ) then + Ind = Ind - 1 + else if ( XVal >= XAry(Ind+1) ) then + Ind = Ind + 1 + else + ! XAry(Ind) <= XVal < XAry(Ind+1) + ! this would make it the "closest" node, but I'm not going to worry about that for visualization purposes + !if ( XVal > (XAry(Ind+1) + XAry(Ind))/2.0_SiKi ) Ind = Ind + 1 + return + end if + end do + return + end subroutine GetWaveElevIndx +end subroutine WrVTK_WaveElevVisGrid +!> clear any memory that the _End routine would not clear. Note we are ignoring any errors +subroutine ClearMem() + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + if (allocated(vtk%WaveElevVisX )) deallocate(vtk%WaveElevVisX ) + if (allocated(vtk%WaveElevVisY )) deallocate(vtk%WaveElevVisY ) + if (allocated(vtk%WaveElevVisGrid)) deallocate(vtk%WaveElevVisGrid) + call SeaSt_DestroyInitInput( InitInp, ErrStat2, ErrMsg2) + call SeaSt_DestroyInitOutput(InitOutData, ErrStat2, ErrMsg2) +end subroutine ClearMem end module SeaState_C_Binding diff --git a/modules/seastate/src/SeaState_DriverCode.f90 b/modules/seastate/src/SeaState_DriverCode.f90 index 53e33165f3..aec84e8ba3 100644 --- a/modules/seastate/src/SeaState_DriverCode.f90 +++ b/modules/seastate/src/SeaState_DriverCode.f90 @@ -161,6 +161,7 @@ program SeaStateDriver InitInData%OutRootName = drvrInitInp%OutRootName InitInData%TMax = (drvrInitInp%NSteps-1) * drvrInitInp%TimeInterval ! Starting time is always t = 0.0 InitInData%HasIce = .false. + InitInData%WaveTimeShift = 0.0_DbKi ! for phase shifting wave field in time (positive value only) ! Get the current time call date_and_time ( Values=StrtTime ) ! Let's time the whole simulation diff --git a/modules/seastate/src/SeaState_Output.f90 b/modules/seastate/src/SeaState_Output.f90 index b5b900e4f4..64d9f60677 100644 --- a/modules/seastate/src/SeaState_Output.f90 +++ b/modules/seastate/src/SeaState_Output.f90 @@ -272,7 +272,7 @@ SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, WaveField, WaveDT, X_ y_gridPts(i+1) = -Y_HalfWidth + deltaGrid(2)*i end do do i = 0, NGrid(3)-1 - z_gridPts(i+1) = - ( 1.0 - cos( real((NGrid(3) - 1) - i, ReKi) * deltaGrid(3) ) ) * WaveField%GridParams%Z_Depth + z_gridPts(i+1) = - ( 1.0 - cos( real((NGrid(3) - 1) - i, ReKi) * deltaGrid(3) ) ) * WaveField%GridDepth end do ! Write the increments from [0, NStepWave] even though for OpenFAST data, NStepWave = 0, but for arbitrary user data this may not be true. @@ -966,7 +966,7 @@ SUBROUTINE SeaStOut_CloseOutput ( p, ErrStat, ErrMsg ) ! Write the summary file header - IF ( p%UnOutFile > -1 ) THEN + IF ( p%UnOutFile > 0 ) THEN ! WRITE (p%UnOutFile,'(/,A/)', IOSTAT=ErrStat) 'This output file was closed on '//CurDate()//' at '//CurTime()//'.' !------------------------------------------------------------------------------------------------- @@ -1038,6 +1038,7 @@ SUBROUTINE SeaStOut_WrSummaryFile(InitInp, InputFileData, p, ErrStat, ErrMsg ) p%WaveField%EffWtrDpth, '(m) relative to SWL' WRITE( UnSum, '(1X,A15,F8.2,A20,F8.2,A19/)' ) 'Grid Z_Depth : ', InputFileData%Z_Depth - p%WaveField%MSL2SWL, '(m) relative to MSL; ', & InputFileData%Z_Depth, '(m) relative to SWL' + WRITE( UnSum, '(1X,A50,F10.5,A4)' ) 'WaveTimeShift: (applied at WaveField data access) ', p%WaveField%WaveTimeShift,' (s)' end if Frmt = '(1X,ES18.4e2,2x,ES18.4e2,2x,ES18.4e2,2x,ES18.4e2)' diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index bdd95ed4de..7d19e1e2bf 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -93,6 +93,7 @@ MODULE SeaState_Types REAL(ReKi) :: defWtrDpth = 0.0_ReKi !< Default water depth from the driver; may be overwritten [m] REAL(ReKi) :: defMSL2SWL = 0.0_ReKi !< Default mean sea level to still water level from the driver; may be overwritten [m] REAL(DbKi) :: TMax = 0.0_R8Ki !< Supplied by Driver: The total simulation time [(sec)] + REAL(DbKi) :: WaveTimeShift = 0 !< Add this to the time to effectively phase shift the wave (useful for hybrid tank testing). Positive value only (advance time) [(s)] INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] REAL(ReKi) :: PtfmLocationX = 0.0_ReKi !< Supplied by Driver: X coordinate of platform location in the wave field [m] REAL(ReKi) :: PtfmLocationY = 0.0_ReKi !< Supplied by Driver: Y coordinate of platform location in the wave field [m] @@ -146,7 +147,7 @@ MODULE SeaState_Types INTEGER(IntKi) :: Decimate = 0_IntKi !< The output decimation counter [-] REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Last time step which was written to the output file (sec) [-] INTEGER(IntKi) :: LastIndWave = 0_IntKi !< The last index used in the wave kinematics arrays, used to optimize interpolation [-] - TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] + TYPE(GridInterp_MiscVarType) :: WaveField_m !< misc var information from the Grid Interpolation module [-] END TYPE SeaSt_MiscVarType ! ======================= ! ========= Jac_u_idxStarts ======= @@ -492,6 +493,7 @@ subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%defWtrDpth = SrcInitInputData%defWtrDpth DstInitInputData%defMSL2SWL = SrcInitInputData%defMSL2SWL DstInitInputData%TMax = SrcInitInputData%TMax + DstInitInputData%WaveTimeShift = SrcInitInputData%WaveTimeShift DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY @@ -530,6 +532,7 @@ subroutine SeaSt_PackInitInput(RF, Indata) call RegPack(RF, InData%defWtrDpth) call RegPack(RF, InData%defMSL2SWL) call RegPack(RF, InData%TMax) + call RegPack(RF, InData%WaveTimeShift) call RegPack(RF, InData%WaveFieldMod) call RegPack(RF, InData%PtfmLocationX) call RegPack(RF, InData%PtfmLocationY) @@ -556,6 +559,7 @@ subroutine SeaSt_UnPackInitInput(RF, OutData) call RegUnpack(RF, OutData%defWtrDpth); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%defMSL2SWL); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%TMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveTimeShift); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%WaveFieldMod); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%PtfmLocationX); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%PtfmLocationY); if (RegCheckErr(RF, RoutineName)) return @@ -986,7 +990,7 @@ subroutine SeaSt_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Decimate = SrcMiscData%Decimate DstMiscData%LastOutTime = SrcMiscData%LastOutTime DstMiscData%LastIndWave = SrcMiscData%LastIndWave - call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) + call GridInterp_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end subroutine @@ -1000,7 +1004,7 @@ subroutine SeaSt_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SeaSt_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) + call GridInterp_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -1012,7 +1016,7 @@ subroutine SeaSt_PackMisc(RF, Indata) call RegPack(RF, InData%Decimate) call RegPack(RF, InData%LastOutTime) call RegPack(RF, InData%LastIndWave) - call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) + call GridInterp_PackMisc(RF, InData%WaveField_m) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1024,7 +1028,7 @@ subroutine SeaSt_UnPackMisc(RF, OutData) call RegUnpack(RF, OutData%Decimate); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%LastIndWave); if (RegCheckErr(RF, RoutineName)) return - call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m + call GridInterp_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m end subroutine subroutine SeaSt_CopyJac_u_idxStarts(SrcJac_u_idxStartsData, DstJac_u_idxStartsData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/servodyn/src/BladedInterface_EX.f90 b/modules/servodyn/src/BladedInterface_EX.f90 index b2f08be893..b4f3b8383d 100644 --- a/modules/servodyn/src/BladedInterface_EX.f90 +++ b/modules/servodyn/src/BladedInterface_EX.f90 @@ -64,7 +64,7 @@ MODULE BladedInterface_EX integer(IntKi), parameter :: CableCtrl_MaxChan = 200 !< Maximum channels in cable control group integer(IntKi), parameter :: StCCtrl_StartIdx = 2801 !< Starting index for the StC control integer(IntKi), parameter :: StCCtrl_MaxChan = 200 !< Maximum channels in StC control group - integer(IntKi), parameter :: StCCtrl_ChanPerSet = 20 !< Channels needed per set (10 sets for total channels) + integer(IntKi), parameter :: StCCtrl_ChanPerSet = 25 !< Channels needed per set (8 sets for total channels) CONTAINS @@ -277,15 +277,15 @@ end subroutine InitCableCtrl subroutine InitStCCtrl() integer(IntKi) :: I,J ! Generic counters - ! Error check the Cable Ctrl + ! Error check the StC Ctrl if (.not. allocated(StC_CtrlChanInitInfo%Requestor)) then ErrStat2=ErrID_Fatal - ErrMsg2='StC control string array indicating which module requested cable controls is missing (StC_CtrlChanInitInfo%Requestor)' + ErrMsg2='StC control string array indicating which module requested StC controls is missing (StC_CtrlChanInitInfo%Requestor)' if (Failed()) return endif if (size(StC_CtrlChanInitInfo%Requestor) /= p%NumStC_Control) then ErrStat2=ErrID_Fatal - ErrMsg2='Size of StC control string array (StC_CtrlChanInitInfo%Requestor) does not match the number of requested cable control channels.' + ErrMsg2='Size of StC control string array (StC_CtrlChanInitInfo%Requestor) does not match the number of requested StC control channels.' if (Failed()) return endif if ( (size(StC_CtrlChanInitInfo%InitMeasDisp,2) /= p%NumStC_Control) .or. & @@ -293,9 +293,10 @@ subroutine InitStCCtrl() (size(StC_CtrlChanInitInfo%InitStiff ,2) /= p%NumStC_Control) .or. & (size(StC_CtrlChanInitInfo%InitDamp ,2) /= p%NumStC_Control) .or. & (size(StC_CtrlChanInitInfo%InitBrake ,2) /= p%NumStC_Control) .or. & - (size(StC_CtrlChanInitInfo%InitForce ,2) /= p%NumStC_Control) ) then + (size(StC_CtrlChanInitInfo%InitForce ,2) /= p%NumStC_Control) .or. & + (size(StC_CtrlChanInitInfo%InitMoment ,2) /= p%NumStC_Control) ) then ErrStat2=ErrID_Fatal - ErrMsg2='Size of StC control initialization arrays (StC_CtrlChanInitInfo%Init*) do not match the number of requested cable control channels. Programming error somewhere.' + ErrMsg2='Size of StC control initialization arrays (StC_CtrlChanInitInfo%Init*) do not match the number of requested StC control channels. Programming error somewhere.' if (Failed()) return endif if ( p%NumStC_Control*StCCtrl_ChanPerSet > StCCtrl_MaxChan ) then @@ -324,6 +325,8 @@ subroutine InitStCCtrl() if (Failed()) return call AllocAry( dll_data%PrevStCCmdForce, 3, p%NumStC_Control, 'PrevStCCmdForce', ErrStat2, ErrMsg2 ) if (Failed()) return + call AllocAry( dll_data%PrevStCCmdMoment,3, p%NumStC_Control, 'PrevStCCmdMoment',ErrStat2, ErrMsg2 ) + if (Failed()) return call AllocAry( dll_data%StCCmdStiff, 3, p%NumStC_Control, 'StCCmdStiff', ErrStat2, ErrMsg2 ) if (Failed()) return call AllocAry( dll_data%StCCmdDamp, 3, p%NumStC_Control, 'StCCmdDamp', ErrStat2, ErrMsg2 ) @@ -332,6 +335,8 @@ subroutine InitStCCtrl() if (Failed()) return call AllocAry( dll_data%StCCmdForce, 3, p%NumStC_Control, 'StCCmdForce', ErrStat2, ErrMsg2 ) if (Failed()) return + call AllocAry( dll_data%StCCmdMoment, 3, p%NumStC_Control, 'StCCmdMoment', ErrStat2, ErrMsg2 ) + if (Failed()) return ! Initialize to values passed in dll_data%StCMeasDisp = real(StC_CtrlChanInitInfo%InitMeasDisp,SiKi) dll_data%StCMeasVel = real(StC_CtrlChanInitInfo%InitMeasVel ,SiKi) @@ -339,10 +344,12 @@ subroutine InitStCCtrl() dll_data%PrevStCCmdDamp = real(StC_CtrlChanInitInfo%InitDamp ,SiKi) dll_data%PrevStCCmdBrake = real(StC_CtrlChanInitInfo%InitBrake ,SiKi) dll_data%PrevStCCmdForce = real(StC_CtrlChanInitInfo%InitForce ,SiKi) + dll_data%PrevStCCmdMoment = real(StC_CtrlChanInitInfo%InitMoment ,SiKi) dll_data%StCCmdStiff = real(StC_CtrlChanInitInfo%InitStiff ,SiKi) dll_data%StCCmdDamp = real(StC_CtrlChanInitInfo%InitDamp ,SiKi) dll_data%StCCmdBrake = real(StC_CtrlChanInitInfo%InitBrake ,SiKi) dll_data%StCCmdForce = real(StC_CtrlChanInitInfo%InitForce ,SiKi) + dll_data%StCCmdMoment = real(StC_CtrlChanInitInfo%InitMoment ,SiKi) ! Create info for summary file about channels if (UnSum > 0) then @@ -366,8 +373,13 @@ subroutine InitStCCtrl() call WrSumInfoRcvd( J+16,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- StC_Force_X (additional force)') call WrSumInfoRcvd( J+17,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- StC_Force_Y (additional force)') call WrSumInfoRcvd( J+18,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- StC_Force_Z (additional force)') - call WrSumInfoRcvd( J+19,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- Reserved for future') - call WrSumInfoRcvd( J+20,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- Reserved for future') + call WrSumInfoRcvd( J+19,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- StC_Moment_X (additional moment)') + call WrSumInfoRcvd( J+20,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- StC_Moment_Y (additional moment)') + call WrSumInfoRcvd( J+21,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- StC_Moment_Z (additional moment)') + call WrSumInfoRcvd( J+22,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- Reserved for future') + call WrSumInfoRcvd( J+23,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- Reserved for future') + call WrSumInfoRcvd( J+24,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- Reserved for future') + call WrSumInfoRcvd( J+25,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- Reserved for future') enddo endif end subroutine InitStCCtrl @@ -569,7 +581,8 @@ subroutine SetEXavrStC_Sensors() dll_data%avrswap(J+ 7:J+ 9) = dll_data%PrevStCCmdStiff(1:3,I) ! StC initial stiffness -- StC_Stiff_X, StC_Stiff_Y, StC_Stiff_Z (N/m) dll_data%avrswap(J+10:J+12) = dll_data%PrevStCCmdDamp( 1:3,I) ! StC initial damping -- StC_Damp_X, StC_Damp_Y, StC_Damp_Z (N/(m/s)) dll_data%avrswap(J+13:J+15) = dll_data%PrevStCCmdBrake(1:3,I) ! StC initial brake -- StC_Brake_X, StC_Brake_Y, StC_Brake_Z (N) - dll_data%avrswap(J+16:J+18) = dll_data%PrevStCCmdForce(1:3,I) ! StC initial brake -- StC_Force_X, StC_Force_Y, StC_Force_Z (N) + dll_data%avrswap(J+16:J+18) = dll_data%PrevStCCmdForce(1:3,I) ! StC initial force -- StC_Force_X, StC_Force_Y, StC_Force_Z (N) + dll_data%avrswap(J+19:J+21) = dll_data%PrevStCCmdMoment(1:3,I) ! StC initial moment -- StC_Moment_X, StC_Moment_Y, StC_Moment_Z (N) enddo endif end subroutine SetEXavrStC_Sensors @@ -645,7 +658,8 @@ subroutine Retrieve_EXavrSWAP_StControls () dll_data%StCCmdStiff(1:3,I) = dll_data%avrswap(J+ 7:J+ 9) ! StC commanded stiffness -- StC_Stiff_X, StC_Stiff_Y, StC_Stiff_Z (N/m) dll_data%StCCmdDamp( 1:3,I) = dll_data%avrswap(J+10:J+12) ! StC commanded damping -- StC_Damp_X, StC_Damp_Y, StC_Damp_Z (N/(m/s)) dll_data%StCCmdBrake(1:3,I) = dll_data%avrswap(J+13:J+15) ! StC commanded brake -- StC_Brake_X, StC_Brake_Y, StC_Brake_Z (N) - dll_data%StCCmdForce(1:3,I) = dll_data%avrswap(J+16:J+18) ! StC commanded brake -- StC_Force_X, StC_Force_Y, StC_Force_Z (N) + dll_data%StCCmdForce(1:3,I) = dll_data%avrswap(J+16:J+18) ! StC commanded force -- StC_Force_X, StC_Force_Y, StC_Force_Z (N) + dll_data%StCCmdMoment(1:3,I)= dll_data%avrswap(J+19:J+21) ! StC commanded moment -- StC_Moment_X, StC_Moment_Y, StC_Moment_Z (N) enddo end subroutine Retrieve_EXavrSWAP_StControls diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index ad9c588d50..e88e37ee82 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -1037,7 +1037,7 @@ subroutine CheckInfo() do i=1,size(InitOut%LinNames_y) Flag='F' if (InitOut%RotFrame_y(i)) Flag='T' - call WrFileNR(CU,' '//Num2LStr(i)//Flag//' '//InitOut%LinNames_y(i)//NewLine) + call WrScr(' '//Num2LStr(i)//Flag//' '//InitOut%LinNames_y(i)) enddo endif if (allocated(InitOut%LinNames_x)) then @@ -1059,13 +1059,13 @@ subroutine CheckInfo() do i=1,size(InitOut%LinNames_x) Flag='F' if (InitOut%RotFrame_x(i)) Flag='T' - call WrFileNR(CU,' '//Num2LStr(i)//Flag//' '//trim(Num2LStr(InitOut%DerivOrder_x(i)))//' '//InitOut%LinNames_x(i)//NewLine) + call WrScr(' '//Num2LStr(i)//Flag//' '//trim(Num2LStr(InitOut%DerivOrder_x(i)))//' '//InitOut%LinNames_x(i)) enddo endif if (allocated(InitOut%LinNames_u)) then call WrScr('Perturb Size u') do i=1,size(p%du) - call WrFileNR(CU,' '//trim(Num2LStr(i))//' '//trim(Num2LStr(p%du(i)))//NewLine) + call WrScr(' '//trim(Num2LStr(i))//' '//trim(Num2LStr(p%du(i)))) enddo call WrScr('LinNames_u') do j=1,p%NumBStC @@ -1087,9 +1087,9 @@ subroutine CheckInfo() FlagLoad='F' if (InitOut%RotFrame_u(i)) Flag='T' if (InitOut%IsLoad_u(i)) FlagLoad='T' - call WrFileNR(CU,' '//Num2LStr(i)//Flag//' '//FlagLoad//' ('// & + call WrScr(' '//Num2LStr(i)//Flag//' '//FlagLoad//' ('// & trim(Num2LStr(p%Jac_u_indx(i,1)))//','//trim(Num2LStr(p%Jac_u_indx(i,2)))//','//trim(Num2LStr(p%Jac_u_indx(i,3)))// & - ') '//InitOut%LinNames_u(i)//NewLine) + ') '//InitOut%LinNames_u(i)) enddo endif end subroutine CheckInfo @@ -1668,6 +1668,7 @@ subroutine StC_CtrlChan_Setup(m,p,CtrlChanInitInfo,UnSum,ErrStat,ErrMsg) allocate(CtrlChanInitInfo%InitDamp( 3,p%NumStC_Control), STAT=ErrStat2); if ( AllErr('Could not allocate InitDamp array') ) return; allocate(CtrlChanInitInfo%InitBrake( 3,p%NumStC_Control), STAT=ErrStat2); if ( AllErr('Could not allocate InitBrake array') ) return; allocate(CtrlChanInitInfo%InitForce( 3,p%NumStC_Control), STAT=ErrStat2); if ( AllErr('Could not allocate InitForce array') ) return; + allocate(CtrlChanInitInfo%InitMoment( 3,p%NumStC_Control), STAT=ErrStat2); if ( AllErr('Could not allocate InitMoment array') ) return; allocate(CtrlChanInitInfo%InitMeasDisp(3,p%NumStC_Control), STAT=ErrStat2); if ( AllErr('Could not allocate InitMeasDisp array') ) return; allocate(CtrlChanInitInfo%InitMeasVel( 3,p%NumStC_Control), STAT=ErrStat2); if ( AllErr('Could not allocate InitMeasVel array') ) return; CtrlChanInitInfo%Requestor = "" @@ -1675,6 +1676,7 @@ subroutine StC_CtrlChan_Setup(m,p,CtrlChanInitInfo,UnSum,ErrStat,ErrMsg) CtrlChanInitInfo%InitDamp = 0.0_SiKi CtrlChanInitInfo%InitBrake = 0.0_SiKi CtrlChanInitInfo%InitForce = 0.0_SiKi + CtrlChanInitInfo%InitMoment = 0.0_SiKi CtrlChanInitInfo%InitMeasDisp = 0.0_SiKi CtrlChanInitInfo%InitMeasVel = 0.0_SiKi @@ -1723,7 +1725,7 @@ subroutine StC_CtrlChan_Setup(m,p,CtrlChanInitInfo,UnSum,ErrStat,ErrMsg) ! Set all the initial values to pass to the controller for first call and ensure all inputs/outputs for control are sized same call StC_SetDLLinputs(p,m,CtrlChanInitInfo%InitMeasDisp,CtrlChanInitInfo%InitMeasVel,ErrStat2,ErrMsg2,.TRUE.) ! Do resizing if needed if (Failed()) return; - call StC_SetInitDLLinputs(p,m,CtrlChanInitInfo%InitStiff,CtrlChanInitInfo%InitDamp,CtrlChanInitInfo%InitBrake,CtrlChanInitInfo%InitForce,ErrStat2,ErrMsg2) + call StC_SetInitDLLinputs(p,m,CtrlChanInitInfo%InitStiff,CtrlChanInitInfo%InitDamp,CtrlChanInitInfo%InitBrake,CtrlChanInitInfo%InitForce,CtrlChanInitInfo%InitMoment,ErrStat2,ErrMsg2) if (Failed()) return; ! Duplicates the Cmd channel data (so that they are allocated for first UpdateStates routine) call StC_InitExtrapInputs(p,m,ErrStat2,ErrMsg2) @@ -1861,10 +1863,11 @@ SUBROUTINE SrvD_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, INTEGER(IntKi) :: k ! loop counter for blade in BStC INTEGER(IntKi) :: order TYPE(SrvD_InputType) :: u_interp ! interpolated input - REAL(ReKi), ALLOCATABLE :: StC_CmdStiff(:,:) !< StC_CmdStiff command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 - REAL(ReKi), ALLOCATABLE :: StC_CmdDamp(:,:) !< StC_CmdDamp command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 - REAL(ReKi), ALLOCATABLE :: StC_CmdBrake(:,:) !< StC_CmdBrake command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 - REAL(ReKi), ALLOCATABLE :: StC_CmdForce(:,:) !< StC_CmdForce command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 + REAL(ReKi), ALLOCATABLE :: StC_CmdStiff(:,:) !< StC_CmdStiff command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 + REAL(ReKi), ALLOCATABLE :: StC_CmdDamp(:,:) !< StC_CmdDamp command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 + REAL(ReKi), ALLOCATABLE :: StC_CmdBrake(:,:) !< StC_CmdBrake command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 + REAL(ReKi), ALLOCATABLE :: StC_CmdForce(:,:) !< StC_CmdForce command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 + REAL(ReKi), ALLOCATABLE :: StC_CmdMoment(:,:) !< StC_CmdMoment command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (occurs after initial error) CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None @@ -1936,7 +1939,8 @@ SUBROUTINE SrvD_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, call AllocAry(StC_CmdDamp, 3, p%NumStC_Control, 'StC_CmdDamp' , ErrStat2, ErrMsg2 ); if (Failed()) return; call AllocAry(StC_CmdBrake, 3, p%NumStC_Control, 'StC_CmdBrake', ErrStat2, ErrMsg2 ); if (Failed()) return; call AllocAry(StC_CmdForce, 3, p%NumStC_Control, 'StC_CmdForce', ErrStat2, ErrMsg2 ); if (Failed()) return; - call StCControl_CalcOutput( t_next, p, StC_CmdStiff, StC_CmdDamp, StC_CmdBrake, StC_CmdForce, m, ErrStat2, ErrMsg2 ) + call AllocAry(StC_CmdMoment,3, p%NumStC_Control, 'StC_CmdMoment',ErrStat2, ErrMsg2 ); if (Failed()) return; + call StCControl_CalcOutput( t_next, p, StC_CmdStiff, StC_CmdDamp, StC_CmdBrake, StC_CmdForce, StC_CmdMoment, m, ErrStat2, ErrMsg2 ) if (Failed()) return; endif @@ -2030,11 +2034,12 @@ SUBROUTINE Cleanup() if (allocated(StC_CmdDamp)) deallocate(StC_CmdDamp) if (allocated(StC_CmdBrake)) deallocate(StC_CmdBrake) if (allocated(StC_CmdForce)) deallocate(StC_CmdForce) + if (allocated(StC_CmdMoment)) deallocate(StC_CmdMoment) END SUBROUTINE Cleanup subroutine SetStCInput_CtrlChans(u_StC) type(StC_InputType), intent(inout) :: u_StC(:) !< Inputs at InputTimes ! -- not all StC instances will necessarily be looking for this, so these inputs might not be allocated) - if (allocated(u_StC(1)%CmdStiff) .and. allocated(u_StC(1)%CmdDamp) .and. allocated(u_StC(1)%CmdBrake) .and. allocated(u_StC(1)%CmdForce)) then + if (allocated(u_StC(1)%CmdStiff) .and. allocated(u_StC(1)%CmdDamp) .and. allocated(u_StC(1)%CmdBrake) .and. allocated(u_StC(1)%CmdForce) .and. allocated(u_StC(1)%CmdMoment)) then if ( n > m%PrevTstepNcall ) then ! Cycle u%CmdStiff and others -- we are at a new timestep. do i=p%InterpOrder,1,-1 ! shift back in time in reverse order -- oldest (InterpOrder+1) to newest (1) @@ -2042,6 +2047,7 @@ subroutine SetStCInput_CtrlChans(u_StC) u_StC(i+1)%CmdDamp = u_StC(i)%CmdDamp u_StC(i+1)%CmdBrake = u_StC(i)%CmdBrake u_StC(i+1)%CmdForce = u_StC(i)%CmdForce + u_StC(i+1)%CmdMoment= u_StC(i)%CmdMoment enddo endif ! Now set the current commanded values @@ -2049,6 +2055,7 @@ subroutine SetStCInput_CtrlChans(u_StC) u_StC(1)%CmdDamp( 1:3,1:p%NumStC_Control) = StC_CmdDamp( 1:3,1:p%NumStC_Control) u_StC(1)%CmdBrake(1:3,1:p%NumStC_Control) = StC_CmdBrake(1:3,1:p%NumStC_Control) u_StC(1)%CmdForce(1:3,1:p%NumStC_Control) = StC_CmdForce(1:3,1:p%NumStC_Control) + u_StC(1)%CmdMoment(1:3,1:p%NumStC_Control)= StC_CmdMoment(1:3,1:p%NumStC_Control) endif end subroutine SetStCInput_CtrlChans @@ -2156,6 +2163,7 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg REAL(ReKi), ALLOCATABLE :: StC_CmdDamp(:,:) !< StC_CmdDamp command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 REAL(ReKi), ALLOCATABLE :: StC_CmdBrake(:,:) !< StC_CmdBrake command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 REAL(ReKi), ALLOCATABLE :: StC_CmdForce(:,:) !< StC_CmdForce command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 + REAL(ReKi), ALLOCATABLE :: StC_CmdMoment(:,:) !< StC_CmdMoment command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CalcOutput' @@ -2223,7 +2231,8 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg call AllocAry(StC_CmdDamp, 3, p%NumStC_Control, 'StC_CmdDamp' , ErrStat2, ErrMsg2 ); if (Failed()) return; call AllocAry(StC_CmdBrake, 3, p%NumStC_Control, 'StC_CmdBrake', ErrStat2, ErrMsg2 ); if (Failed()) return; call AllocAry(StC_CmdForce, 3, p%NumStC_Control, 'StC_CmdForce', ErrStat2, ErrMsg2 ); if (Failed()) return; - call StCControl_CalcOutput( t, p, StC_CmdStiff, StC_CmdDamp, StC_CmdBrake, StC_CmdForce, m, ErrStat2, ErrMsg2 ) + call AllocAry(StC_CmdMoment,3, p%NumStC_Control, 'StC_CmdMoment',ErrStat2, ErrMsg2 ); if (Failed()) return; + call StCControl_CalcOutput( t, p, StC_CmdStiff, StC_CmdDamp, StC_CmdBrake, StC_CmdForce, StC_CmdMoment, m, ErrStat2, ErrMsg2 ) if (Failed()) return; endif do j=1,p%NumBStC ! Blades @@ -2324,15 +2333,17 @@ SUBROUTINE Cleanup() if (allocated(StC_CmdDamp)) deallocate(StC_CmdDamp) if (allocated(StC_CmdBrake)) deallocate(StC_CmdBrake) if (allocated(StC_CmdForce)) deallocate(StC_CmdForce) + if (allocated(StC_CmdMoment)) deallocate(StC_CmdMoment) END SUBROUTINE Cleanup subroutine SetStCInput_CtrlChans(u_StC) type(StC_InputType), intent(inout) :: u_StC !< Inputs at InputTimes ! -- not all StC instances will necessarily be looking for this, so these inputs might not be allocated) - if (allocated(u_StC%CmdStiff) .and. allocated(u_StC%CmdDamp) .and. allocated(u_StC%CmdBrake) .and. allocated(u_StC%CmdForce)) then + if (allocated(u_StC%CmdStiff) .and. allocated(u_StC%CmdDamp) .and. allocated(u_StC%CmdBrake) .and. allocated(u_StC%CmdForce) .and. allocated(u_StC%CmdMoment)) then u_StC%CmdStiff(1:3,1:p%NumStC_Control) = StC_CmdStiff(1:3,1:p%NumStC_Control) u_StC%CmdDamp( 1:3,1:p%NumStC_Control) = StC_CmdDamp( 1:3,1:p%NumStC_Control) u_StC%CmdBrake(1:3,1:p%NumStC_Control) = StC_CmdBrake(1:3,1:p%NumStC_Control) u_StC%CmdForce(1:3,1:p%NumStC_Control) = StC_CmdForce(1:3,1:p%NumStC_Control) + u_StC%CmdMoment(1:3,1:p%NumStC_Control)= StC_CmdMoment(1:3,1:p%NumStC_Control) endif end subroutine SetStCInput_CtrlChans @@ -6346,13 +6357,14 @@ END SUBROUTINE CableControl_CalcOutput ! Commanded Airfoil UserProp for blade (must be same units as given in AD15 airfoil tables) ! This is passed to AD15 to be interpolated with the airfoil table userprop column ! (might be used for airfoil flap angles for example) -SUBROUTINE StCControl_CalcOutput( t, p, StC_CmdStiff, StC_CmdDamp, StC_CmdBrake, StC_CmdForce, m, ErrStat, ErrMsg ) +SUBROUTINE StCControl_CalcOutput( t, p, StC_CmdStiff, StC_CmdDamp, StC_CmdBrake, StC_CmdForce, StC_CmdMoment, m, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters REAL(ReKi), ALLOCATABLE, INTENT(INOUT) :: StC_CmdStiff(:,:) !< StC_CmdStiff command signals (3,p%NumStC_Control) REAL(ReKi), ALLOCATABLE, INTENT(INOUT) :: StC_CmdDamp(:,:) !< StC_CmdDamp command signals (3,p%NumStC_Control) REAL(ReKi), ALLOCATABLE, INTENT(INOUT) :: StC_CmdBrake(:,:) !< StC_CmdBrake command signals (3,p%NumStC_Control) REAL(ReKi), ALLOCATABLE, INTENT(INOUT) :: StC_CmdForce(:,:) !< StC_CmdForce command signals (3,p%NumStC_Control) + REAL(ReKi), ALLOCATABLE, INTENT(INOUT) :: StC_CmdMoment(:,:) !< StC_CmdMoment command signals (3,p%NumStC_Control) TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc (optimization) variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -6364,7 +6376,7 @@ SUBROUTINE StCControl_CalcOutput( t, p, StC_CmdStiff, StC_CmdDamp, StC_CmdBrake, ! Only proceed if we have have StC controls with the extended swap and legacy interface if ((p%NumStC_Control <= 0) .or. (.not. p%EXavrSWAP)) return - if (.not. allocated(StC_CmdStiff) .or. .not. allocated(StC_CmdDamp) .or. .not. allocated(StC_CmdBrake) .or. .not. allocated(StC_CmdForce)) then + if (.not. allocated(StC_CmdStiff) .or. .not. allocated(StC_CmdDamp) .or. .not. allocated(StC_CmdBrake) .or. .not. allocated(StC_CmdForce) .or. .not. allocated(StC_CmdMoment)) then ErrStat = ErrID_Fatal ErrMsg = "StC control signal matrices not allocated. Programming error somewhere." return @@ -6392,11 +6404,16 @@ SUBROUTINE StCControl_CalcOutput( t, p, StC_CmdStiff, StC_CmdDamp, StC_CmdBrake, StC_CmdForce(1:3,1:p%NumStC_Control) = m%dll_data%PrevStCCmdForce(1:3,1:p%NumStC_Control) + & factor * ( m%dll_data%StCCmdForce(1:3,1:p%NumStC_Control) - m%dll_data%PrevStCCmdForce(1:3,1:p%NumStC_Control) ) endif + if (allocated(StC_CmdMoment)) then + StC_CmdMoment(1:3,1:p%NumStC_Control) = m%dll_data%PrevStCCmdMoment(1:3,1:p%NumStC_Control) + & + factor * ( m%dll_data%StCCmdMoment(1:3,1:p%NumStC_Control) - m%dll_data%PrevStCCmdMoment(1:3,1:p%NumStC_Control) ) + endif else if (allocated(StC_CmdStiff)) StC_CmdStiff(1:3,1:p%NumStC_Control) = m%dll_data%StCCmdStiff(1:3,1:p%NumStC_Control) if (allocated(StC_CmdDamp)) StC_CmdDamp( 1:3,1:p%NumStC_Control) = m%dll_data%StCCmdDamp( 1:3,1:p%NumStC_Control) if (allocated(StC_CmdBrake)) StC_CmdBrake(1:3,1:p%NumStC_Control) = m%dll_data%StCCmdBrake(1:3,1:p%NumStC_Control) if (allocated(StC_CmdForce)) StC_CmdForce(1:3,1:p%NumStC_Control) = m%dll_data%StCCmdForce(1:3,1:p%NumStC_Control) + if (allocated(StC_CmdMoment)) StC_CmdMoment(1:3,1:p%NumStC_Control)= m%dll_data%StCCmdMoment(1:3,1:p%NumStC_Control) end if END SUBROUTINE StCControl_CalcOutput @@ -6531,13 +6548,14 @@ subroutine GetMeas(iNum,CChan,y) ! Assemble info about who requested which ch end subroutine GetMeas end subroutine StC_SetDLLinputs -subroutine StC_SetInitDLLinputs(p,m,InitStiff,InitDamp,InitBrake,InitForce,ErrStat,ErrMsg) +subroutine StC_SetInitDLLinputs(p,m,InitStiff,InitDamp,InitBrake,InitForce,InitMoment,ErrStat,ErrMsg) type(SrvD_ParameterType), intent(in ) :: p !< Parameters type(SrvD_MiscVarType), intent(inout) :: m !< Misc (optimization) variables real(SiKi), allocatable, intent(inout) :: InitStiff(:,:) !< initial stiffness -- from input file normally output of DLL (3,p%NumStC_Control) real(SiKi), allocatable, intent(inout) :: InitDamp(:,:) !< Initial damping -- from input file normally output of DLL (3,p%NumStC_Control) real(SiKi), allocatable, intent(inout) :: InitBrake(:,:) !< Initial brake -- from input file (?) normally output of DLL (3,p%NumStC_Control) - real(SiKi), allocatable, intent(inout) :: InitForce(:,:) !< Initial brake -- from input file (?) normally output of DLL (3,p%NumStC_Control) + real(SiKi), allocatable, intent(inout) :: InitForce(:,:) !< Initial force -- from input file (?) normally output of DLL (3,p%NumStC_Control) + real(SiKi), allocatable, intent(inout) :: InitMoment(:,:) !< Initial moment -- from input file (?) normally output of DLL (3,p%NumStC_Control) integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -6554,7 +6572,7 @@ subroutine StC_SetInitDLLinputs(p,m,InitStiff,InitDamp,InitBrake,InitForce,ErrSt ! Only proceed if we have have StC controls with the extended swap if ((p%NumStC_Control <= 0) .or. (.not. p%EXavrSWAP)) return - if ((.not. allocated(InitStiff)) .or. (.not. allocated(InitDamp)) .or. (.not. allocated(InitBrake)) .or. (.not. allocated(InitForce))) then + if ((.not. allocated(InitStiff)) .or. (.not. allocated(InitDamp)) .or. (.not. allocated(InitBrake)) .or. (.not. allocated(InitForce)) .or. (.not. allocated(InitMoment))) then ErrStat2 = ErrID_Fatal ErrMsg2 = "StC control signal matrices not allocated. Programming error somewhere." if (Failed()) return @@ -6598,6 +6616,7 @@ subroutine StC_SetInitDLLinputs(p,m,InitStiff,InitDamp,InitBrake,InitForce,ErrSt endif enddo InitForce = 0.0_ReKi + InitMoment = 0.0_ReKi contains subroutine ResizeStCinput(iNum,u) ! Assemble info about who requested which channel @@ -6605,8 +6624,8 @@ subroutine ResizeStCinput(iNum,u) ! Assemble info about who requested which c type(StC_InputType), intent(inout) :: u ! inputs from the StC instance -- will contain allocated Cmd input values if used type(StC_InputType) :: u_tmp ! copy of u -- for resizing as needed integer(IntKi) :: i_local - if (allocated(u%CmdStiff) .and. allocated(u%CmdDamp) .and. allocated(u%CmdBrake) .and. allocated(u%CmdForce)) then ! either all or none will be allocated - if (p%NumStC_Control > min(size(u%CmdStiff,2),size(u%CmdDamp,2),size(u%CmdBrake,2),size(u%CmdForce,2))) then + if (allocated(u%CmdStiff) .and. allocated(u%CmdDamp) .and. allocated(u%CmdBrake) .and. allocated(u%CmdForce) .and. allocated(u%CmdMoment)) then ! either all or none will be allocated + if (p%NumStC_Control > min(size(u%CmdStiff,2),size(u%CmdDamp,2),size(u%CmdBrake,2),size(u%CmdForce,2),size(u%CmdMoment,2))) then call StC_CopyInput(u,u_tmp,MESH_NEWCOPY,ErrStat2,ErrMsg2); if (Failed()) return; if (allocated(u%CmdStiff)) deallocate(u%CmdStiff) @@ -6637,6 +6656,13 @@ subroutine ResizeStCinput(iNum,u) ! Assemble info about who requested which c u%CmdForce(1:3,i_local) = u_tmp%CmdForce(1:3,i_local) enddo + if (allocated(u%CmdMoment)) deallocate(u%CmdMoment) + call AllocAry(u%CmdMoment,3,p%NumStC_Control,"u%CmdMoment",ErrStat2,ErrMsg2); if (Failed()) return; + u%CmdMoment = 0.0_ReKi + do i_local=1,min(p%NumStC_Control,size(u_tmp%CmdMoment,2)) + u%CmdMoment(1:3,i_local) = u_tmp%CmdMoment(1:3,i_local) + enddo + call Cleanup() endif else @@ -6656,6 +6682,10 @@ subroutine ResizeStCinput(iNum,u) ! Assemble info about who requested which c call AllocAry(u%CmdForce,3,p%NumStC_Control,"u%CmdForce",ErrStat2,ErrMsg2); if (Failed()) return; u%CmdForce = 0.0_ReKi endif + if (.not. allocated(u%CmdMoment)) then + call AllocAry(u%CmdMoment,3,p%NumStC_Control,"u%CmdMoment",ErrStat2,ErrMsg2); if (Failed()) return; + u%CmdMoment = 0.0_ReKi + endif endif end subroutine ResizeStCinput subroutine GetMeas(iNum,CChan,u) ! Assemble info about who requested which channel @@ -6668,6 +6698,7 @@ subroutine GetMeas(iNum,CChan,u) ! Assemble info about who requested which ch InitDamp( 1:3,CChan(j)) = InitDamp( 1:3,CChan(j)) + real(u%CmdDamp( 1:3,CChan(j)),SiKi) InitBrake(1:3,CChan(j)) = InitBrake(1:3,CChan(j)) + real(u%CmdBrake(1:3,CChan(j)),SiKi) InitForce(1:3,CChan(j)) = InitForce(1:3,CChan(j)) + real(u%CmdForce(1:3,CChan(j)),SiKi) + InitMoment(1:3,CChan(j))= InitMoment(1:3,CChan(j))+ real(u%CmdMoment(1:3,CChan(j)),SiKi) endif enddo end subroutine GetMeas diff --git a/modules/servodyn/src/ServoDyn_Registry.txt b/modules/servodyn/src/ServoDyn_Registry.txt index 8160192355..c752d57c97 100644 --- a/modules/servodyn/src/ServoDyn_Registry.txt +++ b/modules/servodyn/src/ServoDyn_Registry.txt @@ -257,12 +257,14 @@ typedef ^ BladedDLLType SiKi CableDeltaL {:} - - "The swap array: used to pass typedef ^ BladedDLLType SiKi CableDeltaLdot {:} - - "The swap array: used to pass data from the DLL controller for cable tensioning DeltaLdot using extended avrSWAP [see EXavrSWAP documentation in BladededInterface_EX]" m/s typedef ^ BladedDLLType SiKi PrevStCCmdStiff {:}{:} - - "Previous value for ramping StC stiffness from controller (3,NumStC_Control)" "N/m" typedef ^ BladedDLLType SiKi PrevStCCmdDamp {:}{:} - - "Previous value for ramping StC damping from controller (3,NumStC_Control)" "N/(m/s)" -typedef ^ BladedDLLType SiKi PrevStCCmdBrake {:}{:} - - "Previous value for ramping StC braking signal (3,NumStC_Control)" "N/(m/s)" -typedef ^ BladedDLLType SiKi PrevStCCmdForce {:}{:} - - "Previous value for ramping StC force signal (3,NumStC_Control)" "N/(m/s)" +typedef ^ BladedDLLType SiKi PrevStCCmdBrake {:}{:} - - "Previous value for ramping StC braking signal (3,NumStC_Control)" "N" +typedef ^ BladedDLLType SiKi PrevStCCmdForce {:}{:} - - "Previous value for ramping StC force signal (3,NumStC_Control)" "N" +typedef ^ BladedDLLType SiKi PrevStCCmdMoment {:}{:} - - "Previous value for ramping StC moment signal (3,NumStC_Control)" "N-m" typedef ^ BladedDLLType SiKi StCCmdStiff {:}{:} - - "StC stiffness from controller (3,NumStC_Control)" "N/m" typedef ^ BladedDLLType SiKi StCCmdDamp {:}{:} - - "StC damping from controller (3,NumStC_Control)" "N/(m/s)" typedef ^ BladedDLLType SiKi StCCmdBrake {:}{:} - - "StC braking signal (3,NumStC_Control)" "N" typedef ^ BladedDLLType SiKi StCCmdForce {:}{:} - - "StC commanded force signal (3,NumStC_Control)" "N" +typedef ^ BladedDLLType SiKi StCCmdMoment {:}{:} - - "StC commanded moment signal (3,NumStC_Control)" "N-m" typedef ^ BladedDLLType SiKi StCMeasDisp {:}{:} - - "StC measured local displacement signal from StC (3,NumStC_Control)" "m" typedef ^ BladedDLLType SiKi StCMeasVel {:}{:} - - "StC measured local velocity signal from StC (3,NumStC_Control)" "m/s" diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index da5d45358c..b9fb0a0f40 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -268,12 +268,14 @@ MODULE ServoDyn_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CableDeltaLdot !< The swap array: used to pass data from the DLL controller for cable tensioning DeltaLdot using extended avrSWAP [see EXavrSWAP documentation in BladededInterface_EX] [m/s] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: PrevStCCmdStiff !< Previous value for ramping StC stiffness from controller (3,NumStC_Control) [N/m] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: PrevStCCmdDamp !< Previous value for ramping StC damping from controller (3,NumStC_Control) [N/(m/s)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: PrevStCCmdBrake !< Previous value for ramping StC braking signal (3,NumStC_Control) [N/(m/s)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: PrevStCCmdForce !< Previous value for ramping StC force signal (3,NumStC_Control) [N/(m/s)] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: PrevStCCmdBrake !< Previous value for ramping StC braking signal (3,NumStC_Control) [N] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: PrevStCCmdForce !< Previous value for ramping StC force signal (3,NumStC_Control) [N] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: PrevStCCmdMoment !< Previous value for ramping StC moment signal (3,NumStC_Control) [N-m] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCCmdStiff !< StC stiffness from controller (3,NumStC_Control) [N/m] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCCmdDamp !< StC damping from controller (3,NumStC_Control) [N/(m/s)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCCmdBrake !< StC braking signal (3,NumStC_Control) [N] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCCmdForce !< StC commanded force signal (3,NumStC_Control) [N] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCCmdMoment !< StC commanded moment signal (3,NumStC_Control) [N-m] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCMeasDisp !< StC measured local displacement signal from StC (3,NumStC_Control) [m] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCMeasVel !< StC measured local velocity signal from StC (3,NumStC_Control) [m/s] END TYPE BladedDLLType @@ -1724,6 +1726,18 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if DstBladedDLLTypeData%PrevStCCmdForce = SrcBladedDLLTypeData%PrevStCCmdForce end if + if (allocated(SrcBladedDLLTypeData%PrevStCCmdMoment)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdMoment) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdMoment) + if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdMoment)) then + allocate(DstBladedDLLTypeData%PrevStCCmdMoment(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdMoment.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%PrevStCCmdMoment = SrcBladedDLLTypeData%PrevStCCmdMoment + end if if (allocated(SrcBladedDLLTypeData%StCCmdStiff)) then LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdStiff) UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdStiff) @@ -1772,6 +1786,18 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if DstBladedDLLTypeData%StCCmdForce = SrcBladedDLLTypeData%StCCmdForce end if + if (allocated(SrcBladedDLLTypeData%StCCmdMoment)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdMoment) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdMoment) + if (.not. allocated(DstBladedDLLTypeData%StCCmdMoment)) then + allocate(DstBladedDLLTypeData%StCCmdMoment(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdMoment.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%StCCmdMoment = SrcBladedDLLTypeData%StCCmdMoment + end if if (allocated(SrcBladedDLLTypeData%StCMeasDisp)) then LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasDisp) UB(1:2) = ubound(SrcBladedDLLTypeData%StCMeasDisp) @@ -1869,6 +1895,9 @@ subroutine SrvD_DestroyBladedDLLType(BladedDLLTypeData, ErrStat, ErrMsg) if (allocated(BladedDLLTypeData%PrevStCCmdForce)) then deallocate(BladedDLLTypeData%PrevStCCmdForce) end if + if (allocated(BladedDLLTypeData%PrevStCCmdMoment)) then + deallocate(BladedDLLTypeData%PrevStCCmdMoment) + end if if (allocated(BladedDLLTypeData%StCCmdStiff)) then deallocate(BladedDLLTypeData%StCCmdStiff) end if @@ -1881,6 +1910,9 @@ subroutine SrvD_DestroyBladedDLLType(BladedDLLTypeData, ErrStat, ErrMsg) if (allocated(BladedDLLTypeData%StCCmdForce)) then deallocate(BladedDLLTypeData%StCCmdForce) end if + if (allocated(BladedDLLTypeData%StCCmdMoment)) then + deallocate(BladedDLLTypeData%StCCmdMoment) + end if if (allocated(BladedDLLTypeData%StCMeasDisp)) then deallocate(BladedDLLTypeData%StCMeasDisp) end if @@ -1990,10 +2022,12 @@ subroutine SrvD_PackBladedDLLType(RF, Indata) call RegPackAlloc(RF, InData%PrevStCCmdDamp) call RegPackAlloc(RF, InData%PrevStCCmdBrake) call RegPackAlloc(RF, InData%PrevStCCmdForce) + call RegPackAlloc(RF, InData%PrevStCCmdMoment) call RegPackAlloc(RF, InData%StCCmdStiff) call RegPackAlloc(RF, InData%StCCmdDamp) call RegPackAlloc(RF, InData%StCCmdBrake) call RegPackAlloc(RF, InData%StCCmdForce) + call RegPackAlloc(RF, InData%StCCmdMoment) call RegPackAlloc(RF, InData%StCMeasDisp) call RegPackAlloc(RF, InData%StCMeasVel) if (RegCheckErr(RF, RoutineName)) return @@ -2106,10 +2140,12 @@ subroutine SrvD_UnPackBladedDLLType(RF, OutData) call RegUnpackAlloc(RF, OutData%PrevStCCmdDamp); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%PrevStCCmdBrake); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%PrevStCCmdForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PrevStCCmdMoment); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%StCCmdStiff); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%StCCmdDamp); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%StCCmdBrake); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%StCCmdForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StCCmdMoment); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%StCMeasDisp); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%StCMeasVel); if (RegCheckErr(RF, RoutineName)) return end subroutine diff --git a/modules/servodyn/src/StrucCtrl.f90 b/modules/servodyn/src/StrucCtrl.f90 index 0c0cea0da6..d559173750 100644 --- a/modules/servodyn/src/StrucCtrl.f90 +++ b/modules/servodyn/src/StrucCtrl.f90 @@ -328,6 +328,8 @@ SUBROUTINE StC_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOu if (Failed()) return; call AllocAry( u%CmdForce, 3, maxval(p%StC_CChan), 'u%CmdForce', ErrStat2, ErrMsg2 ) if (Failed()) return; + call AllocAry( u%CmdMoment,3, maxval(p%StC_CChan), 'u%CmdMoment', ErrStat2, ErrMsg2 ) + if (Failed()) return; call AllocAry( y%MeasDisp, 3, maxval(p%StC_CChan), 'y%MeasDisp', ErrStat2, ErrMsg2 ) if (Failed()) return; call AllocAry( y%MeasVel, 3, maxval(p%StC_CChan), 'y%MeasVel', ErrStat2, ErrMsg2 ) @@ -337,6 +339,7 @@ SUBROUTINE StC_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOu u%CmdDamp = 0.0_ReKi u%CmdBrake = 0.0_ReKi u%CmdForce = 0.0_ReKi + u%CmdMoment = 0.0_ReKi y%MeasDisp = 0.0_ReKi y%MeasVel = 0.0_ReKi ! Check that dimensions of x are what we expect @@ -350,7 +353,7 @@ SUBROUTINE StC_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOu if (p%StC_CChan(i) > 0) then u%CmdStiff(1:3,p%StC_CChan(i)) = (/ p%K_X, p%K_Y, p%K_Z /) u%CmdDamp( 1:3,p%StC_CChan(i)) = (/ p%C_X, p%C_Y, p%C_Z /) - !u%CmdBrake and u%CmdForce--- leave these at zero for now (no input file method to set it) + !u%CmdBrake, u%CmdForce and u%CmdMoment -- leave these at zero for now (no input file method to set it) ! The states are sized by (6,NumMeshPts). NumMeshPts is then used to set ! size of StC_CChan as well. For safety, we will check it here. y%MeasDisp(1:3,p%StC_CChan(i)) = (/ x%StC_x(1,i), x%StC_x(3,i), x%StC_x(5,i) /) @@ -388,6 +391,7 @@ subroutine Init_Misc( p, m, ErrStat, ErrMsg ) ! they have been moved into MiscVars so that we don so we don't reallocate all the time. call AllocAry(m%F_stop , 3, p%NumMeshPts, 'F_stop' , ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; m%F_stop = 0.0_ReKi call AllocAry(m%F_ext , 3, p%NumMeshPts, 'F_ext' , ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; m%F_ext = 0.0_ReKi + call AllocAry(m%M_ext , 3, p%NumMeshPts, 'M_ext' , ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; m%M_ext = 0.0_ReKi call AllocAry(m%F_fr , 3, p%NumMeshPts, 'F_fr' , ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; m%F_fr = 0.0_ReKi call AllocAry(m%C_ctrl , 3, p%NumMeshPts, 'C_ctrl' , ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; m%C_ctrl = 0.0_ReKi call AllocAry(m%C_Brake, 3, p%NumMeshPts, 'C_Brake', ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; m%C_Brake = 0.0_ReKi @@ -975,20 +979,11 @@ SUBROUTINE StC_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ELSEIF ( p%StC_DOF_MODE == DOFMode_ForceDLL ) THEN ! Note that the prescribed force is applied the same to all Mesh pts ! that are passed into this instance of the StC - if (p%PrescribedForcesCoordSys == PRESCRIBED_FORCE_GLOBAL) then - ! Global coords - do i_pt=1,p%NumMeshPts - y%Mesh(i_pt)%Force(1:3,1) = m%F_ext(1:3,i_pt) - y%Mesh(i_pt)%Moment(1:3,1) = 0 - enddo - ! Leave in for now just in case we decide there is a use case for a follower force from the DLL - ! elseif (p%PrescribedForcesCoordSys == PRESCRIBED_FORCE_LOCAL) then - ! ! local coords - ! do i_pt=1,p%NumMeshPts - ! y%Mesh(i_pt)%Force(1:3,1) = matmul(transpose(u%Mesh(i_pt)%Orientation(:,:,1)), m%F_P(1:3,i_pt)) - ! y%Mesh(i_pt)%Moment(1:3,1) = matmul(transpose(u%Mesh(i_pt)%Orientation(:,:,1)), m%M_P(1:3,i_pt)) - ! enddo - endif + ! Global coords only + do i_pt=1,p%NumMeshPts + y%Mesh(i_pt)%Force(1:3,1) = m%F_ext(1:3,i_pt) + y%Mesh(i_pt)%Moment(1:3,1) = m%M_ext(1:3,i_pt) + enddo END IF ! Set output values for the measured displacements for @@ -1174,7 +1169,7 @@ SUBROUTINE StC_CalcContStateDeriv( Time, u, p, x, xd, z, OtherState, m, dxdt, Er ELSE IF (p%StC_CMODE == CMODE_Semi) THEN ! ground hook control CALL StC_GroundHookDamp(dxdt,x,u,p,m%rdisp_P,m%rdot_P,m%C_ctrl,m%C_Brake,m%F_fr) ELSE IF (p%StC_CMODE == CMODE_ActiveDLL) THEN ! Active control from DLL - call StC_ActiveCtrl_StiffDamp(u,p,m%K,m%C_ctrl,m%C_Brake,m%F_ext) + call StC_ActiveCtrl_StiffDamp(u,p,m%K,m%C_ctrl,m%C_Brake,m%F_ext,m%M_ext) m%F_fr = 0.0_ReKi if (.not. p%Use_F_TBL) then K(1:3,:) = m%K(1:3,:) @@ -1654,13 +1649,14 @@ SUBROUTINE StC_GroundHookDamp(dxdt,x,u,p,rdisp_P,rdot_P,C_ctrl,C_Brake,F_fr) enddo END SUBROUTINE StC_GroundHookDamp !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE StC_ActiveCtrl_StiffDamp(u,p,K_ctrl,C_ctrl,C_Brake,F_ctrl) +SUBROUTINE StC_ActiveCtrl_StiffDamp(u,p,K_ctrl,C_ctrl,C_Brake,F_ctrl,M_ctrl) TYPE(StC_InputType), INTENT(IN ) :: u !< Inputs at Time TYPE(StC_ParameterType), INTENT(IN ) :: p !< The module's parameter data real(ReKi), intent(inout) :: K_ctrl(:,:) !< stiffness commanded by dll -- leave alone if no ctrl real(ReKi), intent(inout) :: C_ctrl(:,:) !< damping commanded by dll real(ReKi), intent(inout) :: C_Brake(:,:) !< brake commanded by dll - real(ReKi), intent(inout) :: F_ctrl(:,:) !< brake commanded by dll + real(ReKi), intent(inout) :: F_ctrl(:,:) !< force commanded by dll + real(ReKi), intent(inout) :: M_ctrl(:,:) !< moment commanded by dll integer(IntKi) :: i_pt ! counter for mesh points do i_pt=1,p%NumMeshPts if (p%StC_CChan(i_pt) > 0) then ! This index should have been checked at init, so won't check bounds here @@ -1668,12 +1664,14 @@ SUBROUTINE StC_ActiveCtrl_StiffDamp(u,p,K_ctrl,C_ctrl,C_Brake,F_ctrl) C_ctrl( 1:3,i_pt) = u%CmdDamp( 1:3,p%StC_CChan(i_pt)) C_Brake(1:3,i_pt) = u%CmdBrake(1:3,p%StC_CChan(i_pt)) F_ctrl(1:3,i_pt) = u%CmdForce(1:3,p%StC_CChan(i_pt)) + M_ctrl(1:3,i_pt) = u%CmdMoment(1:3,p%StC_CChan(i_pt)) else ! Use parameters from file (as if no control) -- leave K value as that may be set by table prior C_ctrl(1,:) = p%C_X C_ctrl(2,:) = p%C_Y C_ctrl(3,:) = p%C_Z C_Brake = 0.0_ReKi F_ctrl = 0.0_ReKi + M_ctrl = 0.0_ReKi endif enddo END SUBROUTINE StC_ActiveCtrl_StiffDamp @@ -2192,6 +2190,9 @@ subroutine StC_ValidatePrimaryData( InputFileData, InitInp, ErrStat, ErrMsg ) if ( InputFileData%StC_CChan(i) < 0 .or. InputFileData%StC_CChan(i) > 10 ) then call SetErrStat( ErrID_Fatal, 'Control channel (StC_CChan) must be between 0 (off) and 10 when StC_CMode=5.', ErrStat, ErrMsg, RoutineName ) endif + if ( InputFileData%StC_CChan(i) == 0 ) then + call SetErrStat( ErrID_Warn, 'Control mode 5 (active with DLL control) requested, but no control channel specified. No external force will be applied.', ErrStat, ErrMsg, RoutineName ) + endif enddo endif diff --git a/modules/servodyn/src/StrucCtrl_Registry.txt b/modules/servodyn/src/StrucCtrl_Registry.txt index 9a791558b3..92bbbc3a2b 100644 --- a/modules/servodyn/src/StrucCtrl_Registry.txt +++ b/modules/servodyn/src/StrucCtrl_Registry.txt @@ -103,6 +103,7 @@ typedef ^ StC_CtrlChanInitInfoType SiKi InitStiff {:}{:} - - "StC stiffness at typedef ^ StC_CtrlChanInitInfoType SiKi InitDamp {:}{:} - - "StC damping at initialization (3,NumStC_Control) -- passed from StC to let controller know the value during init" "N/(m/s)" typedef ^ StC_CtrlChanInitInfoType SiKi InitBrake {:}{:} - - "StC braking signal at initialization (3,NumStC_Control) -- passed from StC to let controller know the value during init" "N" typedef ^ StC_CtrlChanInitInfoType SiKi InitForce {:}{:} - - "StC external force signal at initialization (3,NumStC_Control) -- passed from StC to let controller know the value during init (should be zero)" "N" +typedef ^ StC_CtrlChanInitInfoType SiKi InitMoment {:}{:} - - "StC external moment signal at initialization (3,NumStC_Control) -- passed from StC to let controller know the value during init (should be zero)" "N-m" typedef ^ StC_CtrlChanInitInfoType SiKi InitMeasDisp {:}{:} - - "StC measured local displacement signal from StC at initialization (3,NumStC_Control)" "m" typedef ^ StC_CtrlChanInitInfoType SiKi InitMeasVel {:}{:} - - "StC measured local velocity signal from StC at initialization (3,NumStC_Control)" "m/s" @@ -124,6 +125,7 @@ typedef ^ OtherStateType Reki DummyOtherState - - - "Remove this variable if # at a given time, etc.) or other data that do not depend on time typedef ^ MiscVarType Reki F_stop {:}{:} - - "Stop forces" - typedef ^ MiscVarType ReKi F_ext {:}{:} - - "External forces (user defined or from controller)" - +typedef ^ MiscVarType ReKi M_ext {:}{:} - - "External moments (user defined or from controller)" - typedef ^ MiscVarType ReKi F_fr {:}{:} - - "Friction forces" - typedef ^ MiscVarType ReKi K {:}{:} - - "Stiffness -- might be changed if controller controls this" N/m typedef ^ MiscVarType ReKi C_ctrl {:}{:} - - "Controlled Damping (On/Off)" - @@ -203,6 +205,7 @@ typedef ^ ^ ReKi CmdStiff {:}{:} - - "StC stiffness from controller" "N/m" typedef ^ ^ ReKi CmdDamp {:}{:} - - "StC damping from controller" "N/(m/s)" typedef ^ ^ ReKi CmdBrake {:}{:} - - "StC braking from controller" "N/(m/s)" typedef ^ ^ ReKi CmdForce {:}{:} - - "StC force from controller" "N" +typedef ^ ^ ReKi CmdMoment {:}{:} - - "StC moment from controller" "N-m" # ..... Outputs ................................................................................................................... # Define outputs that are contained on the mesh here: typedef ^ OutputType MeshType Mesh {:} - - "Loads at the StC reference points in the inertial frame" - diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index 105e73d1ac..98995f861a 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -126,6 +126,7 @@ MODULE StrucCtrl_Types REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: InitDamp !< StC damping at initialization (3,NumStC_Control) -- passed from StC to let controller know the value during init [N/(m/s)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: InitBrake !< StC braking signal at initialization (3,NumStC_Control) -- passed from StC to let controller know the value during init [N] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: InitForce !< StC external force signal at initialization (3,NumStC_Control) -- passed from StC to let controller know the value during init (should be zero) [N] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: InitMoment !< StC external moment signal at initialization (3,NumStC_Control) -- passed from StC to let controller know the value during init (should be zero) [N-m] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: InitMeasDisp !< StC measured local displacement signal from StC at initialization (3,NumStC_Control) [m] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: InitMeasVel !< StC measured local velocity signal from StC at initialization (3,NumStC_Control) [m/s] END TYPE StC_CtrlChanInitInfoType @@ -159,6 +160,7 @@ MODULE StrucCtrl_Types TYPE, PUBLIC :: StC_MiscVarType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_stop !< Stop forces [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_ext !< External forces (user defined or from controller) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: M_ext !< External moments (user defined or from controller) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_fr !< Friction forces [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: K !< Stiffness -- might be changed if controller controls this [N/m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C_ctrl !< Controlled Damping (On/Off) [-] @@ -239,6 +241,7 @@ MODULE StrucCtrl_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CmdDamp !< StC damping from controller [N/(m/s)] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CmdBrake !< StC braking from controller [N/(m/s)] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CmdForce !< StC force from controller [N] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CmdMoment !< StC moment from controller [N-m] END TYPE StC_InputType ! ======================= ! ========= StC_OutputType ======= @@ -744,6 +747,18 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan end if DstCtrlChanInitInfoTypeData%InitForce = SrcCtrlChanInitInfoTypeData%InitForce end if + if (allocated(SrcCtrlChanInitInfoTypeData%InitMoment)) then + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMoment) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMoment) + if (.not. allocated(DstCtrlChanInitInfoTypeData%InitMoment)) then + allocate(DstCtrlChanInitInfoTypeData%InitMoment(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitMoment.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%InitMoment = SrcCtrlChanInitInfoTypeData%InitMoment + end if if (allocated(SrcCtrlChanInitInfoTypeData%InitMeasDisp)) then LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasDisp) UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMeasDisp) @@ -792,6 +807,9 @@ subroutine StC_DestroyCtrlChanInitInfoType(CtrlChanInitInfoTypeData, ErrStat, Er if (allocated(CtrlChanInitInfoTypeData%InitForce)) then deallocate(CtrlChanInitInfoTypeData%InitForce) end if + if (allocated(CtrlChanInitInfoTypeData%InitMoment)) then + deallocate(CtrlChanInitInfoTypeData%InitMoment) + end if if (allocated(CtrlChanInitInfoTypeData%InitMeasDisp)) then deallocate(CtrlChanInitInfoTypeData%InitMeasDisp) end if @@ -810,6 +828,7 @@ subroutine StC_PackCtrlChanInitInfoType(RF, Indata) call RegPackAlloc(RF, InData%InitDamp) call RegPackAlloc(RF, InData%InitBrake) call RegPackAlloc(RF, InData%InitForce) + call RegPackAlloc(RF, InData%InitMoment) call RegPackAlloc(RF, InData%InitMeasDisp) call RegPackAlloc(RF, InData%InitMeasVel) if (RegCheckErr(RF, RoutineName)) return @@ -828,6 +847,7 @@ subroutine StC_UnPackCtrlChanInitInfoType(RF, OutData) call RegUnpackAlloc(RF, OutData%InitDamp); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%InitBrake); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%InitForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitMoment); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%InitMeasDisp); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%InitMeasVel); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1095,6 +1115,18 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%F_ext = SrcMiscData%F_ext end if + if (allocated(SrcMiscData%M_ext)) then + LB(1:2) = lbound(SrcMiscData%M_ext) + UB(1:2) = ubound(SrcMiscData%M_ext) + if (.not. allocated(DstMiscData%M_ext)) then + allocate(DstMiscData%M_ext(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%M_ext.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%M_ext = SrcMiscData%M_ext + end if if (allocated(SrcMiscData%F_fr)) then LB(1:2) = lbound(SrcMiscData%F_fr) UB(1:2) = ubound(SrcMiscData%F_fr) @@ -1291,6 +1323,9 @@ subroutine StC_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%F_ext)) then deallocate(MiscData%F_ext) end if + if (allocated(MiscData%M_ext)) then + deallocate(MiscData%M_ext) + end if if (allocated(MiscData%F_fr)) then deallocate(MiscData%F_fr) end if @@ -1345,6 +1380,7 @@ subroutine StC_PackMisc(RF, Indata) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%F_stop) call RegPackAlloc(RF, InData%F_ext) + call RegPackAlloc(RF, InData%M_ext) call RegPackAlloc(RF, InData%F_fr) call RegPackAlloc(RF, InData%K) call RegPackAlloc(RF, InData%C_ctrl) @@ -1374,6 +1410,7 @@ subroutine StC_UnPackMisc(RF, OutData) if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%F_stop); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%F_ext); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M_ext); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%F_fr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%K); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%C_ctrl); if (RegCheckErr(RF, RoutineName)) return @@ -1704,6 +1741,18 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if DstInputData%CmdForce = SrcInputData%CmdForce end if + if (allocated(SrcInputData%CmdMoment)) then + LB(1:2) = lbound(SrcInputData%CmdMoment) + UB(1:2) = ubound(SrcInputData%CmdMoment) + if (.not. allocated(DstInputData%CmdMoment)) then + allocate(DstInputData%CmdMoment(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdMoment.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%CmdMoment = SrcInputData%CmdMoment + end if end subroutine subroutine StC_DestroyInput(InputData, ErrStat, ErrMsg) @@ -1738,6 +1787,9 @@ subroutine StC_DestroyInput(InputData, ErrStat, ErrMsg) if (allocated(InputData%CmdForce)) then deallocate(InputData%CmdForce) end if + if (allocated(InputData%CmdMoment)) then + deallocate(InputData%CmdMoment) + end if end subroutine subroutine StC_PackInput(RF, Indata) @@ -1760,6 +1812,7 @@ subroutine StC_PackInput(RF, Indata) call RegPackAlloc(RF, InData%CmdDamp) call RegPackAlloc(RF, InData%CmdBrake) call RegPackAlloc(RF, InData%CmdForce) + call RegPackAlloc(RF, InData%CmdMoment) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1789,6 +1842,7 @@ subroutine StC_UnPackInput(RF, OutData) call RegUnpackAlloc(RF, OutData%CmdDamp); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%CmdBrake); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%CmdForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CmdMoment); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine StC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -2038,6 +2092,9 @@ SUBROUTINE StC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg IF (ALLOCATED(u_out%CmdForce) .AND. ALLOCATED(u1%CmdForce)) THEN u_out%CmdForce = a1*u1%CmdForce + a2*u2%CmdForce END IF ! check if allocated + IF (ALLOCATED(u_out%CmdMoment) .AND. ALLOCATED(u1%CmdMoment)) THEN + u_out%CmdMoment = a1*u1%CmdMoment + a2*u2%CmdMoment + END IF ! check if allocated END SUBROUTINE SUBROUTINE StC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) @@ -2115,6 +2172,9 @@ SUBROUTINE StC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err IF (ALLOCATED(u_out%CmdForce) .AND. ALLOCATED(u1%CmdForce)) THEN u_out%CmdForce = a1*u1%CmdForce + a2*u2%CmdForce + a3*u3%CmdForce END IF ! check if allocated + IF (ALLOCATED(u_out%CmdMoment) .AND. ALLOCATED(u1%CmdMoment)) THEN + u_out%CmdMoment = a1*u1%CmdMoment + a2*u2%CmdMoment + a3*u3%CmdMoment + END IF ! check if allocated END SUBROUTINE subroutine StC_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) diff --git a/modules/turbsim/src/TSsubs.f90 b/modules/turbsim/src/TSsubs.f90 index f869387b6e..fd8753c5ab 100644 --- a/modules/turbsim/src/TSsubs.f90 +++ b/modules/turbsim/src/TSsubs.f90 @@ -39,20 +39,24 @@ MODULE TSSubs !! real array) of the simulated velocity (wind/water speed). It returns !! values FOR ONLY the velocity components that use the IEC method for !! computing spatial coherence; i.e., for i where SCMod(i) == CohMod_IEC -SUBROUTINE CalcFourierCoeffs_IEC( p, U, PhaseAngles, S, V, TRH, ErrStat, ErrMsg ) +!! +!! OpenMP: This makes a copy of the TRH array for each thread to use, which +!! is a little inefficient, but the speedup from parallelization +!! should outweigh the memory overhead. In the single threaded case, +!! a single copy is made, which is relatively negligible. +SUBROUTINE CalcFourierCoeffs_IEC( p, U, PhaseAngles, S, V, TRH_in, ErrStat, ErrMsg ) TYPE(TurbSim_ParameterType), INTENT(IN ) :: p !< TurbSim parameters REAL(ReKi), INTENT(IN) :: U (:) !< The steady u-component wind speeds for the grid (NPoints). REAL(ReKi), INTENT(IN) :: PhaseAngles (:,:,:) !< The array that holds the random phases [number of points, number of frequencies, number of wind components=3]. REAL(ReKi), INTENT(IN) :: S (:,:,:) !< The turbulence PSD array (NumFreq,NPoints,3). REAL(ReKi), INTENT(INOUT) :: V (:,:,:) !< An array containing the summations of the rows of H (NumSteps,NPoints,3). -REAL(ReKi), INTENT(INOUT) :: TRH (:) !< The transfer function matrix. just used as a work array +REAL(ReKi), INTENT(INOUT) :: TRH_in(:) !< The transfer function matrix. just used as a work array INTEGER(IntKi), INTENT(OUT) :: ErrStat CHARACTER(*), INTENT(OUT) :: ErrMsg - - ! Internal variables - +!$OMP THREADPRIVATE(TRH) +REAL(ReKi), allocatable, save :: TRH(:) ! Each OMP thread gets its own copy of this array REAL(ReKi), ALLOCATABLE :: Dist(:) ! The distance between points REAL(ReKi), ALLOCATABLE :: DistU(:) @@ -64,25 +68,22 @@ SUBROUTINE CalcFourierCoeffs_IEC( p, U, PhaseAngles, S, V, TRH, ErrStat, ErrMsg INTEGER(IntKi) :: ErrStat2 CHARACTER(MaxMsgLen) :: ErrMsg2 - - - + ErrStat = ErrID_None ErrMsg = "" - IF (.NOT. ANY(p%met%SCMod == CohMod_IEC) ) RETURN + IF (.NOT. ANY(p%met%SCMod == CohMod_IEC)) RETURN !-------------------------------------------------------------------------------- ! allocate arrays !-------------------------------------------------------------------------------- - CALL AllocAry( Dist, p%grid%NPacked, 'Dist coherence array', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs_IEC') - CALL AllocAry( DistU, p%grid%NPacked, 'DistU coherence array', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs_IEC') - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - + + CALL AllocAry( Dist, p%grid%NPacked, 'Dist coherence array', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs_IEC') + CALL AllocAry( DistU, p%grid%NPacked, 'DistU coherence array', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs_IEC') + IF (ErrStat >= AbortErrLev) RETURN + + TRH = TRH_in ! point the PRIVATE array to the passed in array for single thread case + !-------------------------------------------------------------------------------- ! Calculate the distances and other parameters that don't change with frequency !--------------------------------------------------------------------------------- @@ -115,7 +116,13 @@ SUBROUTINE CalcFourierCoeffs_IEC( p, U, PhaseAngles, S, V, TRH, ErrStat, ErrMsg ! Calculate the coherence, Veers' H matrix (CSDs), and the fourier coefficients !--------------------------------------------------------------------------------- - DO IFREQ = 1,p%grid%NumFreq + !$OMP PARALLEL DO & + !$OMP DEFAULT(None) & + !$OMP SHARED(p, PhaseAngles, S, V, Dist, DistU, IVec, ErrStat, ErrMsg, AbortErrLev) & + !$OMP PRIVATE(Indx, I, J, ErrStat2, ErrMsg2) & + !$OMP COPYIN(TRH) + DO IFREQ = 1, p%grid%NumFreq + ! ----------------------------------------------- ! Create the coherence matrix for this frequency ! ----------------------------------------------- @@ -149,27 +156,18 @@ SUBROUTINE CalcFourierCoeffs_IEC( p, U, PhaseAngles, S, V, TRH, ErrStat, ErrMsg ! use H matrix to calculate coefficients ! ----------------------------------------------- - CALL Coh2H( p, IVec, IFreq, TRH, S, ErrStat2, ErrMsg2 ) + CALL Coh2H(p, IVec, IFreq, TRH, S, ErrStat2, ErrMsg2) + if (ErrStat2 >= AbortErrLev) then + !$OMP CRITICAL CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs_IEC') - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - CALL H2Coeffs( IVec, IFreq, TRH, PhaseAngles, V, p%grid%NPoints ) - END DO !IFreq + !$OMP END CRITICAL + else + CALL H2Coeffs( IVec, IFreq, TRH, PhaseAngles, V, p%grid%NPoints ) + endif + END DO !IFreq END DO !IVec - CALL Cleanup() - RETURN - -!............................................ -CONTAINS - SUBROUTINE Cleanup() - - IF ( ALLOCATED( Dist ) ) DEALLOCATE( Dist ) - IF ( ALLOCATED( DistU ) ) DEALLOCATE( DistU ) - END SUBROUTINE Cleanup !............................................ END SUBROUTINE CalcFourierCoeffs_IEC !======================================================================= @@ -720,18 +718,17 @@ SUBROUTINE EyeCoh2H( IVec, IFreq, TRH, S, NPoints ) ! ----------------------------------------------------------------------------------- Indx = 1 + TRH = 0.0 DO J = 1,NPoints ! The column number ! The diagonal entries of the matrix: TRH(Indx) = SQRT( ABS( S(IFreq,J,IVec) ) ) - ! The off-diagonal values: - Indx = Indx + 1 - DO I = J+1,NPoints ! The row number - TRH(Indx) = 0.0 - Indx = Indx + 1 - ENDDO ! I + ! skip rest of row (NPoints-1) -- these are off diagonal elements that are zero. + ! Then add 1 to get to next diagonal entry + Indx = Indx + (NPoints - J) + 1 + ENDDO ! J END SUBROUTINE EyeCoh2H @@ -751,8 +748,9 @@ SUBROUTINE Coh2H( p, IVec, IFreq, TRH, S, ErrStat, ErrMsg ) integer :: Indx, J, I, NPts - +integer :: old_max_levels ! maximum nesting levels for OPENMP + ! ------------------------------------------------------------- ! Calculate the Cholesky factorization for the coherence matrix ! ------------------------------------------------------------- @@ -872,115 +870,81 @@ END SUBROUTINE H2Coeffs !> This routine takes the Fourier coefficients and converts them to velocity !! note that the resulting time series has zero mean. SUBROUTINE Coeffs2TimeSeries( V, NumSteps, NPoints, NUsrPoints, ErrStat, ErrMsg ) - - - !USE NWTC_FFTPACK - - IMPLICIT NONE - - - ! passed variables INTEGER(IntKi), INTENT(IN) :: NumSteps !< Size of dimension 1 of V (number of time steps) INTEGER(IntKi), INTENT(IN) :: NPoints !< Size of dimension 2 of V (number of grid points) INTEGER(IntKi), INTENT(IN) :: NUsrPoints !< number of user-defined time series - REAL(ReKi), INTENT(INOUT) :: V (NumSteps,NPoints,3) !< An array containing the summations of the rows of H (NumSteps,NPoints,3). - INTEGER(IntKi), intent( out) :: ErrStat !< Error level CHARACTER(*), intent( out) :: ErrMsg !< Message describing error - - ! local variables TYPE(FFT_DataType) :: FFT_Data ! data for applying FFT REAL(SiKi), ALLOCATABLE :: Work ( : ) ! working array to hold coefficients of fft !bjj: made it allocatable so it doesn't take stack space - - - INTEGER(IntKi) :: ITime ! loop counter for time step/frequency INTEGER(IntKi) :: IVec ! loop counter for velocity components INTEGER(IntKi) :: IPoint ! loop counter for grid points - + logical :: ExitOMPlooping ! flag to indicate skipping other loops INTEGER(IntKi) :: ErrStat2 ! Error level (local) - !CHARACTER(MaxMsgLen) :: ErrMsg2 ! Message describing error (local) - ! initialize variables - - !ErrStat = ErrID_None - !ErrMsg = "" - CALL AllocAry(Work, NumSteps, 'Work',ErrStat,ErrMsg) if (ErrStat >= AbortErrLev) return - ! Allocate the FFT working storage and initialize its variables - -CALL InitFFT( NumSteps, FFT_Data, ErrStat=ErrStat2 ) - CALL SetErrStat(ErrStat2, 'Error in InitFFT', ErrStat, ErrMsg, 'Coeffs2TimeSeries' ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - ! Get the stationary-point time series. -CALL WrScr ( ' Generating time series for all points:' ) + CALL WrScr ( ' Generating time series for all points:' ) -DO IVec=1,3 + ! Since we are potentially using OpenMP here, we cannot + ExitOMPlooping = .false. - CALL WrScr ( ' '//Comp(IVec)//'-component' ) + DO IVec=1,3 - DO IPoint=1,NPoints !NTotB + ! make sure we didn't have a failure on prior OMP loop + if (ExitOMPlooping) cycle - ! Overwrite the first point with zero. This sets the real (and - ! imaginary) part of the steady-state value to zero so that we - ! can add in the mean value later. + CALL WrScr ( ' '//Comp(IVec)//'-component' ) - Work(1) = 0.0_ReKi + ! The FFT_Data is not thread safe with the allocation inside. + CALL InitFFT( NumSteps, FFT_Data, ErrStat=ErrStat2 ) + CALL SetErrStat(ErrStat2, 'Error in InitFFT', ErrStat, ErrMsg, 'Coeffs2TimeSeries' ) -! DO ITime = 2,NumSteps-1 - DO ITime = 2,NumSteps - Work(ITime) = V(ITime-1, IPoint, IVec) - ENDDO ! ITime - - IF (iPoint > NUsrPoints) THEN - ! BJJ: we can't override this for the user-input spectra or we don't get the correct time series out. - ! Per JMJ, I will keep this here for the other points, but I personally think it could be skipped, too. + ! Proceed only if the InitFFT worked. + ! NOTE: this is to allow for OpenMP - can't return from inside loop + if (ErrStat2 < AbortErrLev) then ! check ErrStat2 for this OMPthread + DO IPoint=1,NPoints !NTotB + ! Overwrite the first point with zero. This sets the real (and + ! imaginary) part of the steady-state value to zero so that we + ! can add in the mean value later. + Work(1) = 0.0_ReKi + Work(2:NumSteps) = V(1:NumSteps-1, IPoint, IVec) - ! Now, let's add a complex zero to the end to set the power in the Nyquist - ! frequency to zero. + IF (iPoint > NUsrPoints) THEN + ! BJJ: we can't override this for the user-input spectra or we don't get the correct time series out. + ! Per JMJ, I will keep this here for the other points, but I personally think it could be skipped, too. + + ! Now, let's add a complex zero to the end to set the power in the Nyquist + ! frequency to zero. + Work(NumSteps) = 0.0 + END IF - Work(NumSteps) = 0.0 - END IF - + ! perform FFT + CALL ApplyFFT( Work, FFT_Data, ErrStat2 ) + IF (ErrStat2 /= ErrID_None ) THEN + CALL SetErrStat(ErrStat2, 'Error in ApplyFFT for point '//TRIM(Num2LStr(IPoint))//'.', ErrStat, ErrMsg, 'Coeffs2TimeSeries' ) + IF (ErrStat >= AbortErrLev) EXIT + END IF + + V(:,IPoint,IVec) = Work + ENDDO ! IPoint + ! Clean up memory from FFT_Data. + CALL ExitFFT( FFT_Data, ErrStat2 ) + CALL SetErrStat(ErrStat2, 'Error in ExitFFT', ErrStat, ErrMsg, 'Coeffs2TimeSeries' ) - ! perform FFT - - CALL ApplyFFT( Work, FFT_Data, ErrStat2 ) - IF (ErrStat2 /= ErrID_None ) THEN - CALL SetErrStat(ErrStat2, 'Error in ApplyFFT for point '//TRIM(Num2LStr(IPoint))//'.', ErrStat, ErrMsg, 'Coeffs2TimeSeries' ) - IF (ErrStat >= AbortErrLev) EXIT - END IF - - V(:,IPoint,IVec) = Work - - ENDDO ! IPoint - -ENDDO ! IVec - -CALL Cleanup() - -RETURN -CONTAINS -!........................................... -SUBROUTINE Cleanup() - - CALL ExitFFT( FFT_Data, ErrStat2 ) - CALL SetErrStat(ErrStat2, 'Error in ExitFFT', ErrStat, ErrMsg, 'Coeffs2TimeSeries' ) + ! skip further OMP loops if any sequential (or if OMP not used). + ! NOTE: OMP doesn't allow return inside OMP thread + if (ErrStat2 >= AbortErrLev) ExitOMPlooping = .true. + endif + ENDDO ! IVec - if (allocated(work)) deallocate(work) - - END SUBROUTINE Cleanup END SUBROUTINE Coeffs2TimeSeries !======================================================================= !> This routine calculates the two-sided Fourier amplitudes of the frequencies @@ -2030,28 +1994,28 @@ SUBROUTINE AddMeanAndRotate(p, V, U, HWindDir, VWindDir) REAL(ReKi) :: v3(3) ! temporary 3-component array containing velocity INTEGER(IntKi) :: ITime ! loop counter for time step INTEGER(IntKi) :: IPoint ! loop counter for grid points - - - - + !.............................................................................. - ! Add mean wind to u' components and rotate to inertial reference + ! Add mean wind to u' components and rotate to inertial reference ! frame coordinate system - !.............................................................................. + !.............................................................................. + + !$OMP PARALLEL DO & + !$OMP COLLAPSE(2) & + !$OMP DEFAULT(None) & + !$OMP PRIVATE(v3) & + !$OMP SHARED(p, U, V, HWindDir, VWindDir) DO IPoint=1,p%grid%Npoints DO ITime=1,p%grid%NumSteps - ! Add mean wind speed to the streamwise component and - ! Rotate the wind to the X-Y-Z (inertial) reference frame coordinates: - + ! Add mean wind speed to the streamwise component and + ! Rotate the wind to the X-Y-Z (inertial) reference frame coordinates: v3 = V(ITime,IPoint,:) CALL CalculateWindComponents( v3, U(IPoint), HWindDir(IPoint), VWindDir(IPoint), V(ITime,IPoint,:) ) ENDDO ! ITime - ENDDO ! IPoint - - + END SUBROUTINE AddMeanAndRotate !======================================================================= SUBROUTINE TS_ValidateInput(P, ErrStat, ErrMsg) diff --git a/modules/version/tests/VersionInfo_test_tools.F90 b/modules/version/tests/VersionInfo_test_tools.F90 index 30e67ae0f7..de6a95e11b 100644 --- a/modules/version/tests/VersionInfo_test_tools.F90 +++ b/modules/version/tests/VersionInfo_test_tools.F90 @@ -12,16 +12,14 @@ module versioninfo_test_tools character(11), parameter :: terminal="/dev/stdout" #endif -integer, parameter :: stdout=CU - contains subroutine hide_terminal_output() - open(unit=stdout, file=trim(nullfile)) + open(unit=CU, file=trim(nullfile)) end subroutine subroutine show_terminal_output() - open(unit=stdout, file=terminal, status="old") + open(unit=CU, file=terminal, status="old") end subroutine end module diff --git a/modules/wakedynamics/src/WakeDynamics.f90 b/modules/wakedynamics/src/WakeDynamics.f90 index b20190669e..8a9e0b4bd9 100644 --- a/modules/wakedynamics/src/WakeDynamics.f90 +++ b/modules/wakedynamics/src/WakeDynamics.f90 @@ -883,7 +883,7 @@ subroutine WD_UpdateStates( t, n, u, p, x, xd, z, OtherState, m, errStat, errMsg dx = 0.0_ReKi dy_HWkDfl = GetYawCorrection(xd%YawErr_filt(0), xd%xhat_plane(:,0), dx, p, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, errStat, errMsg, RoutineName) - if (errStat /= ErrID_None) then + if (errStat >= AbortErrLev) then ! TEST: E3 call Cleanup() return @@ -906,7 +906,13 @@ subroutine WD_UpdateStates( t, n, u, p, x, xd, z, OtherState, m, errStat, errMsg if (p%Mod_Wake == Mod_Wake_Polar) then ! Compute wake deficit of first plane based on rotor loading, outputs: Vx_Wake, m - call NearWakeCorrection( xd%Ct_azavg_filt, xd%Cq_azavg_filt, xd%Vx_rel_disk_filt, p, m, xd%Vx_wake(:,0), m%Vt_wake, xd%D_rotor_filt(0), errStat, errMsg ) + call NearWakeCorrection( xd%Ct_azavg_filt, xd%Cq_azavg_filt, xd%Vx_rel_disk_filt, p, m, xd%Vx_wake(:,0), m%Vt_wake, xd%D_rotor_filt(0), errStat2, errMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, errStat, errMsg, RoutineName) + if (errStat >= AbortErrLev) then + call Cleanup() + return + end if + m%Ct_avg = get_Ctavg(p%r, xd%Ct_azavg_filt, xd%D_rotor_filt(0)) else if (p%Mod_Wake == Mod_Wake_Cartesian .or. p%Mod_Wake == Mod_Wake_Curl) then @@ -917,7 +923,12 @@ subroutine WD_UpdateStates( t, n, u, p, x, xd, z, OtherState, m, errStat, errMsg ! --- Compute Vx ! Compute Vx(r) - call NearWakeCorrection( xd%Ct_azavg_filt, xd%Cq_azavg_filt, xd%Vx_rel_disk_filt, p, m, m%Vx_polar(:), m%Vt_wake, xd%D_rotor_filt(0), errStat, errMsg ) + call NearWakeCorrection( xd%Ct_azavg_filt, xd%Cq_azavg_filt, xd%Vx_rel_disk_filt, p, m, m%Vx_polar(:), m%Vt_wake, xd%D_rotor_filt(0), errStat2, errMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, errStat, errMsg, RoutineName) + if (errStat >= AbortErrLev) then + call Cleanup() + return + end if ! Convert to Cartesian call Axisymmetric2CartesianVx(m%Vx_polar, p%r, p%y, p%z, xd%Vx_wake2(:,:,0)) call FilterVx(xd%Vx_wake2(:,:,0), p%FilterInit) ! don't filter if FilterInit is 0 diff --git a/modules/wakedynamics/src/WakeDynamics_Registry.txt b/modules/wakedynamics/src/WakeDynamics_Registry.txt index 0116e82cb1..ef9d3e040c 100644 --- a/modules/wakedynamics/src/WakeDynamics_Registry.txt +++ b/modules/wakedynamics/src/WakeDynamics_Registry.txt @@ -55,7 +55,6 @@ typedef ^ WD_InputFileType ReKi k_vCurl - - typedef ^ WD_InputFileType Logical OutAllPlanes - - - "Output all planes" - # wake added turbulence (WAT) inputs typedef ^ WD_InputFileType Logical WAT - - - "Switch for turning on and off wake-added turbulence" - -#typedef ^ WD_InputFileType ReKi WAT_k_Def {5} - - "Calibrated parameters for the influence of the maximum wake deficit on wake-added turbulence (set of 5 parameters: k_Def , FMin, DMin, DMax, Exp) (-) [>=0.0, >=0.0 and <=1.0, >=0.0, >DMin, >0.0] or DEFAULT [DEFAULT=[0.6, 0.0, 0.0, 2.0, 1.0 ]]" - typedef ^ WD_InputFileType ReKi WAT_k_Def_k_c - - - "Calibrated parameter for the influence of the maximum wake deficit on wake-added turblence (-) [>=0] or DEFAULT [DEFAULT=0.6]" - typedef ^ WD_InputFileType ReKi WAT_k_Def_FMin - - - "Calibrated parameter in the eddy viscosity filter function for the WAT maximum wake deficit defining the value in the minimum region [>=0.0 and <=1.0] or DEFAULT [DEFAULT=0.0]" - typedef ^ WD_InputFileType ReKi WAT_k_Def_DMin - - - "Calibrated parameter in the eddy viscosity filter function for the WAT maximum wake deficit defining the transitional diameter fraction between the minimum and exponential regions [>=0.0] or DEFAULT [DEFAULT=0.0]" - @@ -183,7 +182,6 @@ typedef ^ ParameterType CHARACTER(1024) OutFileVTKDir - - - "The parent di typedef ^ ParameterType IntKi TurbNum - 0 - "Turbine ID number (start with 1; end with number of turbines)" - # wake added turbulence (WAT) parameters typedef ^ ParameterType Logical WAT - - - "Switch for turning on and off wake-added turbulence" - -#typedef ^ ParameterType ReKi WAT_k_Def {5} - - "Calibrated parameters for the influence of the maximum wake deficit on wake-added turbulence (set of 5 parameters: k_Def , FMin, DMin, DMax, Exp) (-) [>=0.0, >=0.0 and <=1.0, >=0.0, >DMin, >0.0] or DEFAULT [DEFAULT=[0.6, 0.0, 0.0, 2.0, 1.0 ]]" - typedef ^ ParameterType ReKi WAT_k_Def_k_c - - - "Calibrated parameter for the influence of the maximum wake deficit on wake-added turblence (-) [>=0] or DEFAULT [DEFAULT=0.6]" - typedef ^ ParameterType ReKi WAT_k_Def_FMin - - - "Calibrated parameter in the eddy viscosity filter function for the WAT maximum wake deficit defining the value in the minimum region [>=0.0 and <=1.0] or DEFAULT [DEFAULT=0.0]" - typedef ^ ParameterType ReKi WAT_k_Def_DMin - - - "Calibrated parameter in the eddy viscosity filter function for the WAT maximum wake deficit defining the transitional diameter fraction between the minimum and exponential regions [>=0.0] or DEFAULT [DEFAULT=0.0]" - diff --git a/openfast_io/README.md b/openfast_io/README.md index 4d1d77dfda..2d1849c858 100644 --- a/openfast_io/README.md +++ b/openfast_io/README.md @@ -38,7 +38,7 @@ These instructions are for interaction directly with the `openfast_io` source co ``` ### Extra options -[ROSCO](https://github.com/NREL/ROSCO) can be installed as an optional dependency. Run either +[ROSCO](https://github.com/NatLabRockies/ROSCO) can be installed as an optional dependency. Run either ```shell pip install openfast_io[rosco] ``` diff --git a/openfast_io/openfast_io/FAST_reader.py b/openfast_io/openfast_io/FAST_reader.py index a57d242425..7f28ce44b0 100644 --- a/openfast_io/openfast_io/FAST_reader.py +++ b/openfast_io/openfast_io/FAST_reader.py @@ -520,6 +520,7 @@ def read_ElastoDyn(self, ed_file): self.fst_vt['ElastoDyn']['TipMass(3)'] = float_read(f.readline().split()[0]) self.fst_vt['ElastoDyn']['HubMass'] = float_read(f.readline().split()[0]) self.fst_vt['ElastoDyn']['HubIner'] = float_read(f.readline().split()[0]) + self.fst_vt['ElastoDyn']['HubIner_Teeter'] = float_read(f.readline().split()[0]) self.fst_vt['ElastoDyn']['GenIner'] = float_read(f.readline().split()[0]) self.fst_vt['ElastoDyn']['NacMass'] = float_read(f.readline().split()[0]) self.fst_vt['ElastoDyn']['NacYIner'] = float_read(f.readline().split()[0]) @@ -1644,7 +1645,7 @@ def read_ServoDyn(self): for i in range(self.fst_vt['ServoDyn']['DLL_NumTrq']): data = f.readline().split() self.fst_vt['ServoDyn']['GenSpd_TLU'][i] = float_read(data[0]) - self.fst_vt['ServoDyn']['GenTrq_TLU'][i] = float_read(data[0]) + self.fst_vt['ServoDyn']['GenTrq_TLU'][i] = float_read(data[1]) # ServoDyn Output Params (sd_out_params) f.readline() @@ -3478,6 +3479,8 @@ def execute(self): if not os.path.isabs(self.fst_vt['ElastoDyn']['TwrFile']): ed_tower_file = os.path.join(os.path.dirname(ed_file), self.fst_vt['ElastoDyn']['TwrFile']) + else: + ed_tower_file = self.fst_vt['ElastoDyn']['TwrFile'] self.read_ElastoDynTower(ed_tower_file) if self.fst_vt['Fst']['CompInflow'] == 1: diff --git a/openfast_io/openfast_io/FAST_vars_out.py b/openfast_io/openfast_io/FAST_vars_out.py index ea11689d3b..fb551bdaaf 100644 --- a/openfast_io/openfast_io/FAST_vars_out.py +++ b/openfast_io/openfast_io/FAST_vars_out.py @@ -9585,27 +9585,9 @@ # Update the message in FAST_writer.write_MoorDyn() when this is finished MoorDyn = {} -MoorDyn['FairTen1'] = False # (); ; -MoorDyn['FairTen2'] = False # (); ; -MoorDyn['FairTen3'] = False # (); ; -MoorDyn['FairTen4'] = False # (); ; -MoorDyn['FairTen5'] = False # (); ; -MoorDyn['FairTen6'] = False # (); ; -MoorDyn['FairTen7'] = False # (); ; -MoorDyn['FairTen8'] = False # (); ; -MoorDyn['FairTen9'] = False # (); ; -MoorDyn['AnchTen1'] = False # (); ; -MoorDyn['AnchTen2'] = False # (); ; -MoorDyn['AnchTen3'] = False # (); ; -MoorDyn['AnchTen4'] = False # (); ; -MoorDyn['AnchTen5'] = False # (); ; -MoorDyn['AnchTen6'] = False # (); ; -MoorDyn['AnchTen7'] = False # (); ; -MoorDyn['AnchTen8'] = False # (); ; -MoorDyn['AnchTen9'] = False # (); ; - - - +for i in range(1, 31): + MoorDyn[f'FairTen{i}'] = False # (); ; + MoorDyn[f'AnchTen{i}'] = False # (); ; """ ExtPtfm """ diff --git a/openfast_io/openfast_io/FAST_writer.py b/openfast_io/openfast_io/FAST_writer.py index 088cea824e..f9c3cf6017 100644 --- a/openfast_io/openfast_io/FAST_writer.py +++ b/openfast_io/openfast_io/FAST_writer.py @@ -441,7 +441,8 @@ def write_ElastoDyn(self): f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['TipMass(2)'], 'TipMass(2)', '- Tip-brake mass, blade 2 (kg)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['TipMass(3)'], 'TipMass(3)', '- Tip-brake mass, blade 3 (kg) [unused for 2 blades]\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['HubMass'], 'HubMass', '- Hub mass (kg)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['HubIner'], 'HubIner', '- Hub inertia about rotor axis [3 blades] or teeter axis [2 blades] (kg m^2)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['HubIner'], 'HubIner', 'Hub inertia about rotor axis (2 or 3-blades) (kg m^2)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['HubIner_Teeter'], 'HubIner_Teeter', 'Hub inertia about teeter axis (2-blades) (kg m^2)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['GenIner'], 'GenIner', '- Generator inertia about HSS (kg m^2)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['NacMass'], 'NacMass', '- Nacelle mass (kg)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['NacYIner'], 'NacYIner', '- Nacelle inertia about yaw axis (kg m^2)\n')) @@ -822,6 +823,9 @@ def write_BeamDynBlade(self, bldInd = None): f.write('\n') f.write('\n') + f.flush() + os.fsync(f) + f.close() def write_InflowWind(self): self.fst_vt['Fst']['InflowFile'] = self.FAST_namingOut + '_InflowWind.dat' diff --git a/openfast_io/openfast_io/turbsim_util.py b/openfast_io/openfast_io/turbsim_util.py index 73e1c0cc31..a47dd3ab56 100644 --- a/openfast_io/openfast_io/turbsim_util.py +++ b/openfast_io/openfast_io/turbsim_util.py @@ -90,6 +90,8 @@ def read_input_file(self, input_file_name): self.CTLz = inpf.readline().split()[0] self.CTStartTime = inpf.readline().split()[0] + inpf.close() + class TurbsimWriter(object): diff --git a/openfast_io/pyproject.toml b/openfast_io/pyproject.toml index b942dade9f..460e3bf782 100644 --- a/openfast_io/pyproject.toml +++ b/openfast_io/pyproject.toml @@ -9,15 +9,15 @@ version = "4.1.2" description = "Readers and writers for OpenFAST files." license = {file = "../LICENSE"} authors = [ - {name = "Mayank Chetan", email = "mayank.chetan@nrel.gov" }, - {name = "Andy Platt", email = "andy.platt@nrel.gov" }, - {name = "Derek Slaughter", email = "derek.slaughter@nrel.gov" }, - { name = "NREL WISDEM Team", email = "systems.engineering@nrel.gov" }, + {name = "Mayank Chetan", email = "mayank.chetan@nlr.gov" }, + {name = "Andy Platt", email = "andy.platt@nlr.gov" }, + {name = "Derek Slaughter", email = "derek.slaughter@nlr.gov" }, + { name = "NLR WISDEM Team", email = "systems.engineering@nlr.gov" }, ] maintainers = [ - {name = "Mayank Chetan", email = "mayank.chetan@nrel.gov" }, - {name = "Andy Platt", email = "andy.platt@nrel.gov" }, - {name = "Derek Slaughter", email = "derek.slaughter@nrel.gov" }, + {name = "Mayank Chetan", email = "mayank.chetan@nlr.gov" }, + {name = "Andy Platt", email = "andy.platt@nlr.gov" }, + {name = "Derek Slaughter", email = "derek.slaughter@nlr.gov" }, ] readme = "README.md" requires-python = ">3.10" @@ -42,7 +42,11 @@ classifiers = [ # Optional "Programming Language :: Python :: 3.10", "Programming Language :: Python :: 3.11", "Programming Language :: Python :: 3.12", + "Programming Language :: Python :: 3.13", + "Programming Language :: Python :: 3.14", "Programming Language :: Python :: 3 :: Only", + "Programming Language :: Python :: 3", + "Programming Language :: Python", ] dependencies = [ @@ -63,8 +67,8 @@ Issues = "https://github.com/OpenFAST/openfast/issues" [project.optional-dependencies] rosco = ["rosco>2.9.2"] -xlrd = ["xlrd>2"] -all = ["rosco>2.9.2", "xlrd>2"] +xlrd = ["xlrd>2.0"] +all = ["rosco>2.9.2", "xlrd>2.0"] [tool.hatch.version] source = "vcs" diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index cf14d143f2..845038d9cf 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -250,6 +250,15 @@ function(seast_regression TESTNAME LABEL) regression(${TEST_SCRIPT} ${SEASTATE_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(seast_regression) +# py_seastate +function(py_seast_regression TESTNAME LABEL) + set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeSeaStatePyRegressionCase.py") + set(SEASTATE_EXECUTABLE "${Python_EXECUTABLE}") + set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") + set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/seastate") + regression(${TEST_SCRIPT} ${SEASTATE_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") +endfunction(py_seast_regression) + # moordyn function(md_regression TESTNAME LABEL) set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeMoordynRegressionCase.py") @@ -307,6 +316,15 @@ function(py_openfast_io_library_pytest TESTNAME LABEL) endfunction(py_openfast_io_library_pytest) +# py_wavetank +function(py_wavetank_regression TESTNAME LABEL) + set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeWavetankPyRegressionCase.py") + set(SEASTATE_EXECUTABLE "${Python_EXECUTABLE}") + set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") + set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/glue-codes/other") + regression(${TEST_SCRIPT} ${SEASTATE_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") +endfunction(py_wavetank_regression) + #=============================================================================== # Regression tests #=============================================================================== @@ -320,6 +338,8 @@ of_regression("AWT_WSt_StartUpShutDown" "openfast;elastodyn;aerod of_regression("AOC_WSt" "openfast;elastodyn;aerodyn;servodyn") of_regression("AOC_YFree_WTurb" "openfast;elastodyn;aerodyn;servodyn") of_regression("AOC_YFix_WSt" "openfast;elastodyn;aerodyn;servodyn") +of_regression("AOC_YFriction_Loading" "openfast;elastodyn;aerodyn;servodyn") +of_regression("AOC_YFriction_Stiffness" "openfast;elastodyn;aerodyn;servodyn") of_regression("UAE_Dnwind_YRamp_WSt" "openfast;elastodyn;aerodyn;servodyn") of_regression("UAE_Upwind_Rigid_WRamp_PwrCurve" "openfast;elastodyn;aerodyn;servodyn") of_regression("WP_VSP_WTurb_PitchFail" "openfast;elastodyn;aerodyn;servodyn") @@ -347,12 +367,15 @@ of_regression("StC_test_OC4Semi" "openfast;servodyn;hydrod of_regression("MHK_RM1_Fixed" "openfast;elastodyn;aerodyn;mhk;offshore") of_regression("MHK_RM1_Floating" "openfast;elastodyn;aerodyn;hydrodyn;moordyn;mhk;offshore") of_regression("MHK_RM1_Floating_wNacDrag" "openfast;elastodyn;aerodyn;hydrodyn;moordyn;mhk;offshore") +of_regression("MHK_RM1_Floating_Tank-scaled" "openfast;elastodyn;aerodyn;hydrodyn;moordyn;mhk;offshore;scaled") of_regression("Tailfin_FreeYaw1DOF_PolarBased" "openfast;elastodyn;aerodyn") of_regression("Tailfin_FreeYaw1DOF_Unsteady" "openfast;elastodyn;aerodyn") of_regression("5MW_Land_DLL_WTurb_ADsk" "openfast;elastodyn;aerodisk") of_regression("5MW_Land_DLL_WTurb_ADsk_SED" "openfast;simple-elastodyn;aerodisk") of_regression("5MW_Land_DLL_WTurb_SED" "openfast;simple-elastodyn;aerodyn") +of_regression("MinimalExample" "openfast;elastodyn") + of_aeromap_regression("5MW_Land_AeroMap" "aeromap;elastodyn;aerodyn") # OpenFAST C++ API test @@ -510,6 +533,7 @@ seast_regression("seastate_WaveMod7_WaveStMod1" "seastate") seast_regression("seastate_WaveMod7_WaveStMod2" "seastate") seast_regression("seastate_WaveMod7_WaveStMod3" "seastate") seast_regression("seastate_wavemod5" "seastate") # place at end since it reads outputs generated by seastate_wr_kin1 +py_seast_regression("py_seastate_1" "seastate;python") # MoorDyn regression tests md_regression("md_5MW_OC4Semi" "moordyn") @@ -540,3 +564,6 @@ adsk_regression("adsk_timeseries_shutdown" "aerodisk") # SimplifiedElastoDyn regression tests sed_regression("sed_test_HSSbrk" "simple-elastodyn") sed_regression("sed_test_freewheel" "simple-elastodyn") + +# Wavetank library interface (MD + SS + AD) +py_wavetank_regression("py_wavetank_test1" "wavetank;aerodyn;moordyn;seastate;python;scaled") diff --git a/reg_tests/executeSeaStatePyRegressionCase.py b/reg_tests/executeSeaStatePyRegressionCase.py new file mode 100644 index 0000000000..2d2f8b875e --- /dev/null +++ b/reg_tests/executeSeaStatePyRegressionCase.py @@ -0,0 +1,146 @@ +# +# Copyright 2017 National Renewable Energy Laboratory +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# + +""" + This program executes SeaSate through the python interface for a single test case. + The test data is contained in a git submodule, r-test, which must be initialized + prior to running. See the r-test README or OpenFAST documentation for more info. + + Get usage with: `executeSeaStatePyRegressionCase.py -h` +""" + +import os +import sys +basepath = os.path.dirname(os.path.abspath(__file__)) +sys.path.insert(0, os.path.sep.join([basepath, "lib"])) +import argparse +import numpy as np +import shutil +import glob +import subprocess +import rtestlib as rtl +import openfastDrivers +import pass_fail +from errorPlotting import exportCaseSummary + +##### Main program + +### Store the python executable for future python calls +pythonCommand = sys.executable + +### Verify input arguments +parser = argparse.ArgumentParser(description="Executes SeaState c-bindings library interface with a regression test for a single test case.") +parser.add_argument("caseName", metavar="Case-Name", type=str, nargs=1, help="The name of the test case.") +parser.add_argument("executable", metavar="SeaState-Python", type=str, nargs=1, help="The path to the InflowWind driver executable.") +parser.add_argument("sourceDirectory", metavar="path/to/openfast_repo", type=str, nargs=1, help="The path to the OpenFAST repository.") +parser.add_argument("buildDirectory", metavar="path/to/openfast_repo/build", type=str, nargs=1, help="The path to the OpenFAST repository build directory.") +parser.add_argument("rtol", metavar="Relative-Tolerance", type=float, nargs=1, help="Relative tolerance to allow the solution to deviate; expressed as order of magnitudes less than baseline.") +parser.add_argument("atol", metavar="Absolute-Tolerance", type=float, nargs=1, help="Absolute tolerance to allow small values to pass; expressed as order of magnitudes less than baseline.") +parser.add_argument("-p", "-plot", dest="plot", action='store_true', help="bool to include plots in failed cases") +parser.add_argument("-n", "-no-exec", dest="noExec", action='store_true', help="bool to prevent execution of the test cases") +parser.add_argument("-v", "-verbose", dest="verbose", action='store_true', help="bool to include verbose system output") + +args = parser.parse_args() + +caseName = args.caseName[0] +executable = args.executable[0] +sourceDirectory = args.sourceDirectory[0] +buildDirectory = args.buildDirectory[0] +rtol = args.rtol[0] +atol = args.atol[0] +plotError = args.plot if args.plot is False else True +noExec = args.noExec if args.noExec is False else True +verbose = args.verbose if args.verbose is False else True + +# validate inputs +rtl.validateExeOrExit(executable) +rtl.validateDirOrExit(sourceDirectory) +if not os.path.isdir(buildDirectory): + os.makedirs(buildDirectory, exist_ok=True) + +### Build the filesystem navigation variables for running the test case +regtests = os.path.join(sourceDirectory, "reg_tests") +lib = os.path.join(regtests, "lib") +rtest = os.path.join(regtests, "r-test") +moduleDirectory = os.path.join(rtest, "modules", "seastate") +inputsDirectory = os.path.join(moduleDirectory, caseName) +targetOutputDirectory = os.path.join(inputsDirectory) +testBuildDirectory = os.path.join(buildDirectory, caseName) + +# verify all the required directories exist +if not os.path.isdir(rtest): + rtl.exitWithError("The test data directory, {}, does not exist. If you haven't already, run `git submodule update --init --recursive`".format(rtest)) +if not os.path.isdir(targetOutputDirectory): + rtl.exitWithError("The test data outputs directory, {}, does not exist. Try running `git submodule update`".format(targetOutputDirectory)) +if not os.path.isdir(inputsDirectory): + rtl.exitWithError("The test data inputs directory, {}, does not exist. Verify your local repository is up to date.".format(inputsDirectory)) + +# create the local output directory if it does not already exist +# and initialize it with input files for all test cases +if not os.path.isdir(testBuildDirectory): + os.makedirs(testBuildDirectory) + for file in glob.glob(os.path.join(inputsDirectory,"*py")): + filename = file.split(os.path.sep)[-1] + shutil.copy(os.path.join(inputsDirectory,filename), os.path.join(testBuildDirectory,filename)) + for file in glob.glob(os.path.join(inputsDirectory,"*inp")): + filename = file.split(os.path.sep)[-1] + shutil.copy(os.path.join(inputsDirectory,filename), os.path.join(testBuildDirectory,filename)) + for file in glob.glob(os.path.join(inputsDirectory,"*dat")): + filename = file.split(os.path.sep)[-1] + shutil.copy(os.path.join(inputsDirectory,filename), os.path.join(testBuildDirectory,filename)) + +### Run inflowwind on the test case +if not noExec: + caseInputFile = os.path.join(testBuildDirectory, "py_seastate_driver.py") + returnCode = openfastDrivers.runInflowwindDriverCase(caseInputFile, executable) + if returnCode != 0: + sys.exit(returnCode*10) + +### Build the filesystem navigation variables for running the regression test. +# the "Points.Results.dat" file is from calls to routines other than CalcOutput +localOutFile = os.path.join(testBuildDirectory, "Points.Results.dat") +baselineOutFile = os.path.join(targetOutputDirectory, "Points.Results.dat") +rtl.validateFileOrExit(localOutFile) +rtl.validateFileOrExit(baselineOutFile) + +testData, testInfo, _ = pass_fail.readFASTOut(localOutFile) +baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) + +passing_channels = pass_fail.passing_channels(testData.T, baselineData.T, rtol, atol) +passing_channels = passing_channels.T + +norms = pass_fail.calculateNorms(testData, baselineData) + +# export all case summaries +channel_names = testInfo["attribute_names"] +exportCaseSummary(testBuildDirectory, caseName, channel_names, passing_channels, norms) + +# passing case +if np.all(passing_channels): + sys.exit(0) + +# failing case +if plotError: + from errorPlotting import finalizePlotDirectory, plotOpenfastError + for channel in testInfo["attribute_names"]: + try: + plotOpenfastError(localOutFile, baselineOutFile, channel, rtol, atol) + except: + error = sys.exc_info()[1] + print("Error generating plots: {}".format(error)) + finalizePlotDirectory(localOutFile, testInfo["attribute_names"], caseName) + +sys.exit(1) diff --git a/reg_tests/executeWavetankPyRegressionCase.py b/reg_tests/executeWavetankPyRegressionCase.py new file mode 100644 index 0000000000..506702716f --- /dev/null +++ b/reg_tests/executeWavetankPyRegressionCase.py @@ -0,0 +1,149 @@ +# +# Copyright 2025 National Renewable Energy Laboratory +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# + +""" + This program executes the WaveTank library interface through python interface + for a single test case. The test data is contained in a git submodule, r-test, + which must be initialized prior to running. See the r-test README or OpenFAST + documentation for more info. + + Get usage with: `executeWavetankPyRegressionCase.py -h` +""" + +import os +import sys +basepath = os.path.dirname(os.path.abspath(__file__)) +sys.path.insert(0, os.path.sep.join([basepath, "lib"])) +import argparse +import numpy as np +import shutil +import glob +import subprocess +import rtestlib as rtl +import openfastDrivers +import pass_fail +from errorPlotting import exportCaseSummary + +##### Helper functions +excludeExt=['.out','.outb','.ech','.yaml','.sum','.log'] + +##### Main program + +### Store the python executable for future python calls +pythonCommand = sys.executable + +### Verify input arguments +parser = argparse.ArgumentParser(description="Executes wavetank c-bindings library interface with a regression test for a single test case.") +parser.add_argument("caseName", metavar="Case-Name", type=str, nargs=1, help="The name of the test case.") +parser.add_argument("executable", metavar="WaveTank-Python", type=str, nargs=1, help="The path to the wavetank python driver case.") +parser.add_argument("sourceDirectory", metavar="path/to/openfast_repo", type=str, nargs=1, help="The path to the OpenFAST repository.") +parser.add_argument("buildDirectory", metavar="path/to/openfast_repo/build", type=str, nargs=1, help="The path to the OpenFAST repository build directory.") +parser.add_argument("rtol", metavar="Relative-Tolerance", type=float, nargs=1, help="Relative tolerance to allow the solution to deviate; expressed as order of magnitudes less than baseline.") +parser.add_argument("atol", metavar="Absolute-Tolerance", type=float, nargs=1, help="Absolute tolerance to allow small values to pass; expressed as order of magnitudes less than baseline.") +parser.add_argument("-p", "-plot", dest="plot", action='store_true', help="bool to include plots in failed cases") +parser.add_argument("-n", "-no-exec", dest="noExec", action='store_true', help="bool to prevent execution of the test cases") +parser.add_argument("-v", "-verbose", dest="verbose", action='store_true', help="bool to include verbose system output") + +args = parser.parse_args() + +caseName = args.caseName[0] +executable = args.executable[0] +sourceDirectory = args.sourceDirectory[0] +buildDirectory = args.buildDirectory[0] +rtol = args.rtol[0] +atol = args.atol[0] +plotError = args.plot if args.plot is False else True +noExec = args.noExec if args.noExec is False else True +verbose = args.verbose if args.verbose is False else True + +# validate inputs +rtl.validateExeOrExit(executable) +rtl.validateDirOrExit(sourceDirectory) +if not os.path.isdir(buildDirectory): + os.makedirs(buildDirectory, exist_ok=True) + +### Build the filesystem navigation variables for running the test case +regtests = os.path.join(sourceDirectory, "reg_tests") +lib = os.path.join(regtests, "lib") +rtest = os.path.join(regtests, "r-test") +moduleDirectory = os.path.join(rtest, "glue-codes", "other") +inputsDirectory = os.path.join(moduleDirectory, caseName) +targetOutputDirectory = os.path.join(inputsDirectory) +testBuildDirectory = os.path.join(buildDirectory, caseName) + +dependsDir = os.path.join("..", "..", "openfast", "MHK_RM1_Floating_Tank-scaled") + +# verify all the required directories exist +if not os.path.isdir(rtest): + rtl.exitWithError("The test data directory, {}, does not exist. If you haven't already, run `git submodule update --init --recursive`".format(rtest)) +if not os.path.isdir(targetOutputDirectory): + rtl.exitWithError("The test data outputs directory, {}, does not exist. Try running `git submodule update`".format(targetOutputDirectory)) +if not os.path.isdir(inputsDirectory): + rtl.exitWithError("The test data inputs directory, {}, does not exist. Verify your local repository is up to date.".format(inputsDirectory)) + +# create the local output directory if it does not already exist +# and initialize it with input files for all test cases +if not os.path.isdir(testBuildDirectory): + rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt) + +# Dependency +src = os.path.join(inputsDirectory, dependsDir) +dst = os.path.join(testBuildDirectory, dependsDir) +if not os.path.isdir(dst): + rtl.copyTree(src, dst, excludeExt) + +### Run inflowwind on the test case +if not noExec: + caseInputFile = os.path.join(testBuildDirectory, "py_wavetank_driver.py") + returnCode = openfastDrivers.runInflowwindDriverCase(caseInputFile, executable) + if returnCode != 0: + sys.exit(returnCode*10) + +### Build the filesystem navigation variables for running the regression test. +# the "Points.Results.dat" file is from calls to routines other than CalcOutput +localOutFile = os.path.join(testBuildDirectory, "FRM1Q_Floating_tank_test.out") +baselineOutFile = os.path.join(targetOutputDirectory, "FRM1Q_Floating_tank_test.out") +rtl.validateFileOrExit(localOutFile) +rtl.validateFileOrExit(baselineOutFile) + +testData, testInfo, _ = pass_fail.readFASTOut(localOutFile) +baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) + +passing_channels = pass_fail.passing_channels(testData.T, baselineData.T, rtol, atol) +passing_channels = passing_channels.T + +norms = pass_fail.calculateNorms(testData, baselineData) + +# export all case summaries +channel_names = testInfo["attribute_names"] +exportCaseSummary(testBuildDirectory, caseName, channel_names, passing_channels, norms) + +# passing case +if np.all(passing_channels): + sys.exit(0) + +# failing case +if plotError: + from errorPlotting import finalizePlotDirectory, plotOpenfastError + for channel in testInfo["attribute_names"]: + try: + plotOpenfastError(localOutFile, baselineOutFile, channel, rtol, atol) + except: + error = sys.exc_info()[1] + print("Error generating plots: {}".format(error)) + finalizePlotDirectory(localOutFile, testInfo["attribute_names"], caseName) + +sys.exit(1) diff --git a/reg_tests/r-test b/reg_tests/r-test index 550fa3b925..95d38b57a7 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 550fa3b925fea2e304fb9c678573283ba99a4f8d +Subproject commit 95d38b57a763f4758885c17b01f564df2b588dbb diff --git a/requirements.txt b/requirements.txt index ad406e0555..1006eeb363 100644 --- a/requirements.txt +++ b/requirements.txt @@ -2,4 +2,5 @@ numpy vtk Bokeh>=2.4,!=3.0.0,!=3.0.1,!=3.0.2,!=3.0.3 -pytest \ No newline at end of file +pytest +nptdms diff --git a/vs-build/AeroDyn_Inflow_c_binding/AeroDyn_Inflow_c_binding.vfproj b/vs-build/AeroDyn_Inflow_c_binding/AeroDyn_Inflow_c_binding.vfproj index 6a80b4e660..27a4cdee72 100644 --- a/vs-build/AeroDyn_Inflow_c_binding/AeroDyn_Inflow_c_binding.vfproj +++ b/vs-build/AeroDyn_Inflow_c_binding/AeroDyn_Inflow_c_binding.vfproj @@ -5,7 +5,7 @@ - + @@ -15,7 +15,7 @@ - + @@ -25,7 +25,7 @@ - + @@ -35,7 +35,7 @@ - + @@ -45,7 +45,7 @@ - + @@ -55,7 +55,7 @@ - + @@ -75,7 +75,7 @@ - + @@ -85,7 +85,7 @@ - + @@ -95,7 +95,7 @@ - + @@ -105,7 +105,7 @@ - + @@ -115,7 +115,7 @@ - + @@ -144,6 +144,28 @@ + + + + + + + + + + + + + + + + + + + + + + @@ -1012,6 +1034,7 @@ + diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index e34ecf918e..f4cacd3b7c 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -1943,6 +1943,34 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -1968,6 +1996,7 @@ + diff --git a/vs-build/HydroDyn/HydroDynDriver.vfproj b/vs-build/HydroDyn/HydroDynDriver.vfproj index 6b4bd4fe78..1b60204924 100644 --- a/vs-build/HydroDyn/HydroDynDriver.vfproj +++ b/vs-build/HydroDyn/HydroDynDriver.vfproj @@ -290,6 +290,26 @@ + + + + + + + + + + + + + + + + + + + + @@ -308,7 +328,7 @@ - + @@ -317,6 +337,7 @@ + diff --git a/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj b/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj index 34780120da..801edf151e 100644 --- a/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj +++ b/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj @@ -5,7 +5,7 @@ - + @@ -15,7 +15,7 @@ - + @@ -25,7 +25,7 @@ - + @@ -35,7 +35,7 @@ - + @@ -45,7 +45,7 @@ - + @@ -55,7 +55,7 @@ - + @@ -65,7 +65,7 @@ - + @@ -75,7 +75,7 @@ - + @@ -224,7 +224,6 @@ - @@ -241,10 +240,19 @@ + + + + + + + + + - + @@ -253,11 +261,13 @@ + + diff --git a/vs-build/InflowWind_c_binding/InflowWind_c_binding.vfproj b/vs-build/InflowWind_c_binding/InflowWind_c_binding.vfproj index f1cd6a33de..192df54c69 100644 --- a/vs-build/InflowWind_c_binding/InflowWind_c_binding.vfproj +++ b/vs-build/InflowWind_c_binding/InflowWind_c_binding.vfproj @@ -5,7 +5,7 @@ - + @@ -15,7 +15,7 @@ - + @@ -25,7 +25,7 @@ - + @@ -35,7 +35,7 @@ - + @@ -45,7 +45,7 @@ - + @@ -55,7 +55,7 @@ - + @@ -65,7 +65,7 @@ - + @@ -75,7 +75,7 @@ - + @@ -219,6 +219,7 @@ + diff --git a/vs-build/MoorDyn/MoorDynDriver.vfproj b/vs-build/MoorDyn/MoorDynDriver.vfproj index 9f7ac9fdfc..9d936b59cc 100644 --- a/vs-build/MoorDyn/MoorDynDriver.vfproj +++ b/vs-build/MoorDyn/MoorDynDriver.vfproj @@ -109,6 +109,26 @@ + + + + + + + + + + + + + + + + + + + + @@ -123,13 +143,14 @@ - + + diff --git a/vs-build/MoorDyn_c_binding/MoorDyn_c_binding.vfproj b/vs-build/MoorDyn_c_binding/MoorDyn_c_binding.vfproj index f74ba72b6b..a9e9da955d 100644 --- a/vs-build/MoorDyn_c_binding/MoorDyn_c_binding.vfproj +++ b/vs-build/MoorDyn_c_binding/MoorDyn_c_binding.vfproj @@ -5,7 +5,7 @@ - + @@ -15,7 +15,7 @@ - + @@ -25,7 +25,7 @@ - + @@ -35,7 +35,7 @@ - + @@ -45,7 +45,7 @@ - + @@ -55,7 +55,7 @@ - + @@ -65,7 +65,7 @@ - + @@ -75,7 +75,7 @@ - + @@ -129,7 +129,7 @@ - + @@ -142,30 +142,14 @@ - - - - - - - - - - - - - - - + - + - + - - - - + + @@ -178,99 +162,28 @@ - - - - - + + - + - + - - - + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - + + diff --git a/vs-build/ReadMe.md b/vs-build/ReadMe.md index ecc933f7c2..fd53760a70 100644 --- a/vs-build/ReadMe.md +++ b/vs-build/ReadMe.md @@ -20,7 +20,7 @@ The following solution files are available for code development on Windows using - [SeaState driver](SeaState/SeaStateDriver.sln) Waves and currents - Other: - [Discon](Discon/Discon.sln) - This solution file contains all 3 controllers used in the OpenFAST r-test (with the NREL 5MW model). + This solution file contains all 3 controllers used in the OpenFAST r-test (with the historical NREL 5MW model). It also contains the controller used with the FAST.Farm super-controller. - [SC_DLL](SC_DLL.sln) This solution file builds a template supercontroller to be used with FAST.Farm. - [OpenFAST Registry](Registry/Registry.sln) diff --git a/vs-build/RunRegistry.bat b/vs-build/RunRegistry.bat index 838e54eae7..76558bfe37 100644 --- a/vs-build/RunRegistry.bat +++ b/vs-build/RunRegistry.bat @@ -71,6 +71,12 @@ SET Output_Loc=%CURR_LOC% %REGISTRY% "%CURR_LOC%\Registry_NWTC_Library_base.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap GOTO checkError +:GridInterp +SET CURR_LOC=%NWTC_Lib_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\GridInterp.txt " -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap +GOTO checkError + :MAP SET CURR_LOC=%MAP_Loc% SET Output_Loc=%CURR_LOC% @@ -186,6 +192,12 @@ SET Output_Loc=%CURR_LOC% %REGISTRY% "%CURR_LOC%\AeroDyn_Inflow_Registry.txt" -I "%NWTC_Lib_Loc%" -I %IfW_Loc% -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap GOTO checkError +:ADI_cbind +SET CURR_LOC=%AD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\AeroDyn_Inflow_C_Binding_Registry.txt" -I "%NWTC_Lib_Loc%" -I %IfW_Loc% -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap +GOTO checkError + :AFI SET CURR_LOC=%AD_Loc% diff --git a/vs-build/SeaState/SeaStateDriver.vfproj b/vs-build/SeaState/SeaStateDriver.vfproj index f0f29c7847..f7825846a6 100644 --- a/vs-build/SeaState/SeaStateDriver.vfproj +++ b/vs-build/SeaState/SeaStateDriver.vfproj @@ -86,6 +86,26 @@ + + + + + + + + + + + + + + + + + + + + @@ -107,6 +127,7 @@ + diff --git a/vs-build/SeaState_c_binding/SeaState_c_binding.vfproj b/vs-build/SeaState_c_binding/SeaState_c_binding.vfproj index 7ea7b9851b..817bff1514 100644 --- a/vs-build/SeaState_c_binding/SeaState_c_binding.vfproj +++ b/vs-build/SeaState_c_binding/SeaState_c_binding.vfproj @@ -88,7 +88,6 @@ - @@ -105,8 +104,41 @@ + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -117,6 +149,7 @@ +