diff --git a/OpenFAST/.gitattributes b/OpenFAST/.gitattributes deleted file mode 100644 index 096b1c29a..000000000 --- a/OpenFAST/.gitattributes +++ /dev/null @@ -1,6 +0,0 @@ -# add (semi-useful) version info to git archive -CreateGitVersion.bat ident export-subst - -# Declare files that will always have CRLF line endings on checkout. -*.bat text eol=crlf - diff --git a/OpenFAST/.github/ISSUE_TEMPLATE/bug_report.md b/OpenFAST/.github/ISSUE_TEMPLATE/bug_report.md deleted file mode 100644 index a9fd553b0..000000000 --- a/OpenFAST/.github/ISSUE_TEMPLATE/bug_report.md +++ /dev/null @@ -1,56 +0,0 @@ ---- -name: Bug report -about: Report a bug to help us improve -title: 'Bug report' -labels: "Type: Bug" ---- - -**Bug description** - - -**To Reproduce** - -Steps to reproduce the behavior: -1. Compile with '...' -2. Run '...' case with '...' settings -3. Open '...' output -4. See the error - -**Expected behavior** - - -**Screenshots, if applicable** - - -**OpenFAST Version** - - -``` -************************************************************************************************** - OpenFAST - - Copyright (C) National Renewable Energy Laboratory - Copyright (C) Envision Energy USA LTD - - This program is licensed under Apache License Version 2.0 and comes with ABSOLUTELY NO WARRANTY. - See the "LICENSE" file distributed with this software for details. - ************************************************************************************************** - - OpenFAST-v2.0.0 - Compile Info: - - Architecture: 64 bit - - Precision: double - - Date: Nov 27 2018 - - Time: 17:19:38 - Execution Info: - - Date: 11/29/2018 - - Time: 10:52:28-0700 -``` - -**System Information (please complete the following information):** - - OS: - - Compiler: - - Compiler settings: - -**Additional context** - \ No newline at end of file diff --git a/OpenFAST/.github/ISSUE_TEMPLATE/feature_request.md b/OpenFAST/.github/ISSUE_TEMPLATE/feature_request.md deleted file mode 100644 index b1a58ca9f..000000000 --- a/OpenFAST/.github/ISSUE_TEMPLATE/feature_request.md +++ /dev/null @@ -1,18 +0,0 @@ ---- -name: Feature request -about: Suggest an idea for this project -title: 'Feature request' -labels: 'Type: Enhancement' ---- - -**Is your feature request related to a problem? Please describe.** - - -**Describe the solution you'd like** - - -**Describe alternatives you've considered** - - -**Additional context** - diff --git a/OpenFAST/.github/PULL_REQUEST_TEMPLATE.md b/OpenFAST/.github/PULL_REQUEST_TEMPLATE.md deleted file mode 100644 index fd601a3d4..000000000 --- a/OpenFAST/.github/PULL_REQUEST_TEMPLATE.md +++ /dev/null @@ -1,18 +0,0 @@ - - - - -**Feature or improvement description** - - -**Related issue, if one exists** - - -**Impacted areas of the software** - - -**Additional supporting information** - - -**Test results, if applicable** - diff --git a/OpenFAST/.github/actions/tests-gluecode-openfast/action.yml b/OpenFAST/.github/actions/tests-gluecode-openfast/action.yml deleted file mode 100644 index e29549283..000000000 --- a/OpenFAST/.github/actions/tests-gluecode-openfast/action.yml +++ /dev/null @@ -1,21 +0,0 @@ -name: 'OpenFAST glue code tests' -description: 'Run tests focused on the OpenFAST glue code' -author: 'Rafael Mudafort https://github.com/rafmudaf' -runs: - using: 'composite' - steps: - - run: | - ctest -VV -L linear -E Ideal - ctest -VV -j8 -I 1,1,1,2,3,4,5,6,7,8,10,11,12,13,14,15,17,18,21,22,23,24,25,26,27,28,29 - working-directory: ${{runner.workspace}}/build - shell: bash - -# OpenFAST linearization tests -# Dont run these in parallel, copying the case files can fail in a race condition -# Exclude the Ideal_Beam test cases -# - They fail consistently in the Docker container when run on GitHub, -# but pass everywhere else including running the same Docker image locally - -# Subset of OpenFAST regression tests; do not run -# - 9, 16 because they're very sensitive -# - 19, 20 because they're too long diff --git a/OpenFAST/.github/actions/tests-module-aerodyn/action.yml b/OpenFAST/.github/actions/tests-module-aerodyn/action.yml deleted file mode 100644 index 14ed3a34d..000000000 --- a/OpenFAST/.github/actions/tests-module-aerodyn/action.yml +++ /dev/null @@ -1,25 +0,0 @@ -name: 'AeroDyn module tests' -description: 'Run tests specific to the AeroDyn module' -author: 'Rafael Mudafort https://github.com/rafmudaf' - - -inputs: - test-target: - description: 'Which tests to run: unit | regression | all' - default: 'all' - -runs: - using: "composite" - steps: - - run: | - - if [[ ${{ inputs.test-target }} == "unit" ]] || [[ ${{ inputs.test-target }} == "all" ]]; then - ctest -VV -R fvw_utest - fi - - if [[ ${{ inputs.test-target }} == "regression" ]] || [[ ${{ inputs.test-target }} == "all" ]]; then - ctest -VV -j7 -R ad_ - fi - - working-directory: ${{runner.workspace}}/build - shell: bash diff --git a/OpenFAST/.github/actions/tests-module-beamdyn/action.yml b/OpenFAST/.github/actions/tests-module-beamdyn/action.yml deleted file mode 100644 index 660a2de9f..000000000 --- a/OpenFAST/.github/actions/tests-module-beamdyn/action.yml +++ /dev/null @@ -1,24 +0,0 @@ -name: 'BeamDyn module tests' -description: 'Run tests specific to the BeamDyn module' -author: 'Rafael Mudafort https://github.com/rafmudaf' - -inputs: - test-target: - description: 'Which tests to run: unit | regression | all' - default: 'all' - -runs: - using: "composite" - steps: - - run: | - - if [[ ${{ inputs.test-target }} == "unit" ]] || [[ ${{ inputs.test-target }} == "all" ]]; then - ctest -VV -R beamdyn_utest - fi - - if [[ ${{ inputs.test-target }} == "regression" ]] || [[ ${{ inputs.test-target }} == "all" ]]; then - ctest -VV -j7 -R bd_ - fi - - working-directory: ${{runner.workspace}}/build - shell: bash diff --git a/OpenFAST/.github/actions/tests-module-hydrodyn/action.yml b/OpenFAST/.github/actions/tests-module-hydrodyn/action.yml deleted file mode 100644 index 4890c414f..000000000 --- a/OpenFAST/.github/actions/tests-module-hydrodyn/action.yml +++ /dev/null @@ -1,9 +0,0 @@ -name: 'HydroDyn module tests' -description: 'Run tests specific to the HydroDyn module' -author: 'Rafael Mudafort https://github.com/rafmudaf' -runs: - using: "composite" - steps: - - run: ctest -VV -j7 -R hd_ - working-directory: ${{runner.workspace}}/build - shell: bash diff --git a/OpenFAST/.github/actions/tests-module-inflowwind/action.yml b/OpenFAST/.github/actions/tests-module-inflowwind/action.yml deleted file mode 100644 index 4a204980a..000000000 --- a/OpenFAST/.github/actions/tests-module-inflowwind/action.yml +++ /dev/null @@ -1,9 +0,0 @@ -name: 'InflowWind module tests' -description: 'Run tests specific to the InflowWind module' -author: 'Rafael Mudafort https://github.com/rafmudaf' -runs: - using: "composite" - steps: - - run: ctest -VV -R inflowwind_utest - working-directory: ${{runner.workspace}}/build - shell: bash diff --git a/OpenFAST/.github/actions/tests-module-nwtclibrary/action.yml b/OpenFAST/.github/actions/tests-module-nwtclibrary/action.yml deleted file mode 100644 index a8d27e417..000000000 --- a/OpenFAST/.github/actions/tests-module-nwtclibrary/action.yml +++ /dev/null @@ -1,9 +0,0 @@ -name: 'NWTC Library module tests' -description: 'Run tests specific to the NWTC Library module' -author: 'Rafael Mudafort https://github.com/rafmudaf' -runs: - using: "composite" - steps: - - run: ctest -VV -R nwtc_library_utest - working-directory: ${{runner.workspace}}/build - shell: bash diff --git a/OpenFAST/.github/actions/tests-module-subdyn/action.yml b/OpenFAST/.github/actions/tests-module-subdyn/action.yml deleted file mode 100644 index 62d76630b..000000000 --- a/OpenFAST/.github/actions/tests-module-subdyn/action.yml +++ /dev/null @@ -1,9 +0,0 @@ -name: 'SubDyn module tests' -description: 'Run tests specific to the SubDyn module' -author: 'Rafael Mudafort https://github.com/rafmudaf' -runs: - using: "composite" - steps: - - run: ctest -VV -j7 -R SD_ - working-directory: ${{runner.workspace}}/build - shell: bash diff --git a/OpenFAST/.github/actions/utils/increment_conda_build.py b/OpenFAST/.github/actions/utils/increment_conda_build.py deleted file mode 100644 index 52266b752..000000000 --- a/OpenFAST/.github/actions/utils/increment_conda_build.py +++ /dev/null @@ -1,35 +0,0 @@ - -from shutil import copyfile - -# Open existing meta.yaml and another one -metayaml = open('meta.yaml') -outyaml = open('out.yaml', 'w') - -# Find the build number, increment it, and write to the new yaml -found = False -for line in metayaml: - if "number:" in line: - found = True - # For the line containing the build number, parse the number and increment - elements = [e.strip() for e in line.split(":")] - if not elements[1].isnumeric(): - raise ValueError("Build number is not parsable: {}".format(line)) - - old_build_number = int(elements[1]) - new_build_number = old_build_number + 1 - - # Write new build number to new yaml - outyaml.write(line.replace(str(old_build_number), str(new_build_number))) - else: - # Write all other lines to new yaml - outyaml.write(line) - -if not found: - raise Exception("Error incrementing the build number.") - -# Clean up -metayaml.close() -outyaml.close() - -# Replace original meta.yaml with the new one -copyfile('out.yaml', 'meta.yaml') diff --git a/OpenFAST/.github/workflows/automated-dev-tests.yml b/OpenFAST/.github/workflows/automated-dev-tests.yml deleted file mode 100644 index 96b479a91..000000000 --- a/OpenFAST/.github/workflows/automated-dev-tests.yml +++ /dev/null @@ -1,330 +0,0 @@ - -name: 'Development Pipeline' - -on: - push: - paths-ignore: - - 'docs/**' - - 'share/**' - - 'vs-build/**' - - pull_request: - types: [opened, synchronize, edited, reopened] #labeled, assigned] - paths-ignore: - - 'docs/**' - - 'share/**' - - 'vs-build/**' - -env: - FORTRAN_COMPILER: gfortran-10 - NUM_PROCS: 8 - -# runs-on: ${{ matrix.os }} -# strategy: -# matrix: -# os: [macOS-10.14, ubuntu-18.04] - -jobs: - regression-tests-release: - runs-on: ubuntu-20.04 - steps: - - name: Checkout - uses: actions/checkout@main - with: - submodules: recursive - - - name: Setup Python - uses: actions/setup-python@v2 - with: - python-version: '3.7' - - name: Install dependencies - run: | - python -m pip install --upgrade pip - pip install numpy Bokeh==1.4 - - - name: Setup Workspace - run: cmake -E make_directory ${{runner.workspace}}/build - - name: Configure Build - working-directory: ${{runner.workspace}}/build - run: | - cmake \ - -DCMAKE_INSTALL_PREFIX:PATH=${{runner.workspace}}/install \ - -DCMAKE_Fortran_COMPILER:STRING=${{env.FORTRAN_COMPILER}} \ - -DCMAKE_BUILD_TYPE:STRING=RelWithDebInfo \ - -DBUILD_TESTING:BOOL=ON \ - -DCTEST_PLOT_ERRORS:BOOL=ON \ - ${GITHUB_WORKSPACE} - - name: Build OpenFAST - # if: contains(github.event.head_commit.message, 'Action - Test All') || contains(github.event.pull_request.labels.*.name, 'Action - Test All') - working-directory: ${{runner.workspace}}/build - run: cmake --build . --target install -- -j ${{env.NUM_PROCS}} - - - name: Run AeroDyn tests - uses: ./.github/actions/tests-module-aerodyn - with: - test-target: regression - - name: Run BeamDyn tests - uses: ./.github/actions/tests-module-beamdyn - with: - test-target: regression - - name: Run HydroDyn tests - uses: ./.github/actions/tests-module-hydrodyn - - name: Run SubDyn tests - uses: ./.github/actions/tests-module-subdyn - - name: Run OpenFAST tests - # if: contains(github.event.head_commit.message, 'Action - Test All') || contains(github.event.pull_request.labels.*.name, 'Action - Test All') - uses: ./.github/actions/tests-gluecode-openfast - - - name: Failing test artifacts - uses: actions/upload-artifact@v2 - if: failure() - with: - name: regression-tests-release - path: | - ${{runner.workspace}}/build/reg_tests/modules - ${{runner.workspace}}/build/reg_tests/glue-codes/openfast - !${{runner.workspace}}/build/reg_tests/glue-codes/openfast/5MW_Baseline - !${{runner.workspace}}/build/reg_tests/glue-codes/openfast/AOC - !${{runner.workspace}}/build/reg_tests/glue-codes/openfast/AWT27 - !${{runner.workspace}}/build/reg_tests/glue-codes/openfast/SWRT - !${{runner.workspace}}/build/reg_tests/glue-codes/openfast/UAE_VI - !${{runner.workspace}}/build/reg_tests/glue-codes/openfast/WP_Baseline - - regression-tests-debug: - runs-on: ubuntu-20.04 - steps: - - name: Checkout - uses: actions/checkout@main - with: - submodules: recursive - - - name: Setup Python - uses: actions/setup-python@v2 - with: - python-version: '3.7' - - name: Install dependencies - run: | - python -m pip install --upgrade pip - pip install numpy Bokeh==1.4 - - - name: Setup Workspace - run: cmake -E make_directory ${{runner.workspace}}/build - - name: Configure Build - working-directory: ${{runner.workspace}}/build - run: | - cmake \ - -DCMAKE_INSTALL_PREFIX:PATH=${{runner.workspace}}/install \ - -DCMAKE_Fortran_COMPILER:STRING=${{env.FORTRAN_COMPILER}} \ - -DCMAKE_BUILD_TYPE:STRING=Debug \ - -DBUILD_TESTING:BOOL=ON \ - -DCTEST_PLOT_ERRORS:BOOL=ON \ - ${GITHUB_WORKSPACE} - - - name: Build OpenFAST - working-directory: ${{runner.workspace}}/build - run: | - cmake --build . --target aerodyn_driver -- -j ${{env.NUM_PROCS}} - cmake --build . --target beamdyn_driver -- -j ${{env.NUM_PROCS}} - cmake --build . --target hydrodyn_driver -- -j ${{env.NUM_PROCS}} - cmake --build . --target subdyn_driver -- -j ${{env.NUM_PROCS}} - - - name: Run AeroDyn tests - uses: ./.github/actions/tests-module-aerodyn - with: - test-target: regression - - name: Run BeamDyn tests - uses: ./.github/actions/tests-module-beamdyn - with: - test-target: regression - - name: Run HydroDyn tests - uses: ./.github/actions/tests-module-hydrodyn - - name: Run SubDyn tests - uses: ./.github/actions/tests-module-subdyn - - - name: Failing test artifacts - uses: actions/upload-artifact@v2 - if: failure() - with: - name: regression-tests-debug - path: | - ${{runner.workspace}}/build/reg_tests/modules - - fastfarm-regression-test: - runs-on: ubuntu-20.04 - steps: - - name: Checkout - uses: actions/checkout@main - with: - submodules: recursive - - - name: Setup Python - uses: actions/setup-python@v2 - with: - python-version: '3.7' - - name: Install dependencies - run: | - python -m pip install --upgrade pip - pip install numpy Bokeh==1.4 - - - name: Setup Workspace - run: cmake -E make_directory ${{runner.workspace}}/build - - name: Configure Build - working-directory: ${{runner.workspace}}/build - run: | - cmake \ - -DCMAKE_INSTALL_PREFIX:PATH=${{runner.workspace}}/install \ - -DCMAKE_Fortran_COMPILER:STRING=${{env.FORTRAN_COMPILER}} \ - -DOPENMP:BOOL=ON \ - -DBUILD_FASTFARM:BOOL=ON \ - -DCMAKE_BUILD_TYPE:STRING=RelWithDebInfo \ - -DBUILD_TESTING:BOOL=ON \ - -DCTEST_PLOT_ERRORS:BOOL=ON \ - ${GITHUB_WORKSPACE} - - name: Build FAST.Farm - # if: contains(github.event.head_commit.message, 'Action - Test All') || contains(github.event.pull_request.labels.*.name, 'Action - Test All') - working-directory: ${{runner.workspace}}/build - run: | - cmake --build . --target FAST.Farm -- -j ${{env.NUM_PROCS}} - cmake --build . --target regression_tests -- -j ${{env.NUM_PROCS}} - - - name: Run FAST.Farm tests - # if: contains(github.event.head_commit.message, 'Action - Test All') || contains(github.event.pull_request.labels.*.name, 'Action - Test All') - run: | - ctest -VV -L fastfarm -j ${{env.NUM_PROCS}} - working-directory: ${{runner.workspace}}/build - shell: bash - - - name: Failing test artifacts - uses: actions/upload-artifact@v2 - if: failure() - with: - name: test-results - path: | - ${{runner.workspace}}/build/reg_tests/glue-codes/fastfarm - - unit-test: - runs-on: ubuntu-20.04 - steps: - - name: Checkout - uses: actions/checkout@main - with: - submodules: recursive - - name: Setup - run: cmake -E make_directory ${{runner.workspace}}/build - - name: Configure - working-directory: ${{runner.workspace}}/build - run: | - cmake \ - -DCMAKE_INSTALL_PREFIX:PATH=${{runner.workspace}}/install \ - -DCMAKE_Fortran_COMPILER:STRING=${{env.FORTRAN_COMPILER}} \ - -DCMAKE_BUILD_TYPE:STRING=RelWithDebInfo \ - -DBUILD_TESTING:BOOL=ON \ - ${GITHUB_WORKSPACE} - - - name: Build unit tests - working-directory: ${{runner.workspace}}/build - run: cmake --build . --target unit_tests -- -j ${{env.NUM_PROCS}} - - - name: Run NWTC Library tests - uses: ./.github/actions/tests-module-nwtclibrary - - name: Run AeroDyn tests - uses: ./.github/actions/tests-module-aerodyn - with: - test-target: unit - - name: Run BeamDyn tests - uses: ./.github/actions/tests-module-beamdyn - with: - test-target: unit - - name: Run InflowWind tests - uses: ./.github/actions/tests-module-inflowwind - - compile-all-single-precision: - # Test if single precision compile completes. - # Compiles all targets excluding tests. - # Run with the OpenFAST registry generating the types files. - # Do not run the test suite. - - runs-on: ubuntu-20.04 - steps: - - name: Checkout - uses: actions/checkout@main - with: - submodules: recursive - - name: Setup - run: cmake -E make_directory ${{runner.workspace}}/build - - name: Configure - working-directory: ${{runner.workspace}}/build - run: | - cmake \ - -DCMAKE_INSTALL_PREFIX:PATH=${{runner.workspace}}/install \ - -DCMAKE_Fortran_COMPILER:STRING=${{env.FORTRAN_COMPILER}} \ - -DCMAKE_BUILD_TYPE:STRING=Debug \ - -DDOUBLE_PRECISION:BOOL=OFF \ - -DGENERATE_TYPES:BOOL=ON \ - ${GITHUB_WORKSPACE} - - name: Build all - working-directory: ${{runner.workspace}}/build - run: cmake --build . --target all -- -j ${{env.NUM_PROCS}} - - name: Test - working-directory: ${{runner.workspace}}/build - run: ./glue-codes/openfast/openfast -v - - interface-tests: - runs-on: ubuntu-20.04 - steps: - - name: Checkout - uses: actions/checkout@main - with: - submodules: recursive - - - name: Setup Python - uses: actions/setup-python@v2 - with: - python-version: '3.7' - - name: Install dependencies - run: | - python -m pip install --upgrade pip - pip install numpy Bokeh==1.4 - sudo apt-get update - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev - - - name: Setup Workspace - run: cmake -E make_directory ${{runner.workspace}}/build - - name: Configure Build - working-directory: ${{runner.workspace}}/build - run: | - cmake \ - -DCMAKE_INSTALL_PREFIX:PATH=${{runner.workspace}}/install \ - -DCMAKE_Fortran_COMPILER:STRING=${{env.FORTRAN_COMPILER}} \ - -DCMAKE_BUILD_TYPE:STRING=RelWithDebInfo \ - -DBUILD_OPENFAST_CPP_API:BOOL=ON \ - -DBUILD_SHARED_LIBS:BOOL=ON \ - -DBUILD_TESTING:BOOL=ON \ - -DCTEST_PLOT_ERRORS:BOOL=ON \ - ${GITHUB_WORKSPACE} - - name: Build OpenFAST Interfaces - # if: contains(github.event.head_commit.message, 'Action - Test All') || contains(github.event.pull_request.labels.*.name, 'Action - Test All') - working-directory: ${{runner.workspace}}/build - run: | - cmake --build . --target openfastlib -- -j ${{env.NUM_PROCS}} - cmake --build . --target openfastcpp -- -j ${{env.NUM_PROCS}} - cmake --build . --target regression_tests -- -j ${{env.NUM_PROCS}} - - - name: Run C++ API tests - working-directory: ${{runner.workspace}}/build - run: | - ctest -VV -L cpp - - - name: Run Python API tests - working-directory: ${{runner.workspace}}/build - run: | - ctest -VV -L python - - - name: Failing test artifacts - uses: actions/upload-artifact@v2 - if: failure() - with: - name: test-results - path: | - ${{runner.workspace}}/build/reg_tests/glue-codes/openfast-cpp - !${{runner.workspace}}/build/reg_tests/glue-codes/openfast-cpp/5MW_Baseline diff --git a/OpenFAST/.github/workflows/conda-deploy.yml b/OpenFAST/.github/workflows/conda-deploy.yml deleted file mode 100644 index 765636de6..000000000 --- a/OpenFAST/.github/workflows/conda-deploy.yml +++ /dev/null @@ -1,47 +0,0 @@ - -name: 'Conda Deployment Pipeline' - -on: - push: - paths-ignore: - - 'docs/**' - - 'share/**' - - 'vs-build/**' - branches: - - 'dev' - -jobs: - update-dev: - if: github.repository_owner == 'OpenFAST' - runs-on: ubuntu-20.04 - steps: - # - name: Echo path - # run: | - # echo ${{runner.workspace}} # /home/runner/work/openfast - # echo $GITHUB_WORKSPACE # /home/runner/work/openfast/openfast - - name: Checkout OpenFAST/dev - uses: actions/checkout@main - with: - path: ${{runner.workspace}}/openfast - ref: dev - - - name: Checkout openfast-feedstock - uses: actions/checkout@main - with: - repository: conda-forge/openfast-feedstock - token: ${{ secrets.ACTIONS_TOKEN }} - path: ./openfast-feedstock - ref: dev - - - name: Prep the meta.yaml - run: python ${{runner.workspace}}/openfast/.github/actions/utils/increment_conda_build.py - working-directory: ./openfast-feedstock/recipe - - - name: Push Project B - run: | - cd ./openfast-feedstock - git add recipe/meta.yaml - git config user.name github-actions - git config user.email github-actions@github.com - git commit -m "Increment build number for dev label" - git push diff --git a/OpenFAST/.gitignore b/OpenFAST/.gitignore deleted file mode 100644 index 3827d6e22..000000000 --- a/OpenFAST/.gitignore +++ /dev/null @@ -1,51 +0,0 @@ -# Compiled Object files -*.slo -*.lo -*.o -*.obj - -# Precompiled Headers -*.gch -*.pch - -# Compiled Dynamic libraries -*.so -*.dylib -*.dll - -# Fortran module files -*.mod -*.smod - -# Compiled Static libraries -*.lai -*.la -*.a -*.lib - -# Executables -*.exe -*.out -*.app -__pycache__/* -*.pyc - -# Build specific files -build*/ -_build*/ -install/ -vs-build/ - -# OS and IDE specific files -.DS_Store -.vscode -.atom -.fortls -# backup files -*.asv -~$*.xlsx - -# LaTeX compiling files -*.aux -*.nlo -*.log diff --git a/OpenFAST/.gitmodules b/OpenFAST/.gitmodules deleted file mode 100644 index 9650d9f06..000000000 --- a/OpenFAST/.gitmodules +++ /dev/null @@ -1,6 +0,0 @@ -[submodule "reg_tests/r-test"] - path = reg_tests/r-test - url = https://github.com/OpenFAST/r-test.git -[submodule "unit_tests/pfunit"] - path = unit_tests/pfunit - url = https://github.com/Goddard-Fortran-Ecosystem/pFUnit.git diff --git a/OpenFAST/.readthedocs.yml b/OpenFAST/.readthedocs.yml deleted file mode 100644 index 2a5338b5c..000000000 --- a/OpenFAST/.readthedocs.yml +++ /dev/null @@ -1,26 +0,0 @@ -# .readthedocs.yml -# Read the Docs configuration file -# See https://docs.readthedocs.io/en/stable/config-file/v2.html for details - -# Required -version: 2 - -formats: - - htmlzip - - pdf - # - epub - -python: - version: 3.7 - install: - - requirements: docs/requirements.txt - system_packages: true - -# select the docker image to use: stable | latest -build: - image: stable - -sphinx: - builder: html - configuration: docs/conf.py - fail_on_warning: true diff --git a/OpenFAST/CMakeLists.txt b/OpenFAST/CMakeLists.txt deleted file mode 100644 index 998caa12b..000000000 --- a/OpenFAST/CMakeLists.txt +++ /dev/null @@ -1,181 +0,0 @@ -# -# Copyright 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. -# - -cmake_minimum_required(VERSION 2.8.12) -project(OpenFAST CXX C Fortran) - -include(${CMAKE_SOURCE_DIR}/cmake/OpenfastCmakeUtils.cmake) -include(${CMAKE_SOURCE_DIR}/cmake/OpenfastFortranOptions.cmake) - -set(CMAKE_MODULE_PATH "${CMAKE_SOURCE_DIR}/cmake") - -# CMake Configuration variables -if (NOT CMAKE_BUILD_TYPE) - set(CMAKE_BUILD_TYPE "Release" CACHE STRING - "Choose the build type: Debug Release" FORCE) -endif (NOT CMAKE_BUILD_TYPE) - -option(GENERATE_TYPES "Use the openfast-regsitry to autogenerate types modules" off) -option(BUILD_SHARED_LIBS "Enable building shared libraries" off) -option(DOUBLE_PRECISION "Treat REAL as double precision" on) -option(USE_DLL_INTERFACE "Enable runtime loading of dynamic libraries" on) -option(FPE_TRAP_ENABLED "Enable FPE trap in compiler options" off) -option(ORCA_DLL_LOAD "Enable OrcaFlex Library Load" on) -option(BUILD_OPENFAST_CPP_API "Enable building OpenFAST - C++ API" off) -option(BUILD_FASTFARM "Enable building FAST.Farm" off) -option(OPENMP "Enable OpenMP support" off) -if(CMAKE_INSTALL_PREFIX_INITIALIZED_TO_DEFAULT) - # Configure the default install path to openfast/install - set(CMAKE_INSTALL_PREFIX "${CMAKE_SOURCE_DIR}/install" CACHE PATH "OpenFAST install directory" FORCE) -endif() -if(APPLE) - option(CMAKE_MACOSX_RPATH "Use RPATH runtime linking" on) -endif() - -# Precompiler/preprocessor flag configuration -# Do this before configuring modules so that the flags are included -option(BUILD_TESTING "Build the testing tree." OFF) -if(BUILD_TESTING) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DUNIT_TEST") -endif() -option(BUILD_OPENFAST_SIMULINK_API "Enable building OpenFAST for use with Simulink" off) -if(BUILD_OPENFAST_SIMULINK_API) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DCOMPILE_SIMULINK") -endif() - -# Setup Fortran Compiler options based on architecture/compiler -set_fast_fortran() - -if (USE_DLL_INTERFACE) - add_definitions(-DUSE_DLL_INTERFACE) -endif (USE_DLL_INTERFACE) - -if (FPE_TRAP_ENABLED) - add_definitions(-DFPE_TRAP_ENABLED) -endif (FPE_TRAP_ENABLED) - -# Setup dependencies -if (${CMAKE_Fortran_COMPILER_ID} MATCHES "^Intel") - find_package(MKL) -endif() -if (MKL_FOUND) - include_directories(${MKL_INCLUDE_DIRS}) - set(BLAS_LIBRARIES ${MKL_LIBRARIES}) - set(LAPACK_LIBRARIES ${MKL_LIBRARIES}) - set(CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES "ifport;ifcore;imf;svml;m;ipgo;intlc;c;irc_s;dl;c") -else() - find_package(BLAS REQUIRED) - find_package(LAPACK REQUIRED) -endif() - -# Set the RPATH after configuring the install prefix -include(${CMAKE_SOURCE_DIR}/cmake/set_rpath.cmake) - -######################################################################## -# Build rules for OpenFAST Registry -# -if(GENERATE_TYPES) - add_subdirectory(modules/openfast-registry) -endif() - -######################################################################## -# OpenFAST modules -# -set(OPENFAST_MODULES - nwtc-library - inflowwind - aerodyn - aerodyn14 - servodyn - elastodyn - beamdyn - subdyn - hydrodyn - orcaflex-interface - extptfm - openfoam - supercontroller - turbsim - openfast-library - version - feamooring - moordyn - icedyn - icefloe - map - wakedynamics - awae -) - -set(OPENFAST_REGISTRY_INCLUDES "" CACHE INTERNAL "Registry includes paths") -set_registry_includes("modules" ${OPENFAST_MODULES}) -# Fix non-standard path addition to OPENFAST_REGISTRY_INCLUDES in icefloe module -set(OPENFAST_REGISTRY_INCLUDES - ${OPENFAST_REGISTRY_INCLUDES} -I ${CMAKE_SOURCE_DIR}/modules/icefloe/src/interfaces/FAST/ - CACHE INTERNAL "Registry includes paths") - -foreach(IDIR IN ITEMS ${OPENFAST_MODULES}) - add_subdirectory("${CMAKE_SOURCE_DIR}/modules/${IDIR}") -endforeach(IDIR IN ITEMS ${OPENFAST_MODULES}) - -add_subdirectory(glue-codes) - -# Install fortran .mod files also to installation directory -install(CODE - "EXECUTE_PROCESS (COMMAND \"${CMAKE_COMMAND}\" -E copy_directory \"${CMAKE_Fortran_MODULE_DIRECTORY}\" \"${CMAKE_INSTALL_PREFIX}/include/openfast/\")") - -# Install the library dependency information -install(EXPORT OpenFASTLibraries - DESTINATION lib/cmake/OpenFAST - FILE OpenFASTLibraries.cmake) - -# Create OpenFAST config so that other codes can find OpenFAST -include(CMakePackageConfigHelpers) - -set(INCLUDE_INSTALL_DIR include/) -set(LIB_INSTALL_DIR lib/) -set(FTNMOD_INSTALL_DIR include/openfast/) -if (BUILD_OPENFAST_CPP_API) - set(OpenFAST_HAS_CXX_API TRUE) -else() - set(OpenFAST_HAS_CXX_API FALSE) -endif() - -configure_package_config_file( - cmake/OpenFASTConfig.cmake.in - ${CMAKE_CURRENT_BINARY_DIR}/OpenFASTConfig.cmake - INSTALL_DESTINATION lib/cmake/OpenFAST - PATH_VARS INCLUDE_INSTALL_DIR LIB_INSTALL_DIR FTNMOD_INSTALL_DIR) -install(FILES ${CMAKE_CURRENT_BINARY_DIR}/OpenFASTConfig.cmake - DESTINATION lib/cmake/OpenFAST) - -######################################################################## - -# Option configuration -if(BUILD_TESTING) - include(CTest) - - # regression tests - add_subdirectory(reg_tests) - - # unit tests - add_subdirectory(unit_tests) -endif() - -option(BUILD_DOCUMENTATION "Build documentation." OFF) -if(BUILD_DOCUMENTATION) - add_subdirectory(docs) -endif() diff --git a/OpenFAST/LICENSE b/OpenFAST/LICENSE deleted file mode 100644 index 8dada3eda..000000000 --- a/OpenFAST/LICENSE +++ /dev/null @@ -1,201 +0,0 @@ - Apache License - Version 2.0, January 2004 - http://www.apache.org/licenses/ - - TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION - - 1. Definitions. - - "License" shall mean the terms and conditions for use, reproduction, - and distribution as defined by Sections 1 through 9 of this document. - - "Licensor" shall mean the copyright owner or entity authorized by - the copyright owner that is granting the License. - - "Legal Entity" shall mean the union of the acting entity and all - other entities that control, are controlled by, or are under common - control with that entity. For the purposes of this definition, - "control" means (i) the power, direct or indirect, to cause the - direction or management of such entity, whether by contract or - otherwise, or (ii) ownership of fifty percent (50%) or more of the - outstanding shares, or (iii) beneficial ownership of such entity. - - "You" (or "Your") shall mean an individual or Legal Entity - exercising permissions granted by this License. - - "Source" form shall mean the preferred form for making modifications, - including but not limited to software source code, documentation - source, and configuration files. - - "Object" form shall mean any form resulting from mechanical - transformation or translation of a Source form, including but - not limited to compiled object code, generated documentation, - and conversions to other media types. - - "Work" shall mean the work of authorship, whether in Source or - Object form, made available under the License, as indicated by a - copyright notice that is included in or attached to the work - (an example is provided in the Appendix below). - - "Derivative Works" shall mean any work, whether in Source or Object - form, that is based on (or derived from) the Work and for which the - editorial revisions, annotations, elaborations, or other modifications - represent, as a whole, an original work of authorship. For the purposes - of this License, Derivative Works shall not include works that remain - separable from, or merely link (or bind by name) to the interfaces of, - the Work and Derivative Works thereof. - - "Contribution" shall mean any work of authorship, including - the original version of the Work and any modifications or additions - to that Work or Derivative Works thereof, that is intentionally - submitted to Licensor for inclusion in the Work by the copyright owner - or by an individual or Legal Entity authorized to submit on behalf of - the copyright owner. For the purposes of this definition, "submitted" - means any form of electronic, verbal, or written communication sent - to the Licensor or its representatives, including but not limited to - communication on electronic mailing lists, source code control systems, - and issue tracking systems that are managed by, or on behalf of, the - Licensor for the purpose of discussing and improving the Work, but - excluding communication that is conspicuously marked or otherwise - designated in writing by the copyright owner as "Not a Contribution." - - "Contributor" shall mean Licensor and any individual or Legal Entity - on behalf of whom a Contribution has been received by Licensor and - subsequently incorporated within the Work. - - 2. Grant of Copyright License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - copyright license to reproduce, prepare Derivative Works of, - publicly display, publicly perform, sublicense, and distribute the - Work and such Derivative Works in Source or Object form. - - 3. Grant of Patent License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - (except as stated in this section) patent license to make, have made, - use, offer to sell, sell, import, and otherwise transfer the Work, - where such license applies only to those patent claims licensable - by such Contributor that are necessarily infringed by their - Contribution(s) alone or by combination of their Contribution(s) - with the Work to which such Contribution(s) was submitted. If You - institute patent litigation against any entity (including a - cross-claim or counterclaim in a lawsuit) alleging that the Work - or a Contribution incorporated within the Work constitutes direct - or contributory patent infringement, then any patent licenses - granted to You under this License for that Work shall terminate - as of the date such litigation is filed. - - 4. Redistribution. You may reproduce and distribute copies of the - Work or Derivative Works thereof in any medium, with or without - modifications, and in Source or Object form, provided that You - meet the following conditions: - - (a) You must give any other recipients of the Work or - Derivative Works a copy of this License; and - - (b) You must cause any modified files to carry prominent notices - stating that You changed the files; and - - (c) You must retain, in the Source form of any Derivative Works - that You distribute, all copyright, patent, trademark, and - attribution notices from the Source form of the Work, - excluding those notices that do not pertain to any part of - the Derivative Works; and - - (d) If the Work includes a "NOTICE" text file as part of its - distribution, then any Derivative Works that You distribute must - include a readable copy of the attribution notices contained - within such NOTICE file, excluding those notices that do not - pertain to any part of the Derivative Works, in at least one - of the following places: within a NOTICE text file distributed - as part of the Derivative Works; within the Source form or - documentation, if provided along with the Derivative Works; or, - within a display generated by the Derivative Works, if and - wherever such third-party notices normally appear. The contents - of the NOTICE file are for informational purposes only and - do not modify the License. You may add Your own attribution - notices within Derivative Works that You distribute, alongside - or as an addendum to the NOTICE text from the Work, provided - that such additional attribution notices cannot be construed - as modifying the License. - - You may add Your own copyright statement to Your modifications and - may provide additional or different license terms and conditions - for use, reproduction, or distribution of Your modifications, or - for any such Derivative Works as a whole, provided Your use, - reproduction, and distribution of the Work otherwise complies with - the conditions stated in this License. - - 5. Submission of Contributions. Unless You explicitly state otherwise, - any Contribution intentionally submitted for inclusion in the Work - by You to the Licensor shall be under the terms and conditions of - this License, without any additional terms or conditions. - Notwithstanding the above, nothing herein shall supersede or modify - the terms of any separate license agreement you may have executed - with Licensor regarding such Contributions. - - 6. Trademarks. This License does not grant permission to use the trade - names, trademarks, service marks, or product names of the Licensor, - except as required for reasonable and customary use in describing the - origin of the Work and reproducing the content of the NOTICE file. - - 7. Disclaimer of Warranty. Unless required by applicable law or - agreed to in writing, Licensor provides the Work (and each - Contributor provides its Contributions) on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or - implied, including, without limitation, any warranties or conditions - of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A - PARTICULAR PURPOSE. You are solely responsible for determining the - appropriateness of using or redistributing the Work and assume any - risks associated with Your exercise of permissions under this License. - - 8. Limitation of Liability. In no event and under no legal theory, - whether in tort (including negligence), contract, or otherwise, - unless required by applicable law (such as deliberate and grossly - negligent acts) or agreed to in writing, shall any Contributor be - liable to You for damages, including any direct, indirect, special, - incidental, or consequential damages of any character arising as a - result of this License or out of the use or inability to use the - Work (including but not limited to damages for loss of goodwill, - work stoppage, computer failure or malfunction, or any and all - other commercial damages or losses), even if such Contributor - has been advised of the possibility of such damages. - - 9. Accepting Warranty or Additional Liability. While redistributing - the Work or Derivative Works thereof, You may choose to offer, - and charge a fee for, acceptance of support, warranty, indemnity, - or other liability obligations and/or rights consistent with this - License. However, in accepting such obligations, You may act only - on Your own behalf and on Your sole responsibility, not on behalf - of any other Contributor, and only if You agree to indemnify, - defend, and hold each Contributor harmless for any liability - incurred by, or claims asserted against, such Contributor by reason - of your accepting any such warranty or additional liability. - - END OF TERMS AND CONDITIONS - - APPENDIX: How to apply the Apache License to your work. - - To apply the Apache License to your work, attach the following - boilerplate notice, with the fields enclosed by brackets "{}" - replaced with your own identifying information. (Don't include - the brackets!) The text should be enclosed in the appropriate - comment syntax for the file format. We also recommend that a - file or class name and description of purpose be included on the - same "printed page" as the copyright notice for easier - identification within third-party archives. - - Copyright {yyyy} {name of copyright owner} - - 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. diff --git a/OpenFAST/README.rst b/OpenFAST/README.rst deleted file mode 100644 index b7a59eb67..000000000 --- a/OpenFAST/README.rst +++ /dev/null @@ -1,163 +0,0 @@ -OpenFAST -======== - -|actions| |nbsp| |rtfd| - -.. |actions| image:: https://github.com/openfast/openfast/workflows/OpenFAST%20Build%20and%20Test/badge.svg?branch=dev - :target: https://github.com/OpenFAST/openfast/actions?query=workflow%3A%22OpenFAST+Build+and+Test%22 - :alt: Build Status -.. |rtfd| image:: https://readthedocs.org/projects/openfast/badge/?version=dev - :target: https://openfast.readthedocs.io/en/dev - :alt: Documentation Status -.. |nbsp| unicode:: 0xA0 - :trim: - -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 -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 -`Help Wanted `_ -tag. - -**OpenFAST is under active development**. - -FAST v8 - OpenFAST ------------------- -The transition from FAST v8 to OpenFAST represents the effort to better -support an open-source developer community around FAST-based aero-hydro-servo- -elastic engineering models of wind-turbines and wind-plants. OpenFAST is the -next generation of FAST analysis tools. More information is available in the -`transition notes `_. - -FAST v8, now OpenFAST, is a physics-based engineering tool for simulating the coupled dynamic -response of wind turbines. OpenFAST joins aerodynamics models, hydrodynamics models -for offshore structures, control and electrical system (servo) dynamics models, -and structural (elastic) dynamics models to enable coupled nonlinear aero- -hydro-servo-elastic simulation in the time domain. The OpenFAST tool enables the -analysis of a range of wind turbine configurations, including two- or -three-blade horizontal-axis rotor, pitch or stall regulation, rigid or -teetering hub, upwind or downwind rotor, and lattice or tubular tower. The wind -turbine can be modeled on land or offshore on fixed-bottom or floating -substructures. OpenFAST is based on advanced engineering models derived from -fundamental laws, but with appropriate simplifications and assumptions, and -supplemented where applicable with computational solutions and test data. - -With OpenFAST, you can run large numbers of nonlinear time-domain simulations -in approximately real time to enable standards-based loads analysis for predicting -wind system ultimate and fatigue loads. You can also linearize the underlying -nonlinear model about an operating point to understand the system response -and enable the calculation of natural frequencies, damping, and mode shapes; -the design of controllers, and analysis of aero-elastic instabilities. - -The aerodynamic models use wind-inflow data and solve for the rotor-wake -effects and blade-element aerodynamic loads, including dynamic stall. The -hydrodynamics models simulate the regular or irregular incident waves and -currents and solve for the hydrostatic, radiation, diffraction, and viscous -loads on the offshore substructure. The control and electrical system models -simulate the controller logic, sensors, and actuators of the blade-pitch, -generator-torque, nacelle-yaw, and other control devices, as well as the -generator and power-converter components of the electrical drive. The -structural-dynamics models apply the control and electrical system -reactions, apply the aerodynamic and hydrodynamic loads, adds gravitational -loads, and simulate the elasticity of the rotor, drivetrain, and support -structure. Coupling between all models is achieved through a modular -interface and coupler (glue code). - -FAST.Farm extends the capabilities of OpenFAST to provide physics-based -engineering simulation of multi-turbine land-based, fixed-bottom offshore, -and floating offshore wind farms. With FAST.Farm, you can simulate each wind -turbine in the farm with an OpenFAST model and capture the relevant -physics for prediction of wind farm power performance and structural loads, -including wind farm-wide ambient wind, super controller, and wake advection, -meandering, and merging. FAST.Farm maintains computational efficiency -through parallelization to enable loads analysis for predicting the ultimate -and fatigue loads of each wind turbine in the farm. - - -Documentation -------------- -The full documentation is available at http://openfast.readthedocs.io/. - -This documentation is stored and maintained alongside the source code. -It is compiled into HTML with Sphinx and is tied to a particular version -of OpenFAST. `Readthedocs `_ hosts the following -versions of the documentation: - -* ``latest`` - The latest commit on the ``master`` branch -* ``stable`` - Corresponds to the last tagged release -* ``dev`` - The latest commit on the ``dev`` branch - -These can be toggled with the ``v: latest`` button in the lower left corner of -the docs site. - -Obtaining OpenFAST and FAST.Farm --------------------------------- -OpenFAST and FAST.Farm are hosted entirely on GitHub so you are in the -`right place `_! -The repository is structured with two branches following the -"git-flow" convention: - -* ``main`` -* ``dev`` - -The ``main`` branch is stable, well tested, and represents the most up to -date released versions of OpenFAST and FAST.Farm. The latest commit on ``main`` -contains a tag with version info and brief release notes. The tag history can be -obtained with the ``git tag`` command and viewed in more detail on -`GitHub Releases `_. For general -use, the ``main`` branch is highly recommended. - -The ``dev`` branch is generally stable and tested, but not static. It contains -new features, bug fixes, and documentation updates that have not been compiled -into a production release. Before proceeding with new development, it is -recommended to explore the ``dev`` branch. This branch is updated regularly -through pull requests, so be sure to ``git fetch`` often and check -`outstanding pull requests `_. - -For those not familiar with git and GitHub, there are many resources: - -* https://guides.github.com -* https://try.github.io -* https://help.github.com/categories/bootcamp/ -* https://desktop.github.com/ -* http://nvie.com/posts/a-successful-git-branching-model/ - -Compilation, Usage, and Development ------------------------------------ -Details for compiling -`compiling `_, -`using `_, and -`developing `_ -OpenFAST and FAST.Farm on Unix-based and Windows machines are available at -`readthedocs `_. - -Help ----- -Please use `GitHub Issues `_ to: - -* ask usage questions -* report bugs -* request code enhancements - -Users and developers may also be interested in the NREL National Wind -Technology Center (NWTC) `phpBB Forum `_, -which is still maintained and has a long history of FAST-related questions -and answers. - -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 -organizations: - -* Envision Energy USA, Ltd -* Brigham Young University -* The University of Massachusetts -* `Intel® Parallel Computing Center (IPCC) `_ diff --git a/OpenFAST/cmake/FindMKL.cmake b/OpenFAST/cmake/FindMKL.cmake deleted file mode 100644 index d2dfb9ebb..000000000 --- a/OpenFAST/cmake/FindMKL.cmake +++ /dev/null @@ -1,68 +0,0 @@ -# -# Copyright 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. -# - -# find_path(MKL_INCLUDE_DIRS -# mkl.h -# HINTS $ENV{MKLROOT} -# PATH_SUFFIXES include) - -# infer the architecture build type -# https://cmake.org/cmake/help/v3.0/variable/CMAKE_SIZEOF_VOID_P.html -if("${CMAKE_SIZEOF_VOID_P}" STREQUAL "4") - set(ARCHDIR "ia32") - set(WINDOWS_INTERFACE "_c_") - set(UNIX_INTERFACE "") -elseif("${CMAKE_SIZEOF_VOID_P}" STREQUAL "8") - set(ARCHDIR "intel64") - set(WINDOWS_INTERFACE "_lp64_") - set(UNIX_INTERFACE "_lp64") -endif() - -set(MKLSEARCHPATHS - $ENV{MKLROOT}/lib/${ARCHDIR}_win - $ENV{MKLROOT}/lib/${ARCHDIR} - $ENV{MKLROOT}/lib -) - -# using mkl_intel_c on windows since that is the default for intel compilers -# https://software.intel.com/en-us/mkl-windows-developer-guide-using-the-cdecl-and-stdcall-interfaces -find_library(MKL_IFACE_LIB - NAMES mkl_intel${UNIX_INTERFACE} libmkl_intel${UNIX_INTERFACE} mkl_intel${WINDOWS_INTERFACE}dll - PATHS ${MKLSEARCHPATHS} - NO_DEFAULT_PATH) - -find_library(MKL_SEQ_LIB - NAMES mkl_sequential libmkl_sequential mkl_sequential_dll - PATHS ${MKLSEARCHPATHS} - NO_DEFAULT_PATH) - -find_library(MKL_CORE_LIB - NAMES mkl_core libmkl_core mkl_core_dll - PATHS ${MKLSEARCHPATHS} - NO_DEFAULT_PATH) - -if (MKL_IFACE_LIB AND MKL_SEQ_LIB AND MKL_CORE_LIB) - set(MKL_LIBRARIES ${MKL_IFACE_LIB} ${MKL_SEQ_LIB} ${MKL_CORE_LIB}) -else() - set(MKL_LIBRARIES "") - set(MKL_INCLUDE_DIRS "") -endif() - -include(FindPackageHandleStandardArgs) -find_package_handle_standard_args(MKL DEFAULT_MSG - MKL_LIBRARIES MKL_IFACE_LIB MKL_SEQ_LIB MKL_CORE_LIB) # MKL_INCLUDE_DIRS) -mark_as_advanced( - MKL_INCLUDE_DIRS MKL_LIBRARIES MKL_IFACE_LIB MKL_SEQ_LIB MKL_CORE_LIB) diff --git a/OpenFAST/cmake/FindMatlab.cmake b/OpenFAST/cmake/FindMatlab.cmake deleted file mode 100644 index c50878ef5..000000000 --- a/OpenFAST/cmake/FindMatlab.cmake +++ /dev/null @@ -1,1720 +0,0 @@ -# Distributed under the OSI-approved BSD 3-Clause License. See accompanying -# file Copyright.txt or https://cmake.org/licensing for details. - -#.rst: -# FindMatlab -# ---------- -# -# Finds Matlab or Matlab Compiler Runtime (MCR) and provides Matlab tools, -# libraries and compilers to CMake. -# -# This package primary purpose is to find the libraries associated with Matlab -# or the MCR in order to be able to build Matlab extensions (mex files). It -# can also be used: -# -# * to run specific commands in Matlab in case Matlab is available -# * for declaring Matlab unit test -# * to retrieve various information from Matlab (mex extensions, versions and -# release queries, ...) -# -# The module supports the following components: -# -# * ``MX_LIBRARY``, ``ENG_LIBRARY`` and ``MAT_LIBRARY``: respectively the ``MX``, -# ``ENG`` and ``MAT`` libraries of Matlab -# * ``MAIN_PROGRAM`` the Matlab binary program. Note that this component is not -# available on the MCR version, and will yield an error if the MCR is found -# instead of the regular Matlab installation. -# * ``MEX_COMPILER`` the MEX compiler. -# * ``MCC_COMPILER`` the MCC compiler, included with the Matlab Compiler add-on. -# * ``SIMULINK`` the Simulink environment. -# -# .. note:: -# -# The version given to the :command:`find_package` directive is the Matlab -# **version**, which should not be confused with the Matlab *release* name -# (eg. `R2014`). -# The :command:`matlab_get_version_from_release_name` and -# :command:`matlab_get_release_name_from_version` provide a mapping -# between the release name and the version. -# -# The variable :variable:`Matlab_ROOT_DIR` may be specified in order to give -# the path of the desired Matlab version. Otherwise, the behaviour is platform -# specific: -# -# * Windows: The installed versions of Matlab/MCR are retrieved from the -# Windows registry -# * OS X: The installed versions of Matlab/MCR are given by the MATLAB -# default installation paths in ``/Application``. If no such application is -# found, it falls back to the one that might be accessible from the ``PATH``. -# * Unix: The desired Matlab should be accessible from the ``PATH``. This does -# not work for MCR installation and :variable:`Matlab_ROOT_DIR` should be -# specified on this platform. -# -# Additional information is provided when :variable:`MATLAB_FIND_DEBUG` is set. -# When a Matlab/MCR installation is found automatically and the ``MATLAB_VERSION`` -# is not given, the version is queried from Matlab directly (on Windows this -# may pop up a Matlab window) or from the MCR installation. -# -# The mapping of the release names and the version of Matlab is performed by -# defining pairs (name, version). The variable -# :variable:`MATLAB_ADDITIONAL_VERSIONS` may be provided before the call to -# the :command:`find_package` in order to handle additional versions. -# -# A Matlab scripts can be added to the set of tests using the -# :command:`matlab_add_unit_test`. By default, the Matlab unit test framework -# will be used (>= 2013a) to run this script, but regular ``.m`` files -# returning an exit code can be used as well (0 indicating a success). -# -# Module Input Variables -# ^^^^^^^^^^^^^^^^^^^^^^ -# -# Users or projects may set the following variables to configure the module -# behaviour: -# -# :variable:`Matlab_ROOT_DIR` -# the root of the Matlab installation. -# :variable:`MATLAB_FIND_DEBUG` -# outputs debug information -# :variable:`MATLAB_ADDITIONAL_VERSIONS` -# additional versions of Matlab for the automatic retrieval of the installed -# versions. -# -# Variables defined by the module -# ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -# -# Result variables -# """""""""""""""" -# -# ``Matlab_FOUND`` -# ``TRUE`` if the Matlab installation is found, ``FALSE`` -# otherwise. All variable below are defined if Matlab is found. -# ``Matlab_ROOT_DIR`` -# the final root of the Matlab installation determined by the FindMatlab -# module. -# ``Matlab_MAIN_PROGRAM`` -# the Matlab binary program. Available only if the component ``MAIN_PROGRAM`` -# is given in the :command:`find_package` directive. -# ``Matlab_INCLUDE_DIRS`` -# the path of the Matlab libraries headers -# ``Matlab_MEX_LIBRARY`` -# library for mex, always available. -# ``Matlab_MX_LIBRARY`` -# mx library of Matlab (arrays). Available only if the component -# ``MX_LIBRARY`` has been requested. -# ``Matlab_ENG_LIBRARY`` -# Matlab engine library. Available only if the component ``ENG_LIBRARY`` -# is requested. -# ``Matlab_MAT_LIBRARY`` -# Matlab matrix library. Available only if the component ``MAT_LIBRARY`` -# is requested. -# ``Matlab_LIBRARIES`` -# the whole set of libraries of Matlab -# ``Matlab_MEX_COMPILER`` -# the mex compiler of Matlab. Currently not used. -# Available only if the component ``MEX_COMPILER`` is requested. -# ``Matlab_MCC_COMPILER`` -# the mcc compiler of Matlab. Included with the Matlab Compiler add-on. -# Available only if the component ``MCC_COMPILER`` is requested. -# -# Cached variables -# """""""""""""""" -# -# ``Matlab_MEX_EXTENSION`` -# the extension of the mex files for the current platform (given by Matlab). -# ``Matlab_ROOT_DIR`` -# the location of the root of the Matlab installation found. If this value -# is changed by the user, the result variables are recomputed. -# -# Provided macros -# ^^^^^^^^^^^^^^^ -# -# :command:`matlab_get_version_from_release_name` -# returns the version from the release name -# :command:`matlab_get_release_name_from_version` -# returns the release name from the Matlab version -# -# Provided functions -# ^^^^^^^^^^^^^^^^^^ -# -# :command:`matlab_add_mex` -# adds a target compiling a MEX file. -# :command:`matlab_add_unit_test` -# adds a Matlab unit test file as a test to the project. -# :command:`matlab_extract_all_installed_versions_from_registry` -# parses the registry for all Matlab versions. Available on Windows only. -# The part of the registry parsed is dependent on the host processor -# :command:`matlab_get_all_valid_matlab_roots_from_registry` -# returns all the possible Matlab or MCR paths, according to a previously -# given list. Only the existing/accessible paths are kept. This is mainly -# useful for the searching all possible Matlab installation. -# :command:`matlab_get_mex_suffix` -# returns the suffix to be used for the mex files -# (platform/architecture dependent) -# :command:`matlab_get_version_from_matlab_run` -# returns the version of Matlab/MCR, given the full directory of the Matlab/MCR -# installation path. -# -# -# Known issues -# ^^^^^^^^^^^^ -# -# **Symbol clash in a MEX target** -# By default, every symbols inside a MEX -# file defined with the command :command:`matlab_add_mex` have hidden -# visibility, except for the entry point. This is the default behaviour of -# the MEX compiler, which lowers the risk of symbol collision between the -# libraries shipped with Matlab, and the libraries to which the MEX file is -# linking to. This is also the default on Windows platforms. -# -# However, this is not sufficient in certain case, where for instance your -# MEX file is linking against libraries that are already loaded by Matlab, -# even if those libraries have different SONAMES. -# A possible solution is to hide the symbols of the libraries to which the -# MEX target is linking to. This can be achieved in GNU GCC compilers with -# the linker option ``-Wl,--exclude-libs,ALL``. -# -# **Tests using GPU resources** -# in case your MEX file is using the GPU and -# in order to be able to run unit tests on this MEX file, the GPU resources -# should be properly released by Matlab. A possible solution is to make -# Matlab aware of the use of the GPU resources in the session, which can be -# performed by a command such as ``D = gpuDevice()`` at the beginning of -# the test script (or via a fixture). -# -# -# Reference -# ^^^^^^^^^ -# -# .. variable:: Matlab_ROOT_DIR -# -# The root folder of the Matlab installation. If set before the call to -# :command:`find_package`, the module will look for the components in that -# path. If not set, then an automatic search of Matlab -# will be performed. If set, it should point to a valid version of Matlab. -# -# .. variable:: MATLAB_FIND_DEBUG -# -# If set, the lookup of Matlab and the intermediate configuration steps are -# outputted to the console. -# -# .. variable:: MATLAB_ADDITIONAL_VERSIONS -# -# If set, specifies additional versions of Matlab that may be looked for. -# The variable should be a list of strings, organised by pairs of release -# name and versions, such as follows:: -# -# set(MATLAB_ADDITIONAL_VERSIONS -# "release_name1=corresponding_version1" -# "release_name2=corresponding_version2" -# ... -# ) -# -# Example:: -# -# set(MATLAB_ADDITIONAL_VERSIONS -# "R2013b=8.2" -# "R2013a=8.1" -# "R2012b=8.0") -# -# The order of entries in this list matters when several versions of -# Matlab are installed. The priority is set according to the ordering in -# this list. - -set(_FindMatlab_SELF_DIR "${CMAKE_CURRENT_LIST_DIR}") - -include(CheckCXXCompilerFlag) -include(CheckCCompilerFlag) - - -# The currently supported versions. Other version can be added by the user by -# providing MATLAB_ADDITIONAL_VERSIONS -if(NOT MATLAB_ADDITIONAL_VERSIONS) - set(MATLAB_ADDITIONAL_VERSIONS) -endif() - -set(MATLAB_VERSIONS_MAPPING - "R2020b=9.9" - "R2020a=9.8" - "R2019b=9.7" - "R2019a=9.6" - "R2018b=9.5" - "R2018a=9.4" - "R2017b=9.3" - "R2017a=9.2" - "R2016b=9.1" - "R2016a=9.0" - "R2015b=8.6" - "R2015a=8.5" - "R2014b=8.4" - "R2014a=8.3" - "R2013b=8.2" - "R2013a=8.1" - "R2012b=8.0" - "R2012a=7.14" - "R2011b=7.13" - "R2011a=7.12" - "R2010b=7.11" - - ${MATLAB_ADDITIONAL_VERSIONS} - ) - - -# temporary folder for all Matlab runs -set(_matlab_temporary_folder ${CMAKE_BINARY_DIR}/Matlab) - -if(NOT EXISTS "${_matlab_temporary_folder}") - file(MAKE_DIRECTORY "${_matlab_temporary_folder}") -endif() - -#.rst: -# .. command:: matlab_get_version_from_release_name -# -# Returns the version of Matlab (17.58) from a release name (R2017k) -macro(matlab_get_version_from_release_name release_name version_name) - - string(REGEX MATCHALL "${release_name}=([0-9]+\\.?[0-9]*)" _matched ${MATLAB_VERSIONS_MAPPING}) - - set(${version_name} "") - if(NOT _matched STREQUAL "") - set(${version_name} ${CMAKE_MATCH_1}) - else() - message(WARNING "[MATLAB] The release name ${release_name} is not registered") - endif() - unset(_matched) - -endmacro() - - - - - -#.rst: -# .. command:: matlab_get_release_name_from_version -# -# Returns the release name (R2017k) from the version of Matlab (17.58) -macro(matlab_get_release_name_from_version version release_name) - - set(${release_name} "") - foreach(_var IN LISTS MATLAB_VERSIONS_MAPPING) - string(REGEX MATCHALL "(.+)=${version}" _matched ${_var}) - if(NOT _matched STREQUAL "") - set(${release_name} ${CMAKE_MATCH_1}) - break() - endif() - endforeach(_var) - - unset(_var) - unset(_matched) - if(${release_name} STREQUAL "") - message(WARNING "[MATLAB] The version ${version} is not registered") - endif() - -endmacro() - - - - - -# extracts all the supported release names (R2017k...) of Matlab -# internal use -macro(matlab_get_supported_releases list_releases) - set(${list_releases}) - foreach(_var IN LISTS MATLAB_VERSIONS_MAPPING) - string(REGEX MATCHALL "(.+)=([0-9]+\\.?[0-9]*)" _matched ${_var}) - if(NOT _matched STREQUAL "") - list(APPEND ${list_releases} ${CMAKE_MATCH_1}) - endif() - unset(_matched) - unset(CMAKE_MATCH_1) - endforeach(_var) - unset(_var) -endmacro() - - - -# extracts all the supported versions of Matlab -# internal use -macro(matlab_get_supported_versions list_versions) - set(${list_versions}) - foreach(_var IN LISTS MATLAB_VERSIONS_MAPPING) - string(REGEX MATCHALL "(.+)=([0-9]+\\.?[0-9]*)" _matched ${_var}) - if(NOT _matched STREQUAL "") - list(APPEND ${list_versions} ${CMAKE_MATCH_2}) - endif() - unset(_matched) - unset(CMAKE_MATCH_1) - endforeach(_var) - unset(_var) -endmacro() - - -#.rst: -# .. command:: matlab_extract_all_installed_versions_from_registry -# -# This function parses the registry and founds the Matlab versions that are -# installed. The found versions are returned in `matlab_versions`. -# Set `win64` to `TRUE` if the 64 bit version of Matlab should be looked for -# The returned list contains all versions under -# ``HKLM\\SOFTWARE\\Mathworks\\MATLAB`` and -# ``HKLM\\SOFTWARE\\Mathworks\\MATLAB Runtime`` or an empty list in case an -# error occurred (or nothing found). -# -# .. note:: -# -# Only the versions are provided. No check is made over the existence of the -# installation referenced in the registry, -# -function(matlab_extract_all_installed_versions_from_registry win64 matlab_versions) - - if(NOT CMAKE_HOST_WIN32) - message(FATAL_ERROR "[MATLAB] This macro can only be called by a windows host (call to reg.exe)") - endif() - - if(${win64} AND CMAKE_HOST_SYSTEM_PROCESSOR MATCHES "64") - set(APPEND_REG "/reg:64") - else() - set(APPEND_REG "/reg:32") - endif() - - set(matlabs_from_registry) - - foreach(_installation_type IN ITEMS "MATLAB" "MATLAB Runtime") - - # /reg:64 should be added on 64 bits capable OSs in order to enable the - # redirection of 64 bits applications - execute_process( - COMMAND reg query HKEY_LOCAL_MACHINE\\SOFTWARE\\Mathworks\\${_installation_type} /f * /k ${APPEND_REG} - RESULT_VARIABLE resultMatlab - OUTPUT_VARIABLE varMatlab - ERROR_VARIABLE errMatlab - INPUT_FILE NUL - ) - - - if(${resultMatlab} EQUAL 0) - - string( - REGEX MATCHALL "MATLAB\\\\([0-9]+(\\.[0-9]+)?)" - matlab_versions_regex ${varMatlab}) - - foreach(match IN LISTS matlab_versions_regex) - string( - REGEX MATCH "MATLAB\\\\(([0-9]+)(\\.([0-9]+))?)" - current_match ${match}) - - set(_matlab_current_version ${CMAKE_MATCH_1}) - set(current_matlab_version_major ${CMAKE_MATCH_2}) - set(current_matlab_version_minor ${CMAKE_MATCH_4}) - if(NOT current_matlab_version_minor) - set(current_matlab_version_minor "0") - endif() - - list(APPEND matlabs_from_registry ${_matlab_current_version}) - unset(_matlab_current_version) - endforeach() - - endif() - endforeach() - - if(matlabs_from_registry) - list(REMOVE_DUPLICATES matlabs_from_registry) - list(SORT matlabs_from_registry) - list(REVERSE matlabs_from_registry) - endif() - - set(${matlab_versions} ${matlabs_from_registry} PARENT_SCOPE) - -endfunction() - - - -# (internal) -macro(extract_matlab_versions_from_registry_brute_force matlab_versions) - # get the supported versions - set(matlab_supported_versions) - matlab_get_supported_versions(matlab_supported_versions) - - - # this is a manual population of the versions we want to look for - # this can be done as is, but preferably with the call to - # matlab_get_supported_versions and variable - - # populating the versions we want to look for - # set(matlab_supported_versions) - - # # Matlab 7 - # set(matlab_major 7) - # foreach(current_matlab_minor RANGE 4 20) - # list(APPEND matlab_supported_versions "${matlab_major}.${current_matlab_minor}") - # endforeach(current_matlab_minor) - - # # Matlab 8 - # set(matlab_major 8) - # foreach(current_matlab_minor RANGE 0 5) - # list(APPEND matlab_supported_versions "${matlab_major}.${current_matlab_minor}") - # endforeach(current_matlab_minor) - - # # taking into account the possible additional versions provided by the user - # if(DEFINED MATLAB_ADDITIONAL_VERSIONS) - # list(APPEND matlab_supported_versions MATLAB_ADDITIONAL_VERSIONS) - # endif() - - # we order from more recent to older - if(matlab_supported_versions) - list(REMOVE_DUPLICATES matlab_supported_versions) - list(SORT matlab_supported_versions) - list(REVERSE matlab_supported_versions) - endif() - - set(${matlab_versions} ${matlab_supported_versions}) -endmacro() - - - - -#.rst: -# .. command:: matlab_get_all_valid_matlab_roots_from_registry -# -# Populates the Matlab root with valid versions of Matlab or -# Matlab Runtime (MCR). -# The returned matlab_roots is organized in triplets -# ``(type,version_number,matlab_root_path)``, where ``type`` -# indicates either ``MATLAB`` or ``MCR``. -# -# :: -# -# matlab_get_all_valid_matlab_roots_from_registry( -# matlab_versions -# matlab_roots) -# -# ``matlab_versions`` -# the versions of each of the Matlab or MCR installations -# ``matlab_roots`` -# the location of each of the Matlab or MCR installations -function(matlab_get_all_valid_matlab_roots_from_registry matlab_versions matlab_roots) - - # The matlab_versions comes either from - # extract_matlab_versions_from_registry_brute_force or - # matlab_extract_all_installed_versions_from_registry. - - set(_matlab_roots_list ) - # check for Matlab installations - foreach(_matlab_current_version ${matlab_versions}) - get_filename_component( - current_MATLAB_ROOT - "[HKEY_LOCAL_MACHINE\\SOFTWARE\\MathWorks\\MATLAB\\${_matlab_current_version};MATLABROOT]" - ABSOLUTE) - - if(EXISTS ${current_MATLAB_ROOT}) - list(APPEND _matlab_roots_list "MATLAB" ${_matlab_current_version} ${current_MATLAB_ROOT}) - endif() - - endforeach() - - # Check for MCR installations - foreach(_matlab_current_version ${matlab_versions}) - get_filename_component( - current_MATLAB_ROOT - "[HKEY_LOCAL_MACHINE\\SOFTWARE\\MathWorks\\MATLAB Runtime\\${_matlab_current_version};MATLABROOT]" - ABSOLUTE) - - # remove the dot - string(REPLACE "." "" _matlab_current_version_without_dot "${_matlab_current_version}") - - if(EXISTS ${current_MATLAB_ROOT}) - list(APPEND _matlab_roots_list "MCR" ${_matlab_current_version} "${current_MATLAB_ROOT}/v${_matlab_current_version_without_dot}") - endif() - - endforeach() - set(${matlab_roots} ${_matlab_roots_list} PARENT_SCOPE) -endfunction() - -#.rst: -# .. command:: matlab_get_mex_suffix -# -# Returns the extension of the mex files (the suffixes). -# This function should not be called before the appropriate Matlab root has -# been found. -# -# :: -# -# matlab_get_mex_suffix( -# matlab_root -# mex_suffix) -# -# ``matlab_root`` -# the root of the Matlab/MCR installation -# ``mex_suffix`` -# the variable name in which the suffix will be returned. -function(matlab_get_mex_suffix matlab_root mex_suffix) - - # todo setup the extension properly. Currently I do not know if this is - # sufficient for all win32 distributions. - # there is also CMAKE_EXECUTABLE_SUFFIX that could be tweaked - set(mexext_suffix "") - if(WIN32) - list(APPEND mexext_suffix ".bat") - endif() - - # we first try without suffix, since cmake does not understand a list with - # one empty string element - find_program( - Matlab_MEXEXTENSIONS_PROG - NAMES mexext - PATHS ${matlab_root}/bin - DOC "Matlab MEX extension provider" - NO_DEFAULT_PATH - ) - - foreach(current_mexext_suffix IN LISTS mexext_suffix) - if(NOT DEFINED Matlab_MEXEXTENSIONS_PROG OR NOT Matlab_MEXEXTENSIONS_PROG) - # this call should populate the cache automatically - find_program( - Matlab_MEXEXTENSIONS_PROG - "mexext${current_mexext_suffix}" - PATHS ${matlab_root}/bin - DOC "Matlab MEX extension provider" - NO_DEFAULT_PATH - ) - endif() - endforeach(current_mexext_suffix) - if(MATLAB_FIND_DEBUG) - message(STATUS "[MATLAB] Determining mex files extensions from '${matlab_root}/bin' with program '${Matlab_MEXEXTENSIONS_PROG}'") - endif() - - # the program has been found? - if((NOT Matlab_MEXEXTENSIONS_PROG) OR (NOT EXISTS ${Matlab_MEXEXTENSIONS_PROG})) - if(MATLAB_FIND_DEBUG) - message(WARNING "[MATLAB] Cannot found mexext program. Matlab root is ${matlab_root}") - endif() - unset(Matlab_MEXEXTENSIONS_PROG CACHE) - return() - endif() - - set(_matlab_mex_extension) - - set(devnull) - if(UNIX) - set(devnull INPUT_FILE /dev/null) - elseif(WIN32) - set(devnull INPUT_FILE NUL) - endif() - - # this is the preferred way. If this does not work properly (eg. MCR on Windows), then we use our own knowledge - execute_process( - COMMAND ${Matlab_MEXEXTENSIONS_PROG} - OUTPUT_VARIABLE _matlab_mex_extension - #RESULT_VARIABLE _matlab_mex_extension_call - ERROR_VARIABLE _matlab_mex_extension_error - ${devnull}) - - if(NOT "${_matlab_mex_extension_error}" STREQUAL "") - if(WIN32) - # this is only for intel architecture - if(CMAKE_SIZEOF_VOID_P EQUAL 8) - set(_matlab_mex_extension "mexw64") - else() - set(_matlab_mex_extension "mexw32") - endif() - endif() - endif() - - string(STRIP "${_matlab_mex_extension}" _matlab_mex_extension) - if(MATLAB_FIND_DEBUG) - message(STATUS "[MATLAB] '${Matlab_MEXEXTENSIONS_PROG}' : returned '${_matlab_mex_extension_call}', determined extension '${_matlab_mex_extension}' and error string is '${_matlab_mex_extension_error}'") - endif() - - unset(Matlab_MEXEXTENSIONS_PROG CACHE) - set(${mex_suffix} ${_matlab_mex_extension} PARENT_SCOPE) -endfunction() - - - - -#.rst: -# .. command:: matlab_get_version_from_matlab_run -# -# This function runs Matlab program specified on arguments and extracts its -# version. If the path provided for the Matlab installation points to an MCR -# installation, the version is extracted from the installed files. -# -# :: -# -# matlab_get_version_from_matlab_run( -# matlab_binary_path -# matlab_list_versions) -# -# ``matlab_binary_path`` -# the location of the `matlab` binary executable -# ``matlab_list_versions`` -# the version extracted from Matlab -function(matlab_get_version_from_matlab_run matlab_binary_program matlab_list_versions) - - set(${matlab_list_versions} "" PARENT_SCOPE) - - if(MATLAB_FIND_DEBUG) - message(STATUS "[MATLAB] Determining the version of Matlab from ${matlab_binary_program}") - endif() - - if(EXISTS "${_matlab_temporary_folder}/matlabVersionLog.cmaketmp") - if(MATLAB_FIND_DEBUG) - message(STATUS "[MATLAB] Removing previous ${_matlab_temporary_folder}/matlabVersionLog.cmaketmp file") - endif() - file(REMOVE "${_matlab_temporary_folder}/matlabVersionLog.cmaketmp") - endif() - - - # the log file is needed since on windows the command executes in a new - # window and it is not possible to get back the answer of Matlab - # the -wait command is needed on windows, otherwise the call returns - # immediately after the program launches itself. - if(WIN32) - set(_matlab_additional_commands "-wait") - endif() - - set(devnull) - if(UNIX) - set(devnull INPUT_FILE /dev/null) - elseif(WIN32) - set(devnull INPUT_FILE NUL) - endif() - - # timeout set to 120 seconds, in case it does not start - # note as said before OUTPUT_VARIABLE cannot be used in a platform - # independent manner however, not setting it would flush the output of Matlab - # in the current console (unix variant) - execute_process( - COMMAND "${matlab_binary_program}" -nosplash -nojvm ${_matlab_additional_commands} -logfile "matlabVersionLog.cmaketmp" -nodesktop -nodisplay -r "version, exit" - OUTPUT_VARIABLE _matlab_version_from_cmd_dummy - RESULT_VARIABLE _matlab_result_version_call - ERROR_VARIABLE _matlab_result_version_call_error - TIMEOUT 120 - WORKING_DIRECTORY "${_matlab_temporary_folder}" - ${devnull} - ) - - if("${_matlab_result_version_call}" MATCHES "timeout") - if(MATLAB_FIND_DEBUG) - message(WARNING "[MATLAB] Unable to determine the version of Matlab." - " Matlab call timed out after 120 seconds.") - endif() - return() - endif() - - if(${_matlab_result_version_call}) - if(MATLAB_FIND_DEBUG) - message(WARNING "[MATLAB] Unable to determine the version of Matlab. Matlab call returned with error ${_matlab_result_version_call}.") - endif() - return() - elseif(NOT EXISTS "${_matlab_temporary_folder}/matlabVersionLog.cmaketmp") - if(MATLAB_FIND_DEBUG) - message(WARNING "[MATLAB] Unable to determine the version of Matlab. The log file does not exist.") - endif() - return() - endif() - - # if successful, read back the log - file(READ "${_matlab_temporary_folder}/matlabVersionLog.cmaketmp" _matlab_version_from_cmd) - file(REMOVE "${_matlab_temporary_folder}/matlabVersionLog.cmaketmp") - - set(index -1) - string(FIND ${_matlab_version_from_cmd} "ans" index) - if(index EQUAL -1) - - if(MATLAB_FIND_DEBUG) - message(WARNING "[MATLAB] Cannot find the version of Matlab returned by the run.") - endif() - - else() - set(matlab_list_of_all_versions_tmp) - - string(SUBSTRING ${_matlab_version_from_cmd} ${index} -1 substring_ans) - string( - REGEX MATCHALL "ans[\r\n\t ]*=[\r\n\t ]*'?([0-9]+(\\.[0-9]+)?)" - matlab_versions_regex - ${substring_ans}) - foreach(match IN LISTS matlab_versions_regex) - string( - REGEX MATCH "ans[\r\n\t ]*=[\r\n\t ]*'?(([0-9]+)(\\.([0-9]+))?)" - current_match ${match}) - - list(APPEND matlab_list_of_all_versions_tmp ${CMAKE_MATCH_1}) - endforeach() - if(matlab_list_of_all_versions_tmp) - list(REMOVE_DUPLICATES matlab_list_of_all_versions_tmp) - endif() - set(${matlab_list_versions} ${matlab_list_of_all_versions_tmp} PARENT_SCOPE) - - endif() - -endfunction() - -#.rst: -# .. command:: matlab_add_unit_test -# -# Adds a Matlab unit test to the test set of cmake/ctest. -# This command requires the component ``MAIN_PROGRAM`` and hence is not -# available for an MCR installation. -# -# The unit test uses the Matlab unittest framework (default, available -# starting Matlab 2013b+) except if the option ``NO_UNITTEST_FRAMEWORK`` -# is given. -# -# The function expects one Matlab test script file to be given. -# In the case ``NO_UNITTEST_FRAMEWORK`` is given, the unittest script file -# should contain the script to be run, plus an exit command with the exit -# value. This exit value will be passed to the ctest framework (0 success, -# non 0 failure). Additional arguments accepted by :command:`add_test` can be -# passed through ``TEST_ARGS`` (eg. ``CONFIGURATION ...``). -# -# :: -# -# matlab_add_unit_test( -# NAME -# UNITTEST_FILE matlab_file_containing_unittest.m -# [CUSTOM_TEST_COMMAND matlab_command_to_run_as_test] -# [UNITTEST_PRECOMMAND matlab_command_to_run] -# [TIMEOUT timeout] -# [ADDITIONAL_PATH path1 [path2 ...]] -# [MATLAB_ADDITIONAL_STARTUP_OPTIONS option1 [option2 ...]] -# [TEST_ARGS arg1 [arg2 ...]] -# [NO_UNITTEST_FRAMEWORK] -# ) -# -# The function arguments are: -# -# ``NAME`` -# name of the unittest in ctest. -# ``UNITTEST_FILE`` -# the matlab unittest file. Its path will be automatically -# added to the Matlab path. -# ``CUSTOM_TEST_COMMAND`` -# Matlab script command to run as the test. -# If this is not set, then the following is run: -# ``runtests('matlab_file_name'), exit(max([ans(1,:).Failed]))`` -# where ``matlab_file_name`` is the ``UNITTEST_FILE`` without the extension. -# ``UNITTEST_PRECOMMAND`` -# Matlab script command to be ran before the file -# containing the test (eg. GPU device initialisation based on CMake -# variables). -# ``TIMEOUT`` -# the test timeout in seconds. Defaults to 180 seconds as the -# Matlab unit test may hang. -# ``ADDITIONAL_PATH`` -# a list of paths to add to the Matlab path prior to -# running the unit test. -# ``MATLAB_ADDITIONAL_STARTUP_OPTIONS`` -# a list of additional option in order -# to run Matlab from the command line. -# ``-nosplash -nodesktop -nodisplay`` are always added. -# ``TEST_ARGS`` -# Additional options provided to the add_test command. These -# options are added to the default options (eg. "CONFIGURATIONS Release") -# ``NO_UNITTEST_FRAMEWORK`` -# when set, indicates that the test should not -# use the unittest framework of Matlab (available for versions >= R2013a). -# ``WORKING_DIRECTORY`` -# This will be the working directory for the test. If specified it will -# also be the output directory used for the log file of the test run. -# If not specified the temporary directory ``${CMAKE_BINARY_DIR}/Matlab`` will -# be used as the working directory and the log location. -# -function(matlab_add_unit_test) - - if(NOT Matlab_MAIN_PROGRAM) - message(FATAL_ERROR "[MATLAB] This functionality needs the MAIN_PROGRAM component (not default)") - endif() - - set(options NO_UNITTEST_FRAMEWORK) - set(oneValueArgs NAME UNITTEST_FILE TIMEOUT WORKING_DIRECTORY - UNITTEST_PRECOMMAND CUSTOM_TEST_COMMAND) - set(multiValueArgs ADDITIONAL_PATH MATLAB_ADDITIONAL_STARTUP_OPTIONS TEST_ARGS) - - set(prefix _matlab_unittest_prefix) - cmake_parse_arguments(PARSE_ARGV 0 ${prefix} "${options}" "${oneValueArgs}" "${multiValueArgs}" ) - - if(NOT ${prefix}_NAME) - message(FATAL_ERROR "[MATLAB] The Matlab test name cannot be empty") - endif() - - add_test(NAME ${${prefix}_NAME} - COMMAND ${CMAKE_COMMAND} - "-Dtest_name=${${prefix}_NAME}" - "-Dadditional_paths=${${prefix}_ADDITIONAL_PATH}" - "-Dtest_timeout=${${prefix}_TIMEOUT}" - "-Doutput_directory=${_matlab_temporary_folder}" - "-Dworking_directory=${${prefix}_WORKING_DIRECTORY}" - "-DMatlab_PROGRAM=${Matlab_MAIN_PROGRAM}" - "-Dno_unittest_framework=${${prefix}_NO_UNITTEST_FRAMEWORK}" - "-DMatlab_ADDITIONAL_STARTUP_OPTIONS=${${prefix}_MATLAB_ADDITIONAL_STARTUP_OPTIONS}" - "-Dunittest_file_to_run=${${prefix}_UNITTEST_FILE}" - "-Dcustom_Matlab_test_command=${${prefix}_CUSTOM_TEST_COMMAND}" - "-Dcmd_to_run_before_test=${${prefix}_UNITTEST_PRECOMMAND}" - -P ${_FindMatlab_SELF_DIR}/MatlabTestsRedirect.cmake - ${${prefix}_TEST_ARGS} - ${${prefix}_UNPARSED_ARGUMENTS} - ) -endfunction() - - -#.rst: -# .. command:: matlab_add_mex -# -# Adds a Matlab MEX target. -# This commands compiles the given sources with the current tool-chain in -# order to produce a MEX file. The final name of the produced output may be -# specified, as well as additional link libraries, and a documentation entry -# for the MEX file. Remaining arguments of the call are passed to the -# :command:`add_library` or :command:`add_executable` command. -# -# :: -# -# matlab_add_mex( -# NAME -# [EXECUTABLE | MODULE | SHARED] -# SRC src1 [src2 ...] -# [OUTPUT_NAME output_name] -# [DOCUMENTATION file.txt] -# [LINK_TO target1 target2 ...] -# [...] -# ) -# -# ``NAME`` -# name of the target. -# ``SRC`` -# list of source files. -# ``LINK_TO`` -# a list of additional link dependencies. The target links to ``libmex`` -# by default. If ``Matlab_MX_LIBRARY`` is defined, it also -# links to ``libmx``. -# ``OUTPUT_NAME`` -# if given, overrides the default name. The default name is -# the name of the target without any prefix and -# with ``Matlab_MEX_EXTENSION`` suffix. -# ``DOCUMENTATION`` -# if given, the file ``file.txt`` will be considered as -# being the documentation file for the MEX file. This file is copied into -# the same folder without any processing, with the same name as the final -# mex file, and with extension `.m`. In that case, typing ``help `` -# in Matlab prints the documentation contained in this file. -# ``MODULE`` or ``SHARED`` may be given to specify the type of library to be -# created. ``EXECUTABLE`` may be given to create an executable instead of -# a library. If no type is given explicitly, the type is ``SHARED``. -# -# The documentation file is not processed and should be in the following -# format: -# -# :: -# -# % This is the documentation -# function ret = mex_target_output_name(input1) -# -function(matlab_add_mex) - - if(NOT WIN32) - # we do not need all this on Windows - # pthread options - if(CMAKE_CXX_COMPILER_LOADED) - check_cxx_compiler_flag(-pthread HAS_MINUS_PTHREAD) - elseif(CMAKE_C_COMPILER_LOADED) - check_c_compiler_flag(-pthread HAS_MINUS_PTHREAD) - endif() - # we should use try_compile instead, the link flags are discarded from - # this compiler_flag function. - #check_cxx_compiler_flag(-Wl,--exclude-libs,ALL HAS_SYMBOL_HIDING_CAPABILITY) - - endif() - - set(options EXECUTABLE MODULE SHARED) - set(oneValueArgs NAME DOCUMENTATION OUTPUT_NAME) - set(multiValueArgs LINK_TO SRC) - - set(prefix _matlab_addmex_prefix) - cmake_parse_arguments(${prefix} "${options}" "${oneValueArgs}" "${multiValueArgs}" ${ARGN} ) - - if(NOT ${prefix}_NAME) - message(FATAL_ERROR "[MATLAB] The MEX target name cannot be empty") - endif() - - if(NOT ${prefix}_OUTPUT_NAME) - set(${prefix}_OUTPUT_NAME ${${prefix}_NAME}) - endif() - - if(${prefix}_EXECUTABLE) - add_executable(${${prefix}_NAME} - ${${prefix}_SRC} - ${${prefix}_DOCUMENTATION} - ${${prefix}_UNPARSED_ARGUMENTS}) - else() - if(${prefix}_MODULE) - set(type MODULE) - else() - set(type SHARED) - endif() - - add_library(${${prefix}_NAME} - ${type} - ${${prefix}_SRC} - ${${prefix}_DOCUMENTATION} - ${${prefix}_UNPARSED_ARGUMENTS}) - endif() - - target_include_directories(${${prefix}_NAME} PRIVATE ${Matlab_INCLUDE_DIRS}) - - if(DEFINED Matlab_MX_LIBRARY) - target_link_libraries(${${prefix}_NAME} ${Matlab_MX_LIBRARY}) - endif() - - target_link_libraries(${${prefix}_NAME} ${Matlab_MEX_LIBRARY} ${${prefix}_LINK_TO}) - set_target_properties(${${prefix}_NAME} - PROPERTIES - PREFIX "" - OUTPUT_NAME ${${prefix}_OUTPUT_NAME} - SUFFIX ".${Matlab_MEX_EXTENSION}") - - - # documentation - if(NOT ${${prefix}_DOCUMENTATION} STREQUAL "") - get_target_property(output_name ${${prefix}_NAME} OUTPUT_NAME) - add_custom_command( - TARGET ${${prefix}_NAME} - PRE_BUILD - COMMAND ${CMAKE_COMMAND} -E copy_if_different ${${prefix}_DOCUMENTATION} $/${output_name}.m - COMMENT "[MATLAB] Copy ${${prefix}_NAME} documentation file into the output folder" - ) - endif() # documentation - - # entry point in the mex file + taking care of visibility and symbol clashes. - if(WIN32) - set_target_properties(${${prefix}_NAME} - PROPERTIES - DEFINE_SYMBOL "DLL_EXPORT_SYM=__declspec(dllexport)") - else() - - if(HAS_MINUS_PTHREAD AND NOT APPLE) - # Apparently, compiling with -pthread generated the proper link flags - # and some defines at compilation - target_compile_options(${${prefix}_NAME} PRIVATE "-pthread") - endif() - - - # if we do not do that, the symbols linked from eg. boost remain weak and - # then clash with the ones defined in the matlab process. So by default - # the symbols are hidden. - # This also means that for shared libraries (like MEX), the entry point - # should be explicitly declared with default visibility, otherwise Matlab - # cannot find the entry point. - # Note that this is particularly meaningful if the MEX wrapper itself - # contains symbols that are clashing with Matlab (that are compiled in the - # MEX file). In order to propagate the visibility options to the libraries - # to which the MEX file is linked against, the -Wl,--exclude-libs,ALL - # option should also be specified. - - set_target_properties(${${prefix}_NAME} - PROPERTIES - CXX_VISIBILITY_PRESET "hidden" - C_VISIBILITY_PRESET "hidden" - VISIBILITY_INLINES_HIDDEN ON - ) - - # get_target_property( - # _previous_link_flags - # ${${prefix}_NAME} - # LINK_FLAGS) - # if(NOT _previous_link_flags) - # set(_previous_link_flags) - # endif() - - # if("${CMAKE_CXX_COMPILER_ID}" STREQUAL "GNU") - # set_target_properties(${${prefix}_NAME} - # PROPERTIES - # LINK_FLAGS "${_previous_link_flags} -Wl,--exclude-libs,ALL" - # # -Wl,--version-script=${_FindMatlab_SELF_DIR}/MatlabLinuxVisibility.map" - # ) - # elseif("${CMAKE_CXX_COMPILER_ID}" STREQUAL "Clang") - # # in this case, all other symbols become hidden. - # set_target_properties(${${prefix}_NAME} - # PROPERTIES - # LINK_FLAGS "${_previous_link_flags} -Wl,-exported_symbol,_mexFunction" - # #-Wl,-exported_symbols_list,${_FindMatlab_SELF_DIR}/MatlabOSXVisilibity.map" - # ) - # endif() - - - - set_target_properties(${${prefix}_NAME} - PROPERTIES - DEFINE_SYMBOL "DLL_EXPORT_SYM=__attribute__ ((visibility (\"default\")))" - ) - - - endif() - -endfunction() - - -# (internal) -# Used to get the version of matlab, using caching. This basically transforms the -# output of the root list, with possible unknown version, to a version -# This can possibly run Matlab for extracting the version. -function(_Matlab_get_version_from_root matlab_root matlab_or_mcr matlab_known_version matlab_final_version) - - # if the version is not trivial, we query matlab (if not MCR) for that - # we keep track of the location of matlab that induced this version - #if(NOT DEFINED Matlab_PROG_VERSION_STRING_AUTO_DETECT) - # set(Matlab_PROG_VERSION_STRING_AUTO_DETECT "" CACHE INTERNAL "internal matlab location for the discovered version") - #endif() - - if(NOT ${matlab_known_version} STREQUAL "NOTFOUND") - # the version is known, we just return it - set(${matlab_final_version} ${matlab_known_version} PARENT_SCOPE) - set(Matlab_VERSION_STRING_INTERNAL ${matlab_known_version} CACHE INTERNAL "Matlab version (automatically determined)" FORCE) - return() - endif() - - if("${matlab_or_mcr}" STREQUAL "UNKNOWN") - if(MATLAB_FIND_DEBUG) - message(WARNING "[MATLAB] Determining Matlab or MCR") - endif() - - if(EXISTS "${matlab_root}/appdata/version.xml") - # we inspect the application version.xml file that contains the product information - file(STRINGS "${matlab_root}/appdata/version.xml" productinfo_string NEWLINE_CONSUME) - string(REGEX MATCH "" - product_reg_match - ${productinfo_string} - ) - - # default fallback to Matlab - set(matlab_or_mcr "MATLAB") - if(NOT "${CMAKE_MATCH_1}" STREQUAL "") - string(TOLOWER "${CMAKE_MATCH_1}" product_reg_match) - - if("${product_reg_match}" STREQUAL "matlab runtime") - set(matlab_or_mcr "MCR") - endif() - endif() - endif() - - if(MATLAB_FIND_DEBUG) - message(WARNING "[MATLAB] '${matlab_root}' contains the '${matlab_or_mcr}'") - endif() - endif() - - # UNKNOWN is the default behaviour in case we - # - have an erroneous matlab_root - # - have an initial 'UNKNOWN' - if("${matlab_or_mcr}" STREQUAL "MATLAB" OR "${matlab_or_mcr}" STREQUAL "UNKNOWN") - # MATLAB versions - set(_matlab_current_program ${Matlab_MAIN_PROGRAM}) - - # do we already have a matlab program? - if(NOT _matlab_current_program) - - set(_find_matlab_options) - if(matlab_root AND EXISTS ${matlab_root}) - set(_find_matlab_options PATHS ${matlab_root} ${matlab_root}/bin NO_DEFAULT_PATH) - endif() - - find_program( - _matlab_current_program - matlab - ${_find_matlab_options} - DOC "Matlab main program" - ) - endif() - - if(NOT _matlab_current_program OR NOT EXISTS ${_matlab_current_program}) - # if not found, clear the dependent variables - if(MATLAB_FIND_DEBUG) - message(WARNING "[MATLAB] Cannot find the main matlab program under ${matlab_root}") - endif() - set(Matlab_PROG_VERSION_STRING_AUTO_DETECT "" CACHE INTERNAL "internal matlab location for the discovered version" FORCE) - set(Matlab_VERSION_STRING_INTERNAL "" CACHE INTERNAL "internal matlab location for the discovered version" FORCE) - unset(_matlab_current_program) - unset(_matlab_current_program CACHE) - return() - endif() - - # full real path for path comparison - get_filename_component(_matlab_main_real_path_tmp "${_matlab_current_program}" REALPATH) - unset(_matlab_current_program) - unset(_matlab_current_program CACHE) - - # is it the same as the previous one? - if(_matlab_main_real_path_tmp STREQUAL Matlab_PROG_VERSION_STRING_AUTO_DETECT) - set(${matlab_final_version} ${Matlab_VERSION_STRING_INTERNAL} PARENT_SCOPE) - return() - endif() - - # update the location of the program - set(Matlab_PROG_VERSION_STRING_AUTO_DETECT - ${_matlab_main_real_path_tmp} - CACHE INTERNAL "internal matlab location for the discovered version" FORCE) - - set(matlab_list_of_all_versions) - matlab_get_version_from_matlab_run("${Matlab_PROG_VERSION_STRING_AUTO_DETECT}" matlab_list_of_all_versions) - - list(LENGTH matlab_list_of_all_versions list_of_all_versions_length) - if(${list_of_all_versions_length} GREATER 0) - list(GET matlab_list_of_all_versions 0 _matlab_version_tmp) - else() - set(_matlab_version_tmp "unknown") - endif() - - # set the version into the cache - set(Matlab_VERSION_STRING_INTERNAL ${_matlab_version_tmp} CACHE INTERNAL "Matlab version (automatically determined)" FORCE) - - # warning, just in case several versions found (should not happen) - if((${list_of_all_versions_length} GREATER 1) AND MATLAB_FIND_DEBUG) - message(WARNING "[MATLAB] Found several versions, taking the first one (versions found ${matlab_list_of_all_versions})") - endif() - - # return the updated value - set(${matlab_final_version} ${Matlab_VERSION_STRING_INTERNAL} PARENT_SCOPE) - else() - # MCR - # we cannot run anything in order to extract the version. We assume that the file - # VersionInfo.xml exists under the MatlabRoot, we look for it and extract the version from there - set(_matlab_version_tmp "unknown") - file(STRINGS "${matlab_root}/VersionInfo.xml" versioninfo_string NEWLINE_CONSUME) - # parses "9.2.0.538062" - string(REGEX MATCH "(.*)" - version_reg_match - ${versioninfo_string} - ) - - if(NOT "${version_reg_match}" STREQUAL "") - if("${CMAKE_MATCH_1}" MATCHES "(([0-9])\\.([0-9]))[\\.0-9]*") - set(_matlab_version_tmp "${CMAKE_MATCH_1}") - endif() - endif() - set(${matlab_final_version} "${_matlab_version_tmp}" PARENT_SCOPE) - set(Matlab_VERSION_STRING_INTERNAL - "${_matlab_version_tmp}" - CACHE INTERNAL "Matlab (MCR) version (automatically determined)" - FORCE) - - endif() # Matlab or MCR - -endfunction() - - -# Utility function for finding Matlab or MCR on Win32 -function(_Matlab_find_instances_win32 matlab_roots) - # On WIN32, we look for Matlab installation in the registry - # if unsuccessful, we look for all known revision and filter the existing - # ones. - - # testing if we are able to extract the needed information from the registry - set(_matlab_versions_from_registry) - - if(CMAKE_SIZEOF_VOID_P EQUAL 8) - set(_matlab_win64 ON) - else() - set(_matlab_win64 OFF) - endif() - - matlab_extract_all_installed_versions_from_registry(_matlab_win64 _matlab_versions_from_registry) - - # the returned list is empty, doing the search on all known versions - if(NOT _matlab_versions_from_registry) - if(MATLAB_FIND_DEBUG) - message(STATUS "[MATLAB] Search for Matlab from the registry unsuccessful, testing all supported versions") - endif() - extract_matlab_versions_from_registry_brute_force(_matlab_versions_from_registry) - endif() - - # filtering the results with the registry keys - matlab_get_all_valid_matlab_roots_from_registry("${_matlab_versions_from_registry}" _matlab_possible_roots) - unset(_matlab_versions_from_registry) - - set(_matlab_versions_from_registry) - matlab_extract_all_installed_versions_from_registry(CMAKE_CL_64 _matlab_versions_from_registry) - - # the returned list is empty, doing the search on all known versions - if(NOT _matlab_versions_from_registry) - if(MATLAB_FIND_DEBUG) - message(STATUS "[MATLAB] Search for Matlab from the registry unsuccessful, testing all supported versions") - endif() - extract_matlab_versions_from_registry_brute_force(_matlab_versions_from_registry) - endif() - - # filtering the results with the registry keys - matlab_get_all_valid_matlab_roots_from_registry("${_matlab_versions_from_registry}" _matlab_possible_roots) - set(${matlab_roots} ${_matlab_possible_roots} PARENT_SCOPE) - -endfunction() - -# Utility function for finding Matlab or MCR on OSX -function(_Matlab_find_instances_osx matlab_roots) - - set(_matlab_possible_roots) - # on mac, we look for the /Application paths - # this corresponds to the behaviour on Windows. On Linux, we do not have - # any other guess. - matlab_get_supported_releases(_matlab_releases) - if(MATLAB_FIND_DEBUG) - message(STATUS "[MATLAB] Matlab supported versions ${_matlab_releases}. If more version should be supported " - "the variable MATLAB_ADDITIONAL_VERSIONS can be set according to the documentation") - endif() - - foreach(_matlab_current_release IN LISTS _matlab_releases) - matlab_get_version_from_release_name("${_matlab_current_release}" _matlab_current_version) - string(REPLACE "." "" _matlab_current_version_without_dot "${_matlab_current_version}") - set(_matlab_base_path "/Applications/MATLAB_${_matlab_current_release}.app") - - # Check Matlab, has precedence over MCR - if(EXISTS ${_matlab_base_path}) - if(MATLAB_FIND_DEBUG) - message(STATUS "[MATLAB] Found version ${_matlab_current_release} (${_matlab_current_version}) in ${_matlab_base_path}") - endif() - list(APPEND _matlab_possible_roots "MATLAB" ${_matlab_current_version} ${_matlab_base_path}) - endif() - - # Checks MCR - set(_mcr_path "/Applications/MATLAB/MATLAB_Runtime/v${_matlab_current_version_without_dot}") - if(EXISTS "${_mcr_path}") - if(MATLAB_FIND_DEBUG) - message(STATUS "[MATLAB] Found MCR version ${_matlab_current_release} (${_matlab_current_version}) in ${_mcr_path}") - endif() - list(APPEND _matlab_possible_roots "MCR" ${_matlab_current_version} ${_mcr_path}) - endif() - - endforeach() - set(${matlab_roots} ${_matlab_possible_roots} PARENT_SCOPE) - -endfunction() - -# Utility function for finding Matlab or MCR from the PATH -function(_Matlab_find_instances_from_path matlab_roots) - - set(_matlab_possible_roots) - - # At this point, we have no other choice than trying to find it from PATH. - # If set by the user, this wont change - find_program( - _matlab_main_tmp - NAMES matlab) - - if(_matlab_main_tmp) - # we then populate the list of roots, with empty version - if(MATLAB_FIND_DEBUG) - message(STATUS "[MATLAB] matlab found from PATH: ${_matlab_main_tmp}") - endif() - - # resolve symlinks - get_filename_component(_matlab_current_location "${_matlab_main_tmp}" REALPATH) - - # get the directory (the command below has to be run twice) - # this will be the matlab root - get_filename_component(_matlab_current_location "${_matlab_current_location}" DIRECTORY) - get_filename_component(_matlab_current_location "${_matlab_current_location}" DIRECTORY) # Matlab should be in bin - - # We found the Matlab program - list(APPEND _matlab_possible_roots "MATLAB" "NOTFOUND" ${_matlab_current_location}) - - # we remove this from the CACHE - unset(_matlab_main_tmp CACHE) - else() - find_program( - _matlab_mex_tmp - NAMES mex) - if(_matlab_mex_tmp) - # we then populate the list of roots, with empty version - if(MATLAB_FIND_DEBUG) - message(STATUS "[MATLAB] mex compiler found from PATH: ${_matlab_mex_tmp}") - endif() - - # resolve symlinks - get_filename_component(_mex_current_location "${_matlab_mex_tmp}" REALPATH) - - # get the directory (the command below has to be run twice) - # this will be the matlab root - get_filename_component(_mex_current_location "${_mex_current_location}" DIRECTORY) - get_filename_component(_mex_current_location "${_mex_current_location}" DIRECTORY) # Matlab Runtime mex compiler should be in bin - - # We found the Matlab program - list(APPEND _matlab_possible_roots "MCR" "NOTFOUND" ${_mex_current_location}) - - unset(_matlab_mex_tmp CACHE) - else() - if(MATLAB_FIND_DEBUG) - message(STATUS "[MATLAB] mex compiler not found") - endif() - endif() - - - endif() - - set(${matlab_roots} ${_matlab_possible_roots} PARENT_SCOPE) -endfunction() - - -# ################################### -# Exploring the possible Matlab_ROOTS - -# this variable will get all Matlab installations found in the current system. -set(_matlab_possible_roots) - -if(Matlab_ROOT_DIR) - # if the user specifies a possible root, we keep this one - - if(NOT EXISTS "${Matlab_ROOT_DIR}") - # if Matlab_ROOT_DIR specified but erroneous - if(MATLAB_FIND_DEBUG) - message(WARNING "[MATLAB] the specified path for Matlab_ROOT_DIR does not exist (${Matlab_ROOT_DIR})") - endif() - else() - # NOTFOUND indicates the code below to search for the version automatically - if("${Matlab_VERSION_STRING_INTERNAL}" STREQUAL "") - list(APPEND _matlab_possible_roots "UNKNOWN" "NOTFOUND" ${Matlab_ROOT_DIR}) # empty version, empty MCR/Matlab indication - else() - list(APPEND _matlab_possible_roots "UNKNOWN" ${Matlab_VERSION_STRING_INTERNAL} ${Matlab_ROOT_DIR}) # cached version - endif() - endif() -else() - - # if the user does not specify the possible installation root, we look for - # one installation using the appropriate heuristics. - # There is apparently no standard way on Linux. - if(CMAKE_HOST_WIN32) - _Matlab_find_instances_win32(_matlab_possible_roots_win32) - list(APPEND _matlab_possible_roots ${_matlab_possible_roots_win32}) - elseif(APPLE) - _Matlab_find_instances_osx(_matlab_possible_roots_osx) - list(APPEND _matlab_possible_roots ${_matlab_possible_roots_osx}) - endif() -endif() - - -list(LENGTH _matlab_possible_roots _numbers_of_matlab_roots) -if(_numbers_of_matlab_roots EQUAL 0) - # if we have not found anything, we fall back on the PATH - _Matlab_find_instances_from_path(_matlab_possible_roots) -endif() - - -if(MATLAB_FIND_DEBUG) - message(STATUS "[MATLAB] Matlab root folders are ${_matlab_possible_roots}") -endif() - - - - - -# take the first possible Matlab root -list(LENGTH _matlab_possible_roots _numbers_of_matlab_roots) -set(Matlab_VERSION_STRING "NOTFOUND") -set(Matlab_Or_MCR "UNKNOWN") -if(_numbers_of_matlab_roots GREATER 0) - list(GET _matlab_possible_roots 0 Matlab_Or_MCR) - list(GET _matlab_possible_roots 1 Matlab_VERSION_STRING) - list(GET _matlab_possible_roots 2 Matlab_ROOT_DIR) - - # adding a warning in case of ambiguity - if(_numbers_of_matlab_roots GREATER 3 AND MATLAB_FIND_DEBUG) - message(WARNING "[MATLAB] Found several distributions of Matlab. Setting the current version to ${Matlab_VERSION_STRING} (located ${Matlab_ROOT_DIR})." - " If this is not the desired behaviour, provide the -DMatlab_ROOT_DIR=... on the command line") - endif() -endif() - - -# check if the root changed wrt. the previous defined one, if so -# clear all the cached variables for being able to reconfigure properly -if(DEFINED Matlab_ROOT_DIR_LAST_CACHED) - - if(NOT Matlab_ROOT_DIR_LAST_CACHED STREQUAL Matlab_ROOT_DIR) - set(_Matlab_cached_vars - Matlab_INCLUDE_DIRS - Matlab_MEX_LIBRARY - Matlab_MEX_COMPILER - Matlab_MCC_COMPILER - Matlab_MAIN_PROGRAM - Matlab_MX_LIBRARY - Matlab_ENG_LIBRARY - Matlab_MAT_LIBRARY - Matlab_MEX_EXTENSION - Matlab_SIMULINK_INCLUDE_DIR - - # internal - Matlab_MEXEXTENSIONS_PROG - Matlab_ROOT_DIR_LAST_CACHED - #Matlab_PROG_VERSION_STRING_AUTO_DETECT - Matlab_VERSION_STRING_INTERNAL - ) - foreach(_var IN LISTS _Matlab_cached_vars) - if(DEFINED ${_var}) - unset(${_var} CACHE) - endif() - endforeach() - endif() -endif() - -set(Matlab_ROOT_DIR_LAST_CACHED ${Matlab_ROOT_DIR} CACHE INTERNAL "last Matlab root dir location") -set(Matlab_ROOT_DIR ${Matlab_ROOT_DIR} CACHE PATH "Matlab installation root path" FORCE) - -# Fix the version, in case this one is NOTFOUND -_Matlab_get_version_from_root( - "${Matlab_ROOT_DIR}" - "${Matlab_Or_MCR}" - ${Matlab_VERSION_STRING} - Matlab_VERSION_STRING -) - -if(MATLAB_FIND_DEBUG) - message(STATUS "[MATLAB] Current version is ${Matlab_VERSION_STRING} located ${Matlab_ROOT_DIR}") -endif() - - - -if(Matlab_ROOT_DIR) - file(TO_CMAKE_PATH ${Matlab_ROOT_DIR} Matlab_ROOT_DIR) -endif() - -if(CMAKE_SIZEOF_VOID_P EQUAL 4) - set(_matlab_64Build FALSE) -else() - set(_matlab_64Build TRUE) -endif() - -if(APPLE) - set(_matlab_bin_prefix "mac") # i should be for intel - set(_matlab_bin_suffix_32bits "i") - set(_matlab_bin_suffix_64bits "i64") -elseif(UNIX) - set(_matlab_bin_prefix "gln") - set(_matlab_bin_suffix_32bits "x86") - set(_matlab_bin_suffix_64bits "xa64") -else() - set(_matlab_bin_prefix "win") - set(_matlab_bin_suffix_32bits "32") - set(_matlab_bin_suffix_64bits "64") -endif() - - - -set(MATLAB_INCLUDE_DIR_TO_LOOK ${Matlab_ROOT_DIR}/extern/include) -if(_matlab_64Build) - set(_matlab_current_suffix ${_matlab_bin_suffix_64bits}) -else() - set(_matlab_current_suffix ${_matlab_bin_suffix_32bits}) -endif() - -set(Matlab_BINARIES_DIR - ${Matlab_ROOT_DIR}/bin/${_matlab_bin_prefix}${_matlab_current_suffix}) -set(Matlab_EXTERN_LIBRARY_DIR - ${Matlab_ROOT_DIR}/extern/lib/${_matlab_bin_prefix}${_matlab_current_suffix}) - -if(WIN32) - if(MINGW) - set(_matlab_lib_dir_for_search ${Matlab_EXTERN_LIBRARY_DIR}/mingw64) - else() - set(_matlab_lib_dir_for_search ${Matlab_EXTERN_LIBRARY_DIR}/microsoft) - endif() - set(_matlab_lib_prefix_for_search "lib") -else() - set(_matlab_lib_dir_for_search ${Matlab_BINARIES_DIR}) - set(_matlab_lib_prefix_for_search "lib") -endif() - -unset(_matlab_64Build) - - -if(NOT DEFINED Matlab_MEX_EXTENSION) - set(_matlab_mex_extension "") - matlab_get_mex_suffix("${Matlab_ROOT_DIR}" _matlab_mex_extension) - - # This variable goes to the cache. - set(Matlab_MEX_EXTENSION ${_matlab_mex_extension} CACHE STRING "Extensions for the mex targets (automatically given by Matlab)") - unset(_matlab_mex_extension) -endif() - - -if(MATLAB_FIND_DEBUG) - message(STATUS "[MATLAB] [DEBUG]_matlab_lib_prefix_for_search = ${_matlab_lib_prefix_for_search} | _matlab_lib_dir_for_search = ${_matlab_lib_dir_for_search}") -endif() - - - -# internal -# This small stub around find_library is to prevent any pollution of CMAKE_FIND_LIBRARY_PREFIXES in the global scope. -# This is the function to be used below instead of the find_library directives. -function(_Matlab_find_library _matlab_library_prefix) - set(CMAKE_FIND_LIBRARY_PREFIXES ${CMAKE_FIND_LIBRARY_PREFIXES} ${_matlab_library_prefix}) - find_library(${ARGN}) -endfunction() - - -set(_matlab_required_variables) - - -# the MEX library/header are required -find_path( - Matlab_INCLUDE_DIRS - mex.h - PATHS ${MATLAB_INCLUDE_DIR_TO_LOOK} - NO_DEFAULT_PATH - ) -list(APPEND _matlab_required_variables Matlab_INCLUDE_DIRS) - -_Matlab_find_library( - ${_matlab_lib_prefix_for_search} - Matlab_MEX_LIBRARY - mex - PATHS ${_matlab_lib_dir_for_search} - NO_DEFAULT_PATH -) - -list(APPEND _matlab_required_variables Matlab_MEX_LIBRARY) - -# the MEX extension is required -list(APPEND _matlab_required_variables Matlab_MEX_EXTENSION) - -# the matlab root is required -list(APPEND _matlab_required_variables Matlab_ROOT_DIR) - -# component Mex Compiler -list(FIND Matlab_FIND_COMPONENTS MEX_COMPILER _matlab_find_mex_compiler) -if(_matlab_find_mex_compiler GREATER -1) - find_program( - Matlab_MEX_COMPILER - "mex" - PATHS ${Matlab_BINARIES_DIR} - DOC "Matlab MEX compiler" - NO_DEFAULT_PATH - ) - if(Matlab_MEX_COMPILER) - set(Matlab_MEX_COMPILER_FOUND TRUE) - endif() -endif() -unset(_matlab_find_mex_compiler) - -# component Matlab program -list(FIND Matlab_FIND_COMPONENTS MAIN_PROGRAM _matlab_find_matlab_program) -if(_matlab_find_matlab_program GREATER -1) - find_program( - Matlab_MAIN_PROGRAM - matlab - PATHS ${Matlab_ROOT_DIR} ${Matlab_ROOT_DIR}/bin - DOC "Matlab main program" - NO_DEFAULT_PATH - ) - if(Matlab_MAIN_PROGRAM) - set(Matlab_MAIN_PROGRAM_FOUND TRUE) - endif() -endif() -unset(_matlab_find_matlab_program) - -# Component MX library -list(FIND Matlab_FIND_COMPONENTS MX_LIBRARY _matlab_find_mx) -if(_matlab_find_mx GREATER -1) - _Matlab_find_library( - ${_matlab_lib_prefix_for_search} - Matlab_MX_LIBRARY - mx - PATHS ${_matlab_lib_dir_for_search} - NO_DEFAULT_PATH - ) - if(Matlab_MX_LIBRARY) - set(Matlab_MX_LIBRARY_FOUND TRUE) - endif() -endif() -unset(_matlab_find_mx) - -# Component ENG library -list(FIND Matlab_FIND_COMPONENTS ENG_LIBRARY _matlab_find_eng) -if(_matlab_find_eng GREATER -1) - _Matlab_find_library( - ${_matlab_lib_prefix_for_search} - Matlab_ENG_LIBRARY - eng - PATHS ${_matlab_lib_dir_for_search} - NO_DEFAULT_PATH - ) - if(Matlab_ENG_LIBRARY) - set(Matlab_ENG_LIBRARY_FOUND TRUE) - endif() -endif() -unset(_matlab_find_eng) - -# Component MAT library -list(FIND Matlab_FIND_COMPONENTS MAT_LIBRARY _matlab_find_mat) -if(_matlab_find_mat GREATER -1) - _Matlab_find_library( - ${_matlab_lib_prefix_for_search} - Matlab_MAT_LIBRARY - mat - PATHS ${_matlab_lib_dir_for_search} - NO_DEFAULT_PATH - ) - if(Matlab_MAT_LIBRARY) - set(Matlab_MAT_LIBRARY_FOUND TRUE) - endif() -endif() -unset(_matlab_find_mat) - -# Component Simulink -list(FIND Matlab_FIND_COMPONENTS SIMULINK _matlab_find_simulink) -if(_matlab_find_simulink GREATER -1) - find_path( - Matlab_SIMULINK_INCLUDE_DIR - simstruc.h - PATHS "${Matlab_ROOT_DIR}/simulink/include" - NO_DEFAULT_PATH - ) - if(Matlab_SIMULINK_INCLUDE_DIR) - set(Matlab_SIMULINK_FOUND TRUE) - list(APPEND Matlab_INCLUDE_DIRS "${Matlab_SIMULINK_INCLUDE_DIR}") - endif() -endif() -unset(_matlab_find_simulink) - -# component MCC Compiler -list(FIND Matlab_FIND_COMPONENTS MCC_COMPILER _matlab_find_mcc_compiler) -if(_matlab_find_mcc_compiler GREATER -1) - find_program( - Matlab_MCC_COMPILER - "mcc" - PATHS ${Matlab_BINARIES_DIR} - DOC "Matlab MCC compiler" - NO_DEFAULT_PATH - ) - if(Matlab_MCC_COMPILER) - set(Matlab_MCC_COMPILER_FOUND TRUE) - endif() -endif() -unset(_matlab_find_mcc_compiler) - -unset(_matlab_lib_dir_for_search) - -set(Matlab_LIBRARIES ${Matlab_MEX_LIBRARY} ${Matlab_MX_LIBRARY} ${Matlab_ENG_LIBRARY} ${Matlab_MAT_LIBRARY}) - -find_package_handle_standard_args( - Matlab - FOUND_VAR Matlab_FOUND - REQUIRED_VARS ${_matlab_required_variables} - VERSION_VAR Matlab_VERSION_STRING - HANDLE_COMPONENTS) - -unset(_matlab_required_variables) -unset(_matlab_bin_prefix) -unset(_matlab_bin_suffix_32bits) -unset(_matlab_bin_suffix_64bits) -unset(_matlab_current_suffix) -unset(_matlab_lib_dir_for_search) -unset(_matlab_lib_prefix_for_search) - -if(Matlab_INCLUDE_DIRS AND Matlab_LIBRARIES) - mark_as_advanced( - Matlab_MEX_LIBRARY - Matlab_MX_LIBRARY - Matlab_ENG_LIBRARY - Matlab_MAT_LIBRARY - Matlab_INCLUDE_DIRS - Matlab_FOUND - Matlab_MAIN_PROGRAM - Matlab_MEXEXTENSIONS_PROG - Matlab_MEX_EXTENSION - ) -endif() diff --git a/OpenFAST/cmake/FindSphinx.cmake b/OpenFAST/cmake/FindSphinx.cmake deleted file mode 100644 index 353c69c83..000000000 --- a/OpenFAST/cmake/FindSphinx.cmake +++ /dev/null @@ -1,17 +0,0 @@ -find_program(SPHINX_EXECUTABLE NAMES sphinx-build - DOC "Sphinx Documentation Builder (sphinx-doc.org)" -) - -if(SPHINX_EXECUTABLE) - execute_process(COMMAND ${SPHINX_EXECUTABLE} --version OUTPUT_VARIABLE SPHINX_VERSION_OUTPUT) - if("${SPHINX_VERSION_OUTPUT}" MATCHES "^Sphinx \\(sphinx-build\\) ([^\n]+)\n") - set(SPHINX_VERSION "${CMAKE_MATCH_1}") - endif() -endif() - -include(FindPackageHandleStandardArgs) -find_package_handle_standard_args(Sphinx REQUIRED_VARS SPHINX_EXECUTABLE - VERSION_VAR SPHINX_VERSION -) - -mark_as_advanced(SPHINX_EXECUTABLE) diff --git a/OpenFAST/cmake/GetGitRevisionDescription.cmake b/OpenFAST/cmake/GetGitRevisionDescription.cmake deleted file mode 100644 index f6459366f..000000000 --- a/OpenFAST/cmake/GetGitRevisionDescription.cmake +++ /dev/null @@ -1,160 +0,0 @@ -# - Returns a version string from Git -# -# These functions force a re-configure on each git commit so that you can -# trust the values of the variables in your build system. -# -# get_git_head_revision( [ ...]) -# -# Returns the refspec and sha hash of the current head revision -# -# git_describe( [ ...]) -# -# Returns the results of git describe on the source tree, and adjusting -# the output so that it tests false if an error occurs. -# -# git_get_exact_tag( [ ...]) -# -# Returns the results of git describe --exact-match on the source tree, -# and adjusting the output so that it tests false if there was no exact -# matching tag. -# -# git_local_changes() -# -# Returns either "CLEAN" or "DIRTY" with respect to uncommitted changes. -# Uses the return code of "git diff-index --quiet HEAD --". -# Does not regard untracked files. -# -# Requires CMake 2.6 or newer (uses the 'function' command) -# -# Obtained from https://github.com/rpavlik/cmake-modules/blob/master/GetGitRevisionDescription.cmake -# on August 29 2017 -# -# Original Author: -# 2009-2010 Ryan Pavlik -# http://academic.cleardefinition.com -# Iowa State University HCI Graduate Program/VRAC -# -# Copyright Iowa State University 2009-2010. -# Distributed under the Boost Software License, Version 1.0. -# (See accompanying file LICENSE_1_0.txt or copy at -# http://www.boost.org/LICENSE_1_0.txt) - -if(__get_git_revision_description) - return() -endif() -set(__get_git_revision_description YES) - -# We must run the following at "include" time, not at function call time, -# to find the path to this module rather than the path to a calling list file -get_filename_component(_gitdescmoddir ${CMAKE_CURRENT_LIST_FILE} PATH) - -function(get_git_head_revision _refspecvar _hashvar) - set(GIT_PARENT_DIR "${CMAKE_CURRENT_SOURCE_DIR}") - set(GIT_DIR "${GIT_PARENT_DIR}/.git") - while(NOT EXISTS "${GIT_DIR}") # .git dir not found, search parent directories - set(GIT_PREVIOUS_PARENT "${GIT_PARENT_DIR}") - get_filename_component(GIT_PARENT_DIR ${GIT_PARENT_DIR} PATH) - if(GIT_PARENT_DIR STREQUAL GIT_PREVIOUS_PARENT) - # We have reached the root directory, we are not in git - set(${_refspecvar} "GITDIR-NOTFOUND" PARENT_SCOPE) - set(${_hashvar} "GITDIR-NOTFOUND" PARENT_SCOPE) - return() - endif() - set(GIT_DIR "${GIT_PARENT_DIR}/.git") - endwhile() - # check if this is a submodule - if(NOT IS_DIRECTORY ${GIT_DIR}) - file(READ ${GIT_DIR} submodule) - string(REGEX REPLACE "gitdir: (.*)\n$" "\\1" GIT_DIR_RELATIVE ${submodule}) - get_filename_component(SUBMODULE_DIR ${GIT_DIR} PATH) - get_filename_component(GIT_DIR ${SUBMODULE_DIR}/${GIT_DIR_RELATIVE} ABSOLUTE) - endif() - set(GIT_DATA "${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/git-data") - if(NOT EXISTS "${GIT_DATA}") - file(MAKE_DIRECTORY "${GIT_DATA}") - endif() - - if(NOT EXISTS "${GIT_DIR}/HEAD") - return() - endif() - set(HEAD_FILE "${GIT_DATA}/HEAD") - configure_file("${GIT_DIR}/HEAD" "${HEAD_FILE}" COPYONLY) - - configure_file("${_gitdescmoddir}/GetGitRevisionDescription.cmake.in" - "${GIT_DATA}/grabRef.cmake" - @ONLY) - include("${GIT_DATA}/grabRef.cmake") - - set(${_refspecvar} "${HEAD_REF}" PARENT_SCOPE) - set(${_hashvar} "${HEAD_HASH}" PARENT_SCOPE) -endfunction() - -function(git_describe _var) - if(NOT GIT_FOUND) - find_package(Git QUIET) - endif() - get_git_head_revision(refspec hash) - if(NOT GIT_FOUND) - set(${_var} "GIT-NOTFOUND" PARENT_SCOPE) - return() - endif() - if(NOT hash) - set(${_var} "HEAD-HASH-NOTFOUND" PARENT_SCOPE) - return() - endif() - - execute_process(COMMAND - "${GIT_EXECUTABLE}" - describe --abbrev=8 --tags --dirty - # ${hash} - WORKING_DIRECTORY - "${CMAKE_CURRENT_SOURCE_DIR}" - RESULT_VARIABLE - res - OUTPUT_VARIABLE - out - ERROR_QUIET - OUTPUT_STRIP_TRAILING_WHITESPACE) - if(NOT res EQUAL 0) - set(out "${out}-${res}-NOTFOUND") - endif() - - set(${_var} "${out}" PARENT_SCOPE) -endfunction() - -function(git_get_exact_tag _var) - git_describe(out --exact-match ${ARGN}) - set(${_var} "${out}" PARENT_SCOPE) -endfunction() - -function(git_local_changes _var) - if(NOT GIT_FOUND) - find_package(Git QUIET) - endif() - get_git_head_revision(refspec hash) - if(NOT GIT_FOUND) - set(${_var} "GIT-NOTFOUND" PARENT_SCOPE) - return() - endif() - if(NOT hash) - set(${_var} "HEAD-HASH-NOTFOUND" PARENT_SCOPE) - return() - endif() - - execute_process(COMMAND - "${GIT_EXECUTABLE}" - diff-index --quiet HEAD -- - WORKING_DIRECTORY - "${CMAKE_CURRENT_SOURCE_DIR}" - RESULT_VARIABLE - res - OUTPUT_VARIABLE - out - ERROR_QUIET - OUTPUT_STRIP_TRAILING_WHITESPACE) - if(res EQUAL 0) - set(${_var} "CLEAN" PARENT_SCOPE) - else() - set(${_var} "DIRTY" PARENT_SCOPE) - endif() -endfunction() diff --git a/OpenFAST/cmake/GetGitRevisionDescription.cmake.in b/OpenFAST/cmake/GetGitRevisionDescription.cmake.in deleted file mode 100644 index a0f9c60c3..000000000 --- a/OpenFAST/cmake/GetGitRevisionDescription.cmake.in +++ /dev/null @@ -1,44 +0,0 @@ -# -# Internal file for GetGitRevisionDescription.cmake -# -# Requires CMake 2.6 or newer (uses the 'function' command) -# -# Obtained from https://github.com/rpavlik/cmake-modules/blob/master/GetGitRevisionDescription.cmake.in -# on August 29 2017 -# -# Original Author: -# 2009-2010 Ryan Pavlik -# http://academic.cleardefinition.com -# Iowa State University HCI Graduate Program/VRAC -# -# Copyright Iowa State University 2009-2010. -# Distributed under the Boost Software License, Version 1.0. -# (See accompanying file LICENSE_1_0.txt or copy at -# http://www.boost.org/LICENSE_1_0.txt) - -set(HEAD_HASH) - -file(READ "@HEAD_FILE@" HEAD_CONTENTS LIMIT 1024) - -string(STRIP "${HEAD_CONTENTS}" HEAD_CONTENTS) -if(HEAD_CONTENTS MATCHES "ref") - # named branch - string(REPLACE "ref: " "" HEAD_REF "${HEAD_CONTENTS}") - if(EXISTS "@GIT_DIR@/${HEAD_REF}") - configure_file("@GIT_DIR@/${HEAD_REF}" "@GIT_DATA@/head-ref" COPYONLY) - else() - configure_file("@GIT_DIR@/packed-refs" "@GIT_DATA@/packed-refs" COPYONLY) - file(READ "@GIT_DATA@/packed-refs" PACKED_REFS) - if(${PACKED_REFS} MATCHES "([0-9a-z]*) ${HEAD_REF}") - set(HEAD_HASH "${CMAKE_MATCH_1}") - endif() - endif() -else() - # detached HEAD - configure_file("@GIT_DIR@/HEAD" "@GIT_DATA@/head-ref" COPYONLY) -endif() - -if(NOT HEAD_HASH) - file(READ "@GIT_DATA@/head-ref" HEAD_HASH LIMIT 8) - string(STRIP "${HEAD_HASH}" HEAD_HASH) -endif() \ No newline at end of file diff --git a/OpenFAST/cmake/OpenFASTConfig.cmake.in b/OpenFAST/cmake/OpenFASTConfig.cmake.in deleted file mode 100644 index 952563d3e..000000000 --- a/OpenFAST/cmake/OpenFASTConfig.cmake.in +++ /dev/null @@ -1,65 +0,0 @@ -# -# Copyright 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. -# - -@PACKAGE_INIT@ - -# Compilers use by OpenFAST build -set(OpenFAST_CXX_COMPILER "@CMAKE_CXX_COMPILER@") -set(OpenFAST_C_COMPILER "@CMAKE_C_COMPILER@") -set(OpenFAST_Fortran_COMPILER "@CMAKE_Fortran_COMPILER@") - -# Compiler flags used by OpenFAST build -set(OpenFAST_CXX_COMPILER_FLAGS "@CMAKE_CXX_FLAGS@") -set(OpenFAST_C_COMPILER_FLAGS "@CMAKE_C_FLAGS@") -set(OpenFAST_Fortran_COMPILER_FLAGS "@CMAKE_Fortran_FLAGS@") - -set_and_check(OpenFAST_INCLUDE_DIRS "@PACKAGE_INCLUDE_INSTALL_DIR@") -set_and_check(OpenFAST_LIBRARY_DIRS "@PACKAGE_LIB_INSTALL_DIR@") -set_and_check(OpenFAST_FTNMOD_DIR "@PACKAGE_FTNMOD_INSTALL_DIR@") - -set(OpenFAST_LIBRARIES "openfastlib") -set(OpenFAST_CPP_LIBRARIES "openfastcpplib") - -include("${CMAKE_CURRENT_LIST_DIR}/OpenFASTLibraries.cmake") - -set(OpenFAST_HAS_CXX_API @OpenFAST_HAS_CXX_API@) -set(OpenFAST_FOUND TRUE) - -if (NOT OpenFAST_FIND_COMPONENTS) - if (OpenFAST_HAS_CXX_API) - set(OpenFAST_FIND_COMPONENTS "openfastcpplib;openfastlib") - else() - set(OpenFAST_FIND_COMPONENTS "openfastlib") - endif() -endif () - -foreach (comp IN LISTS OpenFAST_FIND_COMPONENTS) - if (${comp} STREQUAL "openfastcpplib") - if (NOT OpenFAST_HAS_CXX_API) - set(OpenFAST_${comp}_FOUND FALSE) - message(WARNING "OpenFAST ${comp} NOT found") - if(OpenFAST_FIND_REQUIRED_${comp}) - set(OpenFAST_FOUND FALSE) - endif() - else() - set(OpenFAST_${comp}_FOUND TRUE) - endif() - else() - set(OpenFAST_${comp}_FOUND TRUE) - endif() -endforeach () - -check_required_components(OpenFAST) diff --git a/OpenFAST/cmake/OpenfastCmakeUtils.cmake b/OpenFAST/cmake/OpenfastCmakeUtils.cmake deleted file mode 100644 index 483758241..000000000 --- a/OpenFAST/cmake/OpenfastCmakeUtils.cmake +++ /dev/null @@ -1,66 +0,0 @@ -# -# Copyright 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. -# - -################################################################################ -# OpenFAST CMake Utilities -# -# This module contains various functions used within CMakeLists.txt. -# Consolidated here to provide a central place for edits/enhancements. -# -# Available functions: -# - generate_f90_types -# - set_registry_includes -# -################################################################################ - - -# -# GENERATE_F90TYPES - Generate *_Types.F90 files -# -# Usage: -# generate_f90_types(BeamDyn_Registry.txt BeamDyn_Types.f90) -# -# Inputs: -# - regfile (filename): Path to the .txt definitions file -# -# Outputs: -# - outfile (filename): Path to the F90 or C file to be generated -# -function(generate_f90_types regfile outfile) - get_filename_component(input ${regfile} ABSOLUTE) - get_filename_component(outdir ${outfile} DIRECTORY) - - add_custom_command( - OUTPUT ${outfile} - DEPENDS openfast_registry ${input} - COMMAND ${CMAKE_BINARY_DIR}/modules/openfast-registry/openfast_registry ${input} "-O" "${outdir}" ${OPENFAST_REGISTRY_INCLUDES} ${ARGN} - ) - set_source_files_properties(${output} PROPERTIES GENERATED TRUE) -endfunction(generate_f90_types) - -# -# SET_REGISTRY_INCLUDES - Set includes path for generating *_Types.f90 -# -# Utility function to create the includes path used when looking at module -# definitions for creating the Types.f90 files. -# -function(set_registry_includes modules_location) - foreach(IDIR IN ITEMS ${ARGN}) - set(OPENFAST_REGISTRY_INCLUDES - ${OPENFAST_REGISTRY_INCLUDES} -I ${CMAKE_SOURCE_DIR}/${modules_location}/${IDIR}/src - CACHE INTERNAL "Registry includes paths") - endforeach(IDIR IN ITEMS ${ARGN}) -endfunction(set_registry_includes) diff --git a/OpenFAST/cmake/OpenfastFortranOptions.cmake b/OpenFAST/cmake/OpenfastFortranOptions.cmake deleted file mode 100644 index 4e02fd463..000000000 --- a/OpenFAST/cmake/OpenfastFortranOptions.cmake +++ /dev/null @@ -1,234 +0,0 @@ -# -# Copyright 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. -# - -################################################################################ -# OpenFAST Fortran Options -# -# Utility functions to set Fortran compiler options depending on system -# architecture and compiler type. The entry point is the function -# `set_fast_fortran` that configures various options once the compiler is -# auto-detected. -# -# The remaining functions provide customization for specific compiler/arch to -# avoid nested if-else conditionals. -# -# Available functions: -# -# - set_fast_gfortran -# - set_fast_intel_fortran -# - set_fast_intel_fortran_posix -# - set_fast_intel_fortran_windows -# -################################################################################ - -# -# SET_FAST_FORTRAN - Set Fortran compiler options based on compiler/arch -# -macro(set_fast_fortran) - get_filename_component(FCNAME "${CMAKE_Fortran_COMPILER}" NAME) - - # Abort if we do not have gfortran or Intel Fortran Compiler. - if (NOT (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU" OR - ${CMAKE_Fortran_COMPILER_ID} MATCHES "^Intel")) - message(FATAL_ERROR "OpenFAST requires either GFortran or Intel Fortran Compiler. Compiler detected by CMake: ${FCNAME}.") - endif() - - # Verify proper compiler versions are available - # see https://github.com/OpenFAST/openfast/issues/88 - if(${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") - if("${CMAKE_Fortran_COMPILER_VERSION}" STREQUAL "") - message(WARNING "A version of GNU GFortran greater than 4.6.0 is required but CMake could not detect your GFortran version.") - elseif("${CMAKE_Fortran_COMPILER_VERSION}" VERSION_LESS "4.6.0") - message(FATAL_ERROR "A version of GNU GFortran greater than 4.6.0 is required. GFortran version detected by CMake: ${CMAKE_Fortran_COMPILER_VERSION}.") - endif() - elseif(${CMAKE_Fortran_COMPILER_ID} MATCHES "^Intel") - if("${CMAKE_Fortran_COMPILER_VERSION}" VERSION_LESS "11") - message(FATAL_ERROR "A version of Intel ifort greater than 11 is required. ifort version detected by CMake: ${CMAKE_Fortran_COMPILER_VERSION}.") - endif() - endif() - - # Force all .mod files to be stored in a single directory - set(CMAKE_Fortran_MODULE_DIRECTORY "${CMAKE_BINARY_DIR}/ftnmods" - CACHE STRING "Set the Fortran Modules directory" FORCE) - include_directories(${CMAKE_Fortran_MODULE_DIRECTORY}) - - # Get OS/Compiler specific options - if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") - set_fast_gfortran() - elseif(${CMAKE_Fortran_COMPILER_ID} MATCHES "^Intel") - set_fast_intel_fortran() - endif() -endmacro(set_fast_fortran) - -# -# CHECK_F2008_FEATURES - Check if Fortran2008 features are available -# -macro(check_f2008_features) - include(CheckFortranSourceCompiles) - check_fortran_source_compiles( - "program test - use iso_fortran_env, only: compiler_version, real32, real64, real128 - integer, parameter :: quki = real128 - integer, parameter :: dbki = real64 - integer, parameter :: reki = real32 - - end program test" - HAS_FORTRAN2008 - SRC_EXT F90) - if (HAS_FORTRAN2008) - message(STATUS "Enabling Fortran 2008 features") - add_definitions(-DHAS_FORTRAN2008_FEATURES) - endif() -endmacro(check_f2008_features) - -# -# SET_FAST_GFORTRAN - Customizations for GNU Fortran compiler -# -macro(set_fast_gfortran) - if(NOT WIN32) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fpic ") - set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -fpic") - endif(NOT WIN32) - - # Fix free-form compilation for OpenFAST - #set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-none -cpp -fopenmp") - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-none -cpp") - - # Disable stack reuse within routines: issues seen with gfortran 9.x, but others may also exhibit - # see section 3.16 of https://gcc.gnu.org/onlinedocs/gcc-9.2.0/gcc.pdf - # and https://github.com/OpenFAST/openfast/pull/595 - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fstack-reuse=none") - - # Deal with Double/Single precision - if (DOUBLE_PRECISION) - add_definitions(-DOPENFAST_DOUBLE_PRECISION) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fdefault-real-8") - endif (DOUBLE_PRECISION) - - # debug flags - if(CMAKE_BUILD_TYPE MATCHES Debug) - set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -fcheck=all,no-array-temps -pedantic -fbacktrace -finit-real=inf -finit-integer=9999." ) - endif() - - if(CYGWIN) - # increase the default 2MB stack size to 16 MB - MATH(EXPR stack_size "16 * 1024 * 1024") - set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS},--stack,${stack_size}") - endif() - - # OPENMP - if (OPENMP) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fopenmp") - set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -fopenmp" ) - endif() - - check_f2008_features() -endmacro(set_fast_gfortran) - -# -# SET_FAST_INTEL_FORTRAN - Customizations for Intel Fortran Compiler -# -macro(set_fast_intel_fortran) - if(WIN32) - set_fast_intel_fortran_windows() - else(WIN32) - set_fast_intel_fortran_posix() - endif(WIN32) -endmacro(set_fast_intel_fortran) - -# -# SET_FAST_INTEL_FORTRAN_POSIX - Customizations for Intel Fortran Compiler posix -# arch -# -macro(set_fast_intel_fortran_posix) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fpic -fpp") - # Deal with Double/Single precision - if (DOUBLE_PRECISION) - add_definitions(-DOPENFAST_DOUBLE_PRECISION) - if("${CMAKE_Fortran_COMPILER_VERSION}" VERSION_GREATER "19") - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -r8 -double-size 128") - else() - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -r8 -double_size 128") - endif() - endif (DOUBLE_PRECISION) - - # debug flags - if(CMAKE_BUILD_TYPE MATCHES Debug) - set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -check all,no-array-temps -traceback" ) - endif() - - # OPENMP - if (OPENMP) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -qopenmp") - set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -qopenmp" ) - endif() - - check_f2008_features() - - ### Intel profiling flags - - # https://software.intel.com/content/www/us/en/develop/documentation/fortran-compiler-developer-guide-and-reference/top/compiler-reference/compiler-options/compiler-option-details/optimization-report-options/qopt-report-qopt-report.html - # phases: vec, par, openmp - # set(CMAKE_Fortran_FLAGS_RELWITHDEBINFO "${CMAKE_Fortran_FLAGS_RELWITHDEBINFO} -qopt-report-phase=vec,openmp -qopt-report=5") - # set(CMAKE_Fortran_FLAGS_RELWITHDEBINFO "${CMAKE_Fortran_FLAGS_RELWITHDEBINFO} -qopt-report-routine=Create_Augmented_Ln2_Src_Mesh") # Create_Augmented_Ln2_Src_Mesh, Morison_CalcOutput, VariousWaves_Init - - # https://software.intel.com/content/www/us/en/develop/documentation/fortran-compiler-developer-guide-and-reference/top/compiler-reference/compiler-options/compiler-option-details/output-debug-and-precompiled-header-pch-options/debug-linux-and-macos.html - # set(CMAKE_Fortran_FLAGS_RELWITHDEBINFO "${CMAKE_Fortran_FLAGS_RELWITHDEBINFO} -debug all") - # set(CMAKE_Fortran_FLAGS_RELWITHDEBINFO "${CMAKE_Fortran_FLAGS_RELWITHDEBINFO} -debug inline-debug-info") - - # Intel processor feature sets - # https://software.intel.com/content/www/us/en/develop/documentation/fortran-compiler-developer-guide-and-reference/top/compiler-reference/compiler-options/compiler-option-details/code-generation-options/xhost-qxhost.html - # set(CMAKE_Fortran_FLAGS_RELWITHDEBINFO "${CMAKE_Fortran_FLAGS_RELWITHDEBINFO} -xHOST") # Use feature set for CPU used to compile - # set(CMAKE_Fortran_FLAGS_RELWITHDEBINFO "${CMAKE_Fortran_FLAGS_RELWITHDEBINFO} -xSKYLAKE-AVX512") # Use Eagle processor feature set -endmacro(set_fast_intel_fortran_posix) - -# -# SET_FAST_INTEL_FORTRAN_WINDOWS - Customizations for Intel Fortran Compiler -# windows arch -# -macro(set_fast_intel_fortran_windows) - # Turn off specific warnings - # - 5199: too many continuation lines - # - 5268: 132 column limit - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} /Qdiag-disable:5199,5268 /fpp") - - # Deal with Double/Single precision - if (DOUBLE_PRECISION) - add_definitions(-DOPENFAST_DOUBLE_PRECISION) - if("${CMAKE_Fortran_COMPILER_VERSION}" VERSION_GREATER "19") - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} /real-size:64 /double-size:128") - else() - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} /real_size:64 /double_size:128") - endif() - endif (DOUBLE_PRECISION) - - # increase the default 2MB stack size to 16 MB - MATH(EXPR stack_size "16 * 1024 * 1024") - set(CMAKE_EXE_LINKER_FLAGS "${CMAKE_EXE_LINKER_FLAGS} /STACK:${stack_size}") - - # debug flags - if(CMAKE_BUILD_TYPE MATCHES Debug) - set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} /check:all /traceback" ) - endif() - - # OPENMP - if (OPENMP) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} /qopenmp") - set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} /qopenmp" ) - endif() - - check_f2008_features() -endmacro(set_fast_intel_fortran_windows) diff --git a/OpenFAST/cmake/set_rpath.cmake b/OpenFAST/cmake/set_rpath.cmake deleted file mode 100644 index 0e3cb9a67..000000000 --- a/OpenFAST/cmake/set_rpath.cmake +++ /dev/null @@ -1,32 +0,0 @@ -# -# Copyright 2021 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. -# - -# Use, i.e. don't skip the full RPATH for the build tree -set(CMAKE_SKIP_BUILD_RPATH FALSE) - -# When building, don't use the install RPATH already (but later on when installing) -set(CMAKE_BUILD_WITH_INSTALL_RPATH FALSE) -set(CMAKE_INSTALL_RPATH "${CMAKE_INSTALL_PREFIX}/lib") - -# Add the automatically determined parts of the RPATH -# which point to directories outside the build tree to the install RPATH -set(CMAKE_INSTALL_RPATH_USE_LINK_PATH TRUE) - -# The RPATH to be used when installing, but only if it's not a system directory -list(FIND CMAKE_PLATFORM_IMPLICIT_LINK_DIRECTORIES "${CMAKE_INSTALL_PREFIX}/lib" isSystemDir) -if("${isSystemDir}" STREQUAL "-1") - set(CMAKE_INSTALL_RPATH "${CMAKE_INSTALL_PREFIX}/lib") -endif("${isSystemDir}" STREQUAL "-1") diff --git a/OpenFAST/docs/CMakeLists.txt b/OpenFAST/docs/CMakeLists.txt deleted file mode 100644 index 7e67f2f05..000000000 --- a/OpenFAST/docs/CMakeLists.txt +++ /dev/null @@ -1,43 +0,0 @@ -find_package(Doxygen) -find_package(Sphinx) - -if(NOT DOXYGEN_FOUND) - message(WARNING "Skipping Doxygen documentation due to missing dependencies.") -else() - configure_file(Doxyfile.in Doxyfile @ONLY) - file(COPY "DoxygenLayout.xml" DESTINATION ${CMAKE_CURRENT_BINARY_DIR}) - - add_custom_target(doxygen - COMMAND ${DOXYGEN_EXECUTABLE} "${CMAKE_CURRENT_BINARY_DIR}/Doxyfile" ) -endif() - -if(NOT SPHINX_FOUND) - message(WARNING "Skipping Sphinx documentation due to missing dependencies.") -else() - set(SPHINX_GENERATOR html) - file(COPY "conf.py" DESTINATION ${CMAKE_CURRENT_BINARY_DIR}) - file(COPY "_static" DESTINATION ${CMAKE_CURRENT_BINARY_DIR}) - - add_custom_target(sphinx - COMMAND ${SPHINX_EXECUTABLE} -b ${SPHINX_GENERATOR} - -c ${CMAKE_CURRENT_BINARY_DIR} - "${CMAKE_CURRENT_SOURCE_DIR}" "${CMAKE_CURRENT_BINARY_DIR}/${SPHINX_GENERATOR}" - ) - add_dependencies(sphinx doxygen) - add_custom_target(docs DEPENDS sphinx) - - # Add a sphinx-only HTML target to avoid building doxygen while developing documentation - add_custom_target(sphinx-html - COMMAND ${SPHINX_EXECUTABLE} -M html - "${CMAKE_CURRENT_SOURCE_DIR}" "${CMAKE_CURRENT_BINARY_DIR}" - -c ${CMAKE_CURRENT_SOURCE_DIR}) - - # PDF documentation generation using sphinx -> latex -> pdflatex - find_package(LATEX COMPONENTS PDFLATEX BIBTEX) - if (LATEX_FOUND) - add_custom_target(sphinx-pdf - COMMAND ${SPHINX_EXECUTABLE} -M latexpdf - "${CMAKE_CURRENT_SOURCE_DIR}" "${CMAKE_CURRENT_BINARY_DIR}" - -c ${CMAKE_CURRENT_BINARY_DIR}) - endif() -endif() diff --git a/OpenFAST/docs/Doxyfile.in b/OpenFAST/docs/Doxyfile.in deleted file mode 100644 index 88c8b3b1f..000000000 --- a/OpenFAST/docs/Doxyfile.in +++ /dev/null @@ -1,2514 +0,0 @@ -# Doxyfile 1.8.16 - -# This file describes the settings to be used by the documentation system -# doxygen (www.doxygen.org) for a project. -# -# All text after a double hash (##) is considered a comment and is placed in -# front of the TAG it is preceding. -# -# All text after a single hash (#) is considered a comment and will be ignored. -# The format is: -# TAG = value [value, ...] -# For lists, items can also be appended using: -# TAG += value [value, ...] -# Values that contain spaces should be placed between quotes (\" \"). - -#--------------------------------------------------------------------------- -# Project related configuration options -#--------------------------------------------------------------------------- - -# This tag specifies the encoding used for all characters in the configuration -# file that follow. The default is UTF-8 which is also the encoding used for all -# text before the first occurrence of this tag. Doxygen uses libiconv (or the -# iconv built into libc) for the transcoding. See -# https://www.gnu.org/software/libiconv/ for the list of possible encodings. -# The default value is: UTF-8. - -DOXYFILE_ENCODING = UTF-8 - -# The PROJECT_NAME tag is a single word (or a sequence of words surrounded by -# double-quotes, unless you are using Doxywizard) that should identify the -# project for which the documentation is generated. This name is used in the -# title of most generated pages and in a few other places. -# The default value is: My Project. - -PROJECT_NAME = "OpenFAST" - -# The PROJECT_NUMBER tag can be used to enter a project or revision number. This -# could be handy for archiving the generated documentation or if some version -# control system is used. - -PROJECT_NUMBER = - -# Using the PROJECT_BRIEF tag one can provide an optional one line description -# for a project that appears at the top of each page and should give viewer a -# quick idea about the purpose of the project. Keep the description short. - -PROJECT_BRIEF = "Wind turbine multiphysics simulator" - -# With the PROJECT_LOGO tag one can specify a logo or an icon that is included -# in the documentation. The maximum height of the logo should not exceed 55 -# pixels and the maximum width should not exceed 200 pixels. Doxygen will copy -# the logo to the output directory. - -PROJECT_LOGO = @CMAKE_BINARY_DIR@/docs/_static/openfastlogo.jpg - -# The OUTPUT_DIRECTORY tag is used to specify the (relative or absolute) path -# into which the generated documentation will be written. If a relative path is -# entered, it will be relative to the location where doxygen was started. If -# left blank the current directory will be used. - -OUTPUT_DIRECTORY = @CMAKE_BINARY_DIR@/docs/doxygen - -# If the CREATE_SUBDIRS tag is set to YES then doxygen will create 4096 sub- -# directories (in 2 levels) under the output directory of each output format and -# will distribute the generated files over these directories. Enabling this -# option can be useful when feeding doxygen a huge amount of source files, where -# putting all generated files in the same directory would otherwise causes -# performance problems for the file system. -# The default value is: NO. - -CREATE_SUBDIRS = NO - -# If the ALLOW_UNICODE_NAMES tag is set to YES, doxygen will allow non-ASCII -# characters to appear in the names of generated files. If set to NO, non-ASCII -# characters will be escaped, for example _xE3_x81_x84 will be used for Unicode -# U+3044. -# The default value is: NO. - -ALLOW_UNICODE_NAMES = NO - -# The OUTPUT_LANGUAGE tag is used to specify the language in which all -# documentation generated by doxygen is written. Doxygen will use this -# information to generate all constant output in the proper language. -# Possible values are: Afrikaans, Arabic, Armenian, Brazilian, Catalan, Chinese, -# Chinese-Traditional, Croatian, Czech, Danish, Dutch, English (United States), -# Esperanto, Farsi (Persian), Finnish, French, German, Greek, Hungarian, -# Indonesian, Italian, Japanese, Japanese-en (Japanese with English messages), -# Korean, Korean-en (Korean with English messages), Latvian, Lithuanian, -# Macedonian, Norwegian, Persian (Farsi), Polish, Portuguese, Romanian, Russian, -# Serbian, Serbian-Cyrillic, Slovak, Slovene, Spanish, Swedish, Turkish, -# Ukrainian and Vietnamese. -# The default value is: English. - -OUTPUT_LANGUAGE = English - -# The OUTPUT_TEXT_DIRECTION tag is used to specify the direction in which all -# documentation generated by doxygen is written. Doxygen will use this -# information to generate all generated output in the proper direction. -# Possible values are: None, LTR, RTL and Context. -# The default value is: None. - -OUTPUT_TEXT_DIRECTION = None - -# If the BRIEF_MEMBER_DESC tag is set to YES, doxygen will include brief member -# descriptions after the members that are listed in the file and class -# documentation (similar to Javadoc). Set to NO to disable this. -# The default value is: YES. - -BRIEF_MEMBER_DESC = YES - -# If the REPEAT_BRIEF tag is set to YES, doxygen will prepend the brief -# description of a member or function before the detailed description -# -# Note: If both HIDE_UNDOC_MEMBERS and BRIEF_MEMBER_DESC are set to NO, the -# brief descriptions will be completely suppressed. -# The default value is: YES. - -REPEAT_BRIEF = YES - -# This tag implements a quasi-intelligent brief description abbreviator that is -# used to form the text in various listings. Each string in this list, if found -# as the leading text of the brief description, will be stripped from the text -# and the result, after processing the whole list, is used as the annotated -# text. Otherwise, the brief description is used as-is. If left blank, the -# following values are used ($name is automatically replaced with the name of -# the entity):The $name class, The $name widget, The $name file, is, provides, -# specifies, contains, represents, a, an and the. - -ABBREVIATE_BRIEF = "The $name class" \ - "The $name widget" \ - "The $name file" \ - is \ - provides \ - specifies \ - contains \ - represents \ - a \ - an \ - the - -# If the ALWAYS_DETAILED_SEC and REPEAT_BRIEF tags are both set to YES then -# doxygen will generate a detailed section even if there is only a brief -# description. -# The default value is: NO. - -ALWAYS_DETAILED_SEC = NO - -# If the INLINE_INHERITED_MEMB tag is set to YES, doxygen will show all -# inherited members of a class in the documentation of that class as if those -# members were ordinary class members. Constructors, destructors and assignment -# operators of the base classes will not be shown. -# The default value is: NO. - -INLINE_INHERITED_MEMB = NO - -# If the FULL_PATH_NAMES tag is set to YES, doxygen will prepend the full path -# before files name in the file list and in the header files. If set to NO the -# shortest path that makes the file name unique will be used -# The default value is: YES. - -FULL_PATH_NAMES = NO - -# The STRIP_FROM_PATH tag can be used to strip a user-defined part of the path. -# Stripping is only done if one of the specified strings matches the left-hand -# part of the path. The tag can be used to show relative paths in the file list. -# If left blank the directory from which doxygen is run is used as the path to -# strip. -# -# Note that you can specify absolute paths here, but also relative paths, which -# will be relative from the directory where doxygen is started. -# This tag requires that the tag FULL_PATH_NAMES is set to YES. - -STRIP_FROM_PATH = - -# The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of the -# path mentioned in the documentation of a class, which tells the reader which -# header file to include in order to use a class. If left blank only the name of -# the header file containing the class definition is used. Otherwise one should -# specify the list of include paths that are normally passed to the compiler -# using the -I flag. - -STRIP_FROM_INC_PATH = - -# If the SHORT_NAMES tag is set to YES, doxygen will generate much shorter (but -# less readable) file names. This can be useful is your file systems doesn't -# support long names like on DOS, Mac, or CD-ROM. -# The default value is: NO. - -SHORT_NAMES = NO - -# If the JAVADOC_AUTOBRIEF tag is set to YES then doxygen will interpret the -# first line (until the first dot) of a Javadoc-style comment as the brief -# description. If set to NO, the Javadoc-style will behave just like regular Qt- -# style comments (thus requiring an explicit @brief command for a brief -# description.) -# The default value is: NO. - -JAVADOC_AUTOBRIEF = YES - -# If the JAVADOC_BANNER tag is set to YES then doxygen will interpret a line -# such as -# /*************** -# as being the beginning of a Javadoc-style comment "banner". If set to NO, the -# Javadoc-style will behave just like regular comments and it will not be -# interpreted by doxygen. -# The default value is: NO. - -JAVADOC_BANNER = YES - -# If the QT_AUTOBRIEF tag is set to YES then doxygen will interpret the first -# line (until the first dot) of a Qt-style comment as the brief description. If -# set to NO, the Qt-style will behave just like regular Qt-style comments (thus -# requiring an explicit \brief command for a brief description.) -# The default value is: NO. - -QT_AUTOBRIEF = NO - -# The MULTILINE_CPP_IS_BRIEF tag can be set to YES to make doxygen treat a -# multi-line C++ special comment block (i.e. a block of //! or /// comments) as -# a brief description. This used to be the default behavior. The new default is -# to treat a multi-line C++ comment block as a detailed description. Set this -# tag to YES if you prefer the old behavior instead. -# -# Note that setting this tag to YES also means that rational rose comments are -# not recognized any more. -# The default value is: NO. - -MULTILINE_CPP_IS_BRIEF = NO - -# If the INHERIT_DOCS tag is set to YES then an undocumented member inherits the -# documentation from any documented member that it re-implements. -# The default value is: YES. - -INHERIT_DOCS = YES - -# If the SEPARATE_MEMBER_PAGES tag is set to YES then doxygen will produce a new -# page for each member. If set to NO, the documentation of a member will be part -# of the file/class/namespace that contains it. -# The default value is: NO. - -SEPARATE_MEMBER_PAGES = NO - -# The TAB_SIZE tag can be used to set the number of spaces in a tab. Doxygen -# uses this value to replace tabs by spaces in code fragments. -# Minimum value: 1, maximum value: 16, default value: 4. - -TAB_SIZE = 4 - -# This tag can be used to specify a number of aliases that act as commands in -# the documentation. An alias has the form: -# name=value -# For example adding -# "sideeffect=@par Side Effects:\n" -# will allow you to put the command \sideeffect (or @sideeffect) in the -# documentation, which will result in a user-defined paragraph with heading -# "Side Effects:". You can put \n's in the value part of an alias to insert -# newlines (in the resulting output). You can put ^^ in the value part of an -# alias to insert a newline as if a physical newline was in the original file. -# When you need a literal { or } or , in the value part of an alias you have to -# escape them by means of a backslash (\), this can lead to conflicts with the -# commands \{ and \} for these it is advised to use the version @{ and @} or use -# a double escape (\\{ and \\}) - -ALIASES = - -# This tag can be used to specify a number of word-keyword mappings (TCL only). -# A mapping has the form "name=value". For example adding "class=itcl::class" -# will allow you to use the command class in the itcl::class meaning. - -TCL_SUBST = - -# Set the OPTIMIZE_OUTPUT_FOR_C tag to YES if your project consists of C sources -# only. Doxygen will then generate output that is more tailored for C. For -# instance, some of the names that are used will be different. The list of all -# members will be omitted, etc. -# The default value is: NO. - -OPTIMIZE_OUTPUT_FOR_C = NO - -# Set the OPTIMIZE_OUTPUT_JAVA tag to YES if your project consists of Java or -# Python sources only. Doxygen will then generate output that is more tailored -# for that language. For instance, namespaces will be presented as packages, -# qualified scopes will look different, etc. -# The default value is: NO. - -OPTIMIZE_OUTPUT_JAVA = NO - -# Set the OPTIMIZE_FOR_FORTRAN tag to YES if your project consists of Fortran -# sources. Doxygen will then generate output that is tailored for Fortran. -# The default value is: NO. - -OPTIMIZE_FOR_FORTRAN = YES - -# Set the OPTIMIZE_OUTPUT_VHDL tag to YES if your project consists of VHDL -# sources. Doxygen will then generate output that is tailored for VHDL. -# The default value is: NO. - -OPTIMIZE_OUTPUT_VHDL = NO - -# Set the OPTIMIZE_OUTPUT_SLICE tag to YES if your project consists of Slice -# sources only. Doxygen will then generate output that is more tailored for that -# language. For instance, namespaces will be presented as modules, types will be -# separated into more groups, etc. -# The default value is: NO. - -OPTIMIZE_OUTPUT_SLICE = NO - -# Doxygen selects the parser to use depending on the extension of the files it -# parses. With this tag you can assign which parser to use for a given -# extension. Doxygen has a built-in mapping, but you can override or extend it -# using this tag. The format is ext=language, where ext is a file extension, and -# language is one of the parsers supported by doxygen: IDL, Java, Javascript, -# Csharp (C#), C, C++, D, PHP, md (Markdown), Objective-C, Python, Slice, -# Fortran (fixed format Fortran: FortranFixed, free formatted Fortran: -# FortranFree, unknown formatted Fortran: Fortran. In the later case the parser -# tries to guess whether the code is fixed or free formatted code, this is the -# default for Fortran type files), VHDL, tcl. For instance to make doxygen treat -# .inc files as Fortran files (default is PHP), and .f files as C (default is -# Fortran), use: inc=Fortran f=C. -# -# Note: For files without extension you can use no_extension as a placeholder. -# -# Note that for custom extensions you also need to set FILE_PATTERNS otherwise -# the files are not read by doxygen. - -EXTENSION_MAPPING = - -# If the MARKDOWN_SUPPORT tag is enabled then doxygen pre-processes all comments -# according to the Markdown format, which allows for more readable -# documentation. See https://daringfireball.net/projects/markdown/ for details. -# The output of markdown processing is further processed by doxygen, so you can -# mix doxygen, HTML, and XML commands with Markdown formatting. Disable only in -# case of backward compatibilities issues. -# The default value is: YES. - -MARKDOWN_SUPPORT = YES - -# When the TOC_INCLUDE_HEADINGS tag is set to a non-zero value, all headings up -# to that level are automatically included in the table of contents, even if -# they do not have an id attribute. -# Note: This feature currently applies only to Markdown headings. -# Minimum value: 0, maximum value: 99, default value: 5. -# This tag requires that the tag MARKDOWN_SUPPORT is set to YES. - -TOC_INCLUDE_HEADINGS = 5 - -# When enabled doxygen tries to link words that correspond to documented -# classes, or namespaces to their corresponding documentation. Such a link can -# be prevented in individual cases by putting a % sign in front of the word or -# globally by setting AUTOLINK_SUPPORT to NO. -# The default value is: YES. - -AUTOLINK_SUPPORT = YES - -# If you use STL classes (i.e. std::string, std::vector, etc.) but do not want -# to include (a tag file for) the STL sources as input, then you should set this -# tag to YES in order to let doxygen match functions declarations and -# definitions whose arguments contain STL classes (e.g. func(std::string); -# versus func(std::string) {}). This also make the inheritance and collaboration -# diagrams that involve STL classes more complete and accurate. -# The default value is: NO. - -BUILTIN_STL_SUPPORT = YES - -# If you use Microsoft's C++/CLI language, you should set this option to YES to -# enable parsing support. -# The default value is: NO. - -CPP_CLI_SUPPORT = NO - -# Set the SIP_SUPPORT tag to YES if your project consists of sip (see: -# https://www.riverbankcomputing.com/software/sip/intro) sources only. Doxygen -# will parse them like normal C++ but will assume all classes use public instead -# of private inheritance when no explicit protection keyword is present. -# The default value is: NO. - -SIP_SUPPORT = NO - -# For Microsoft's IDL there are propget and propput attributes to indicate -# getter and setter methods for a property. Setting this option to YES will make -# doxygen to replace the get and set methods by a property in the documentation. -# This will only work if the methods are indeed getting or setting a simple -# type. If this is not the case, or you want to show the methods anyway, you -# should set this option to NO. -# The default value is: YES. - -IDL_PROPERTY_SUPPORT = NO - -# If member grouping is used in the documentation and the DISTRIBUTE_GROUP_DOC -# tag is set to YES then doxygen will reuse the documentation of the first -# member in the group (if any) for the other members of the group. By default -# all members of a group must be documented explicitly. -# The default value is: NO. - -DISTRIBUTE_GROUP_DOC = NO - -# If one adds a struct or class to a group and this option is enabled, then also -# any nested class or struct is added to the same group. By default this option -# is disabled and one has to add nested compounds explicitly via \ingroup. -# The default value is: NO. - -GROUP_NESTED_COMPOUNDS = NO - -# Set the SUBGROUPING tag to YES to allow class member groups of the same type -# (for instance a group of public functions) to be put as a subgroup of that -# type (e.g. under the Public Functions section). Set it to NO to prevent -# subgrouping. Alternatively, this can be done per class using the -# \nosubgrouping command. -# The default value is: YES. - -SUBGROUPING = YES - -# When the INLINE_GROUPED_CLASSES tag is set to YES, classes, structs and unions -# are shown inside the group in which they are included (e.g. using \ingroup) -# instead of on a separate page (for HTML and Man pages) or section (for LaTeX -# and RTF). -# -# Note that this feature does not work in combination with -# SEPARATE_MEMBER_PAGES. -# The default value is: NO. - -INLINE_GROUPED_CLASSES = NO - -# When the INLINE_SIMPLE_STRUCTS tag is set to YES, structs, classes, and unions -# with only public data fields or simple typedef fields will be shown inline in -# the documentation of the scope in which they are defined (i.e. file, -# namespace, or group documentation), provided this scope is documented. If set -# to NO, structs, classes, and unions are shown on a separate page (for HTML and -# Man pages) or section (for LaTeX and RTF). -# The default value is: NO. - -INLINE_SIMPLE_STRUCTS = NO - -# When TYPEDEF_HIDES_STRUCT tag is enabled, a typedef of a struct, union, or -# enum is documented as struct, union, or enum with the name of the typedef. So -# typedef struct TypeS {} TypeT, will appear in the documentation as a struct -# with name TypeT. When disabled the typedef will appear as a member of a file, -# namespace, or class. And the struct will be named TypeS. This can typically be -# useful for C code in case the coding convention dictates that all compound -# types are typedef'ed and only the typedef is referenced, never the tag name. -# The default value is: NO. - -TYPEDEF_HIDES_STRUCT = NO - -# The size of the symbol lookup cache can be set using LOOKUP_CACHE_SIZE. This -# cache is used to resolve symbols given their name and scope. Since this can be -# an expensive process and often the same symbol appears multiple times in the -# code, doxygen keeps a cache of pre-resolved symbols. If the cache is too small -# doxygen will become slower. If the cache is too large, memory is wasted. The -# cache size is given by this formula: 2^(16+LOOKUP_CACHE_SIZE). The valid range -# is 0..9, the default is 0, corresponding to a cache size of 2^16=65536 -# symbols. At the end of a run doxygen will report the cache usage and suggest -# the optimal cache size from a speed point of view. -# Minimum value: 0, maximum value: 9, default value: 0. - -LOOKUP_CACHE_SIZE = 0 - -#--------------------------------------------------------------------------- -# Build related configuration options -#--------------------------------------------------------------------------- - -# If the EXTRACT_ALL tag is set to YES, doxygen will assume all entities in -# documentation are documented, even if no documentation was available. Private -# class members and static file members will be hidden unless the -# EXTRACT_PRIVATE respectively EXTRACT_STATIC tags are set to YES. -# Note: This will also disable the warnings about undocumented members that are -# normally produced when WARNINGS is set to YES. -# The default value is: NO. - -EXTRACT_ALL = NO - -# If the EXTRACT_PRIVATE tag is set to YES, all private members of a class will -# be included in the documentation. -# The default value is: NO. - -EXTRACT_PRIVATE = YES - -# If the EXTRACT_PRIV_VIRTUAL tag is set to YES, documented private virtual -# methods of a class will be included in the documentation. -# The default value is: NO. - -EXTRACT_PRIV_VIRTUAL = NO - -# If the EXTRACT_PACKAGE tag is set to YES, all members with package or internal -# scope will be included in the documentation. -# The default value is: NO. - -EXTRACT_PACKAGE = NO - -# If the EXTRACT_STATIC tag is set to YES, all static members of a file will be -# included in the documentation. -# The default value is: NO. - -EXTRACT_STATIC = YES - -# If the EXTRACT_LOCAL_CLASSES tag is set to YES, classes (and structs) defined -# locally in source files will be included in the documentation. If set to NO, -# only classes defined in header files are included. Does not have any effect -# for Java sources. -# The default value is: YES. - -EXTRACT_LOCAL_CLASSES = YES - -# This flag is only useful for Objective-C code. If set to YES, local methods, -# which are defined in the implementation section but not in the interface are -# included in the documentation. If set to NO, only methods in the interface are -# included. -# The default value is: NO. - -EXTRACT_LOCAL_METHODS = NO - -# If this flag is set to YES, the members of anonymous namespaces will be -# extracted and appear in the documentation as a namespace called -# 'anonymous_namespace{file}', where file will be replaced with the base name of -# the file that contains the anonymous namespace. By default anonymous namespace -# are hidden. -# The default value is: NO. - -EXTRACT_ANON_NSPACES = YES - -# If the HIDE_UNDOC_MEMBERS tag is set to YES, doxygen will hide all -# undocumented members inside documented classes or files. If set to NO these -# members will be included in the various overviews, but no documentation -# section is generated. This option has no effect if EXTRACT_ALL is enabled. -# The default value is: NO. - -HIDE_UNDOC_MEMBERS = NO - -# If the HIDE_UNDOC_CLASSES tag is set to YES, doxygen will hide all -# undocumented classes that are normally visible in the class hierarchy. If set -# to NO, these classes will be included in the various overviews. This option -# has no effect if EXTRACT_ALL is enabled. -# The default value is: NO. - -HIDE_UNDOC_CLASSES = NO - -# If the HIDE_FRIEND_COMPOUNDS tag is set to YES, doxygen will hide all friend -# (class|struct|union) declarations. If set to NO, these declarations will be -# included in the documentation. -# The default value is: NO. - -HIDE_FRIEND_COMPOUNDS = NO - -# If the HIDE_IN_BODY_DOCS tag is set to YES, doxygen will hide any -# documentation blocks found inside the body of a function. If set to NO, these -# blocks will be appended to the function's detailed documentation block. -# The default value is: NO. - -HIDE_IN_BODY_DOCS = NO - -# The INTERNAL_DOCS tag determines if documentation that is typed after a -# \internal command is included. If the tag is set to NO then the documentation -# will be excluded. Set it to YES to include the internal documentation. -# The default value is: NO. - -INTERNAL_DOCS = NO - -# If the CASE_SENSE_NAMES tag is set to NO then doxygen will only generate file -# names in lower-case letters. If set to YES, upper-case letters are also -# allowed. This is useful if you have classes or files whose names only differ -# in case and if your file system supports case sensitive file names. Windows -# (including Cygwin) ands Mac users are advised to set this option to NO. -# The default value is: system dependent. - -CASE_SENSE_NAMES = NO - -# If the HIDE_SCOPE_NAMES tag is set to NO then doxygen will show members with -# their full class and namespace scopes in the documentation. If set to YES, the -# scope will be hidden. -# The default value is: NO. - -HIDE_SCOPE_NAMES = NO - -# If the HIDE_COMPOUND_REFERENCE tag is set to NO (default) then doxygen will -# append additional text to a page's title, such as Class Reference. If set to -# YES the compound reference will be hidden. -# The default value is: NO. - -HIDE_COMPOUND_REFERENCE= NO - -# If the SHOW_INCLUDE_FILES tag is set to YES then doxygen will put a list of -# the files that are included by a file in the documentation of that file. -# The default value is: YES. - -SHOW_INCLUDE_FILES = YES - -# If the SHOW_GROUPED_MEMB_INC tag is set to YES then Doxygen will add for each -# grouped member an include statement to the documentation, telling the reader -# which file to include in order to use the member. -# The default value is: NO. - -SHOW_GROUPED_MEMB_INC = NO - -# If the FORCE_LOCAL_INCLUDES tag is set to YES then doxygen will list include -# files with double quotes in the documentation rather than with sharp brackets. -# The default value is: NO. - -FORCE_LOCAL_INCLUDES = NO - -# If the INLINE_INFO tag is set to YES then a tag [inline] is inserted in the -# documentation for inline members. -# The default value is: YES. - -INLINE_INFO = YES - -# If the SORT_MEMBER_DOCS tag is set to YES then doxygen will sort the -# (detailed) documentation of file and class members alphabetically by member -# name. If set to NO, the members will appear in declaration order. -# The default value is: YES. - -SORT_MEMBER_DOCS = YES - -# If the SORT_BRIEF_DOCS tag is set to YES then doxygen will sort the brief -# descriptions of file, namespace and class members alphabetically by member -# name. If set to NO, the members will appear in declaration order. Note that -# this will also influence the order of the classes in the class list. -# The default value is: NO. - -SORT_BRIEF_DOCS = NO - -# If the SORT_MEMBERS_CTORS_1ST tag is set to YES then doxygen will sort the -# (brief and detailed) documentation of class members so that constructors and -# destructors are listed first. If set to NO the constructors will appear in the -# respective orders defined by SORT_BRIEF_DOCS and SORT_MEMBER_DOCS. -# Note: If SORT_BRIEF_DOCS is set to NO this option is ignored for sorting brief -# member documentation. -# Note: If SORT_MEMBER_DOCS is set to NO this option is ignored for sorting -# detailed member documentation. -# The default value is: NO. - -SORT_MEMBERS_CTORS_1ST = NO - -# If the SORT_GROUP_NAMES tag is set to YES then doxygen will sort the hierarchy -# of group names into alphabetical order. If set to NO the group names will -# appear in their defined order. -# The default value is: NO. - -SORT_GROUP_NAMES = NO - -# If the SORT_BY_SCOPE_NAME tag is set to YES, the class list will be sorted by -# fully-qualified names, including namespaces. If set to NO, the class list will -# be sorted only by class name, not including the namespace part. -# Note: This option is not very useful if HIDE_SCOPE_NAMES is set to YES. -# Note: This option applies only to the class list, not to the alphabetical -# list. -# The default value is: NO. - -SORT_BY_SCOPE_NAME = NO - -# If the STRICT_PROTO_MATCHING option is enabled and doxygen fails to do proper -# type resolution of all parameters of a function it will reject a match between -# the prototype and the implementation of a member function even if there is -# only one candidate or it is obvious which candidate to choose by doing a -# simple string match. By disabling STRICT_PROTO_MATCHING doxygen will still -# accept a match between prototype and implementation in such cases. -# The default value is: NO. - -STRICT_PROTO_MATCHING = NO - -# The GENERATE_TODOLIST tag can be used to enable (YES) or disable (NO) the todo -# list. This list is created by putting \todo commands in the documentation. -# The default value is: YES. - -GENERATE_TODOLIST = YES - -# The GENERATE_TESTLIST tag can be used to enable (YES) or disable (NO) the test -# list. This list is created by putting \test commands in the documentation. -# The default value is: YES. - -GENERATE_TESTLIST = YES - -# The GENERATE_BUGLIST tag can be used to enable (YES) or disable (NO) the bug -# list. This list is created by putting \bug commands in the documentation. -# The default value is: YES. - -GENERATE_BUGLIST = YES - -# The GENERATE_DEPRECATEDLIST tag can be used to enable (YES) or disable (NO) -# the deprecated list. This list is created by putting \deprecated commands in -# the documentation. -# The default value is: YES. - -GENERATE_DEPRECATEDLIST= YES - -# The ENABLED_SECTIONS tag can be used to enable conditional documentation -# sections, marked by \if ... \endif and \cond -# ... \endcond blocks. - -ENABLED_SECTIONS = - -# The MAX_INITIALIZER_LINES tag determines the maximum number of lines that the -# initial value of a variable or macro / define can have for it to appear in the -# documentation. If the initializer consists of more lines than specified here -# it will be hidden. Use a value of 0 to hide initializers completely. The -# appearance of the value of individual variables and macros / defines can be -# controlled using \showinitializer or \hideinitializer command in the -# documentation regardless of this setting. -# Minimum value: 0, maximum value: 10000, default value: 30. - -MAX_INITIALIZER_LINES = 30 - -# Set the SHOW_USED_FILES tag to NO to disable the list of files generated at -# the bottom of the documentation of classes and structs. If set to YES, the -# list will mention the files that were used to generate the documentation. -# The default value is: YES. - -SHOW_USED_FILES = YES - -# Set the SHOW_FILES tag to NO to disable the generation of the Files page. This -# will remove the Files entry from the Quick Index and from the Folder Tree View -# (if specified). -# The default value is: YES. - -SHOW_FILES = YES - -# Set the SHOW_NAMESPACES tag to NO to disable the generation of the Namespaces -# page. This will remove the Namespaces entry from the Quick Index and from the -# Folder Tree View (if specified). -# The default value is: YES. - -SHOW_NAMESPACES = YES - -# The FILE_VERSION_FILTER tag can be used to specify a program or script that -# doxygen should invoke to get the current version for each file (typically from -# the version control system). Doxygen will invoke the program by executing (via -# popen()) the command command input-file, where command is the value of the -# FILE_VERSION_FILTER tag, and input-file is the name of an input file provided -# by doxygen. Whatever the program writes to standard output is used as the file -# version. For an example see the documentation. - -FILE_VERSION_FILTER = - -# The LAYOUT_FILE tag can be used to specify a layout file which will be parsed -# by doxygen. The layout file controls the global structure of the generated -# output files in an output format independent way. To create the layout file -# that represents doxygen's defaults, run doxygen with the -l option. You can -# optionally specify a file name after the option, if omitted DoxygenLayout.xml -# will be used as the name of the layout file. -# -# Note that if you run doxygen from a directory containing a file called -# DoxygenLayout.xml, doxygen will parse it automatically even if the LAYOUT_FILE -# tag is left empty. - -LAYOUT_FILE = - -# The CITE_BIB_FILES tag can be used to specify one or more bib files containing -# the reference definitions. This must be a list of .bib files. The .bib -# extension is automatically appended if omitted. This requires the bibtex tool -# to be installed. See also https://en.wikipedia.org/wiki/BibTeX for more info. -# For LaTeX the style of the bibliography can be controlled using -# LATEX_BIB_STYLE. To use this feature you need bibtex and perl available in the -# search path. See also \cite for info how to create references. - -CITE_BIB_FILES = - -#--------------------------------------------------------------------------- -# Configuration options related to warning and progress messages -#--------------------------------------------------------------------------- - -# The QUIET tag can be used to turn on/off the messages that are generated to -# standard output by doxygen. If QUIET is set to YES this implies that the -# messages are off. -# The default value is: NO. - -QUIET = NO - -# The WARNINGS tag can be used to turn on/off the warning messages that are -# generated to standard error (stderr) by doxygen. If WARNINGS is set to YES -# this implies that the warnings are on. -# -# Tip: Turn warnings on while writing the documentation. -# The default value is: YES. - -WARNINGS = YES - -# If the WARN_IF_UNDOCUMENTED tag is set to YES then doxygen will generate -# warnings for undocumented members. If EXTRACT_ALL is set to YES then this flag -# will automatically be disabled. -# The default value is: YES. - -WARN_IF_UNDOCUMENTED = YES - -# If the WARN_IF_DOC_ERROR tag is set to YES, doxygen will generate warnings for -# potential errors in the documentation, such as not documenting some parameters -# in a documented function, or documenting parameters that don't exist or using -# markup commands wrongly. -# The default value is: YES. - -WARN_IF_DOC_ERROR = YES - -# This WARN_NO_PARAMDOC option can be enabled to get warnings for functions that -# are documented, but have no documentation for their parameters or return -# value. If set to NO, doxygen will only warn about wrong or incomplete -# parameter documentation, but not about the absence of documentation. If -# EXTRACT_ALL is set to YES then this flag will automatically be disabled. -# The default value is: NO. - -WARN_NO_PARAMDOC = NO - -# If the WARN_AS_ERROR tag is set to YES then doxygen will immediately stop when -# a warning is encountered. -# The default value is: NO. - -WARN_AS_ERROR = NO - -# The WARN_FORMAT tag determines the format of the warning messages that doxygen -# can produce. The string should contain the $file, $line, and $text tags, which -# will be replaced by the file and line number from which the warning originated -# and the warning text. Optionally the format may contain $version, which will -# be replaced by the version of the file (if it could be obtained via -# FILE_VERSION_FILTER) -# The default value is: $file:$line: $text. - -WARN_FORMAT = "$file:$line: $text" - -# The WARN_LOGFILE tag can be used to specify a file to which warning and error -# messages should be written. If left blank the output is written to standard -# error (stderr). - -WARN_LOGFILE = - -#--------------------------------------------------------------------------- -# Configuration options related to the input files -#--------------------------------------------------------------------------- - -# The INPUT tag is used to specify the files and/or directories that contain -# documented source files. You may enter file names like myfile.cpp or -# directories like /usr/src/myproject. Separate the files or directories with -# spaces. See also FILE_PATTERNS and EXTENSION_MAPPING -# Note: If this tag is empty the current directory is searched. - -INPUT = @CMAKE_SOURCE_DIR@/glue-codes/ \ - @CMAKE_SOURCE_DIR@/modules/ \ - -# This tag can be used to specify the character encoding of the source files -# that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses -# libiconv (or the iconv built into libc) for the transcoding. See the libiconv -# documentation (see: https://www.gnu.org/software/libiconv/) for the list of -# possible encodings. -# The default value is: UTF-8. - -INPUT_ENCODING = UTF-8 - -# If the value of the INPUT tag contains directories, you can use the -# FILE_PATTERNS tag to specify one or more wildcard patterns (like *.cpp and -# *.h) to filter out the source-files in the directories. -# -# Note that for custom extensions or not directly supported extensions you also -# need to set EXTENSION_MAPPING for the extension otherwise the files are not -# read by doxygen. -# -# If left blank the following patterns are tested:*.c, *.cc, *.cxx, *.cpp, -# *.c++, *.java, *.ii, *.ixx, *.ipp, *.i++, *.inl, *.idl, *.ddl, *.odl, *.h, -# *.hh, *.hxx, *.hpp, *.h++, *.cs, *.d, *.php, *.php4, *.php5, *.phtml, *.inc, -# *.m, *.markdown, *.md, *.mm, *.dox, *.py, *.pyw, *.f90, *.f95, *.f03, *.f08, -# *.f, *.for, *.tcl, *.vhd, *.vhdl, *.ucf and *.qsf. - -FILE_PATTERNS = *.f90 \ - *.F90 \ - *.f \ - *.F \ - *.for \ - *.c \ - *.cxx \ - *.cpp \ - *.C \ - *.cc \ - *.hh \ - *.hxx \ - *.hpp \ - *.h \ - *.py - -# The RECURSIVE tag can be used to specify whether or not subdirectories should -# be searched for input files as well. -# The default value is: NO. - -RECURSIVE = YES - -# The EXCLUDE tag can be used to specify files and/or directories that should be -# excluded from the INPUT source files. This way you can easily exclude a -# subdirectory from a directory tree whose root is specified with the INPUT tag. -# -# Note that relative paths are relative to the directory from which doxygen is -# run. - -EXCLUDE = - -# The EXCLUDE_SYMLINKS tag can be used to select whether or not files or -# directories that are symbolic links (a Unix file system feature) are excluded -# from the input. -# The default value is: NO. - -EXCLUDE_SYMLINKS = NO - -# If the value of the INPUT tag contains directories, you can use the -# EXCLUDE_PATTERNS tag to specify one or more wildcard patterns to exclude -# certain files from those directories. -# -# Note that the wildcards are matched against the file with absolute path, so to -# exclude all test directories for example use the pattern */test/* - -EXCLUDE_PATTERNS = @CMAKE_SOURCE_DIR@/.git/* \ - @CMAKE_SOURCE_DIR@/build/* \ - @CMAKE_SOURCE_DIR@/cmake/* \ - @CMAKE_SOURCE_DIR@/docs/* \ - @CMAKE_SOURCE_DIR@/modules/orcaflex-interface/src/OrcaFlexInterface.f90 \ - @CMAKE_SOURCE_DIR@/modules/servodyn/src/BladedInterface.f90 - -# The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names -# (namespaces, classes, functions, etc.) that should be excluded from the -# output. The symbol name can be a fully qualified name, a word, or if the -# wildcard * is used, a substring. Examples: ANamespace, AClass, -# AClass::ANamespace, ANamespace::*Test -# -# Note that the wildcards are matched against the file with absolute path, so to -# exclude all test directories use the pattern */test/* - -EXCLUDE_SYMBOLS = - -# The EXAMPLE_PATH tag can be used to specify one or more files or directories -# that contain example code fragments that are included (see the \include -# command). - -EXAMPLE_PATH = - -# If the value of the EXAMPLE_PATH tag contains directories, you can use the -# EXAMPLE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp and -# *.h) to filter out the source-files in the directories. If left blank all -# files are included. - -EXAMPLE_PATTERNS = * - -# If the EXAMPLE_RECURSIVE tag is set to YES then subdirectories will be -# searched for input files to be used with the \include or \dontinclude commands -# irrespective of the value of the RECURSIVE tag. -# The default value is: NO. - -EXAMPLE_RECURSIVE = NO - -# The IMAGE_PATH tag can be used to specify one or more files or directories -# that contain images that are to be included in the documentation (see the -# \image command). - -IMAGE_PATH = - -# The INPUT_FILTER tag can be used to specify a program that doxygen should -# invoke to filter for each input file. Doxygen will invoke the filter program -# by executing (via popen()) the command: -# -# -# -# where is the value of the INPUT_FILTER tag, and is the -# name of an input file. Doxygen will then use the output that the filter -# program writes to standard output. If FILTER_PATTERNS is specified, this tag -# will be ignored. -# -# Note that the filter must not add or remove lines; it is applied before the -# code is scanned, but not when the output code is generated. If lines are added -# or removed, the anchors will not be placed correctly. -# -# Note that for custom extensions or not directly supported extensions you also -# need to set EXTENSION_MAPPING for the extension otherwise the files are not -# properly processed by doxygen. - -INPUT_FILTER = - -# The FILTER_PATTERNS tag can be used to specify filters on a per file pattern -# basis. Doxygen will compare the file name with each pattern and apply the -# filter if there is a match. The filters are a list of the form: pattern=filter -# (like *.cpp=my_cpp_filter). See INPUT_FILTER for further information on how -# filters are used. If the FILTER_PATTERNS tag is empty or if none of the -# patterns match the file name, INPUT_FILTER is applied. -# -# Note that for custom extensions or not directly supported extensions you also -# need to set EXTENSION_MAPPING for the extension otherwise the files are not -# properly processed by doxygen. - -FILTER_PATTERNS = - -# If the FILTER_SOURCE_FILES tag is set to YES, the input filter (if set using -# INPUT_FILTER) will also be used to filter the input files that are used for -# producing the source files to browse (i.e. when SOURCE_BROWSER is set to YES). -# The default value is: NO. - -FILTER_SOURCE_FILES = NO - -# The FILTER_SOURCE_PATTERNS tag can be used to specify source filters per file -# pattern. A pattern will override the setting for FILTER_PATTERN (if any) and -# it is also possible to disable source filtering for a specific pattern using -# *.ext= (so without naming a filter). -# This tag requires that the tag FILTER_SOURCE_FILES is set to YES. - -FILTER_SOURCE_PATTERNS = - -# If the USE_MDFILE_AS_MAINPAGE tag refers to the name of a markdown file that -# is part of the input, its contents will be placed on the main page -# (index.html). This can be useful if you have a project on for instance GitHub -# and want to reuse the introduction page also for the doxygen output. - -USE_MDFILE_AS_MAINPAGE = - -#--------------------------------------------------------------------------- -# Configuration options related to source browsing -#--------------------------------------------------------------------------- - -# If the SOURCE_BROWSER tag is set to YES then a list of source files will be -# generated. Documented entities will be cross-referenced with these sources. -# -# Note: To get rid of all source code in the generated output, make sure that -# also VERBATIM_HEADERS is set to NO. -# The default value is: NO. - -SOURCE_BROWSER = NO - -# Setting the INLINE_SOURCES tag to YES will include the body of functions, -# classes and enums directly into the documentation. -# The default value is: NO. - -INLINE_SOURCES = NO - -# Setting the STRIP_CODE_COMMENTS tag to YES will instruct doxygen to hide any -# special comment blocks from generated source code fragments. Normal C, C++ and -# Fortran comments will always remain visible. -# The default value is: YES. - -STRIP_CODE_COMMENTS = YES - -# If the REFERENCED_BY_RELATION tag is set to YES then for each documented -# entity all documented functions referencing it will be listed. -# The default value is: NO. - -REFERENCED_BY_RELATION = NO - -# If the REFERENCES_RELATION tag is set to YES then for each documented function -# all documented entities called/used by that function will be listed. -# The default value is: NO. - -REFERENCES_RELATION = NO - -# If the REFERENCES_LINK_SOURCE tag is set to YES and SOURCE_BROWSER tag is set -# to YES then the hyperlinks from functions in REFERENCES_RELATION and -# REFERENCED_BY_RELATION lists will link to the source code. Otherwise they will -# link to the documentation. -# The default value is: YES. - -REFERENCES_LINK_SOURCE = YES - -# If SOURCE_TOOLTIPS is enabled (the default) then hovering a hyperlink in the -# source code will show a tooltip with additional information such as prototype, -# brief description and links to the definition and documentation. Since this -# will make the HTML file larger and loading of large files a bit slower, you -# can opt to disable this feature. -# The default value is: YES. -# This tag requires that the tag SOURCE_BROWSER is set to YES. - -SOURCE_TOOLTIPS = YES - -# If the USE_HTAGS tag is set to YES then the references to source code will -# point to the HTML generated by the htags(1) tool instead of doxygen built-in -# source browser. The htags tool is part of GNU's global source tagging system -# (see https://www.gnu.org/software/global/global.html). You will need version -# 4.8.6 or higher. -# -# To use it do the following: -# - Install the latest version of global -# - Enable SOURCE_BROWSER and USE_HTAGS in the configuration file -# - Make sure the INPUT points to the root of the source tree -# - Run doxygen as normal -# -# Doxygen will invoke htags (and that will in turn invoke gtags), so these -# tools must be available from the command line (i.e. in the search path). -# -# The result: instead of the source browser generated by doxygen, the links to -# source code will now point to the output of htags. -# The default value is: NO. -# This tag requires that the tag SOURCE_BROWSER is set to YES. - -USE_HTAGS = NO - -# If the VERBATIM_HEADERS tag is set the YES then doxygen will generate a -# verbatim copy of the header file for each class for which an include is -# specified. Set to NO to disable this. -# See also: Section \class. -# The default value is: YES. - -VERBATIM_HEADERS = YES - -#--------------------------------------------------------------------------- -# Configuration options related to the alphabetical class index -#--------------------------------------------------------------------------- - -# If the ALPHABETICAL_INDEX tag is set to YES, an alphabetical index of all -# compounds will be generated. Enable this if the project contains a lot of -# classes, structs, unions or interfaces. -# The default value is: YES. - -ALPHABETICAL_INDEX = YES - -# The COLS_IN_ALPHA_INDEX tag can be used to specify the number of columns in -# which the alphabetical index list will be split. -# Minimum value: 1, maximum value: 20, default value: 5. -# This tag requires that the tag ALPHABETICAL_INDEX is set to YES. - -COLS_IN_ALPHA_INDEX = 5 - -# In case all classes in a project start with a common prefix, all classes will -# be put under the same header in the alphabetical index. The IGNORE_PREFIX tag -# can be used to specify a prefix (or a list of prefixes) that should be ignored -# while generating the index headers. -# This tag requires that the tag ALPHABETICAL_INDEX is set to YES. - -IGNORE_PREFIX = - -#--------------------------------------------------------------------------- -# Configuration options related to the HTML output -#--------------------------------------------------------------------------- - -# If the GENERATE_HTML tag is set to YES, doxygen will generate HTML output -# The default value is: YES. - -GENERATE_HTML = YES - -# The HTML_OUTPUT tag is used to specify where the HTML docs will be put. If a -# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of -# it. -# The default directory is: html. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_OUTPUT = html - -# The HTML_FILE_EXTENSION tag can be used to specify the file extension for each -# generated HTML page (for example: .htm, .php, .asp). -# The default value is: .html. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_FILE_EXTENSION = .html - -# The HTML_HEADER tag can be used to specify a user-defined HTML header file for -# each generated HTML page. If the tag is left blank doxygen will generate a -# standard header. -# -# To get valid HTML the header file that includes any scripts and style sheets -# that doxygen needs, which is dependent on the configuration options used (e.g. -# the setting GENERATE_TREEVIEW). It is highly recommended to start with a -# default header using -# doxygen -w html new_header.html new_footer.html new_stylesheet.css -# YourConfigFile -# and then modify the file new_header.html. See also section "Doxygen usage" -# for information on how to generate the default header that doxygen normally -# uses. -# Note: The header is subject to change so you typically have to regenerate the -# default header when upgrading to a newer version of doxygen. For a description -# of the possible markers and block names see the documentation. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_HEADER = - -# The HTML_FOOTER tag can be used to specify a user-defined HTML footer for each -# generated HTML page. If the tag is left blank doxygen will generate a standard -# footer. See HTML_HEADER for more information on how to generate a default -# footer and what special commands can be used inside the footer. See also -# section "Doxygen usage" for information on how to generate the default footer -# that doxygen normally uses. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_FOOTER = - -# The HTML_STYLESHEET tag can be used to specify a user-defined cascading style -# sheet that is used by each HTML page. It can be used to fine-tune the look of -# the HTML output. If left blank doxygen will generate a default style sheet. -# See also section "Doxygen usage" for information on how to generate the style -# sheet that doxygen normally uses. -# Note: It is recommended to use HTML_EXTRA_STYLESHEET instead of this tag, as -# it is more robust and this tag (HTML_STYLESHEET) will in the future become -# obsolete. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_STYLESHEET = - -# The HTML_EXTRA_STYLESHEET tag can be used to specify additional user-defined -# cascading style sheets that are included after the standard style sheets -# created by doxygen. Using this option one can overrule certain style aspects. -# This is preferred over using HTML_STYLESHEET since it does not replace the -# standard style sheet and is therefore more robust against future updates. -# Doxygen will copy the style sheet files to the output directory. -# Note: The order of the extra style sheet files is of importance (e.g. the last -# style sheet in the list overrules the setting of the previous ones in the -# list). For an example see the documentation. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_EXTRA_STYLESHEET = - -# The HTML_EXTRA_FILES tag can be used to specify one or more extra images or -# other source files which should be copied to the HTML output directory. Note -# that these files will be copied to the base HTML output directory. Use the -# $relpath^ marker in the HTML_HEADER and/or HTML_FOOTER files to load these -# files. In the HTML_STYLESHEET file, use the file name only. Also note that the -# files will be copied as-is; there are no commands or markers available. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_EXTRA_FILES = - -# The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. Doxygen -# will adjust the colors in the style sheet and background images according to -# this color. Hue is specified as an angle on a colorwheel, see -# https://en.wikipedia.org/wiki/Hue for more information. For instance the value -# 0 represents red, 60 is yellow, 120 is green, 180 is cyan, 240 is blue, 300 -# purple, and 360 is red again. -# Minimum value: 0, maximum value: 359, default value: 220. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_COLORSTYLE_HUE = 220 - -# The HTML_COLORSTYLE_SAT tag controls the purity (or saturation) of the colors -# in the HTML output. For a value of 0 the output will use grayscales only. A -# value of 255 will produce the most vivid colors. -# Minimum value: 0, maximum value: 255, default value: 100. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_COLORSTYLE_SAT = 100 - -# The HTML_COLORSTYLE_GAMMA tag controls the gamma correction applied to the -# luminance component of the colors in the HTML output. Values below 100 -# gradually make the output lighter, whereas values above 100 make the output -# darker. The value divided by 100 is the actual gamma applied, so 80 represents -# a gamma of 0.8, The value 220 represents a gamma of 2.2, and 100 does not -# change the gamma. -# Minimum value: 40, maximum value: 240, default value: 80. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_COLORSTYLE_GAMMA = 80 - -# If the HTML_TIMESTAMP tag is set to YES then the footer of each generated HTML -# page will contain the date and time when the page was generated. Setting this -# to YES can help to show when doxygen was last run and thus if the -# documentation is up to date. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_TIMESTAMP = NO - -# If the HTML_DYNAMIC_MENUS tag is set to YES then the generated HTML -# documentation will contain a main index with vertical navigation menus that -# are dynamically created via Javascript. If disabled, the navigation index will -# consists of multiple levels of tabs that are statically embedded in every HTML -# page. Disable this option to support browsers that do not have Javascript, -# like the Qt help browser. -# The default value is: YES. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_DYNAMIC_MENUS = YES - -# If the HTML_DYNAMIC_SECTIONS tag is set to YES then the generated HTML -# documentation will contain sections that can be hidden and shown after the -# page has loaded. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_DYNAMIC_SECTIONS = NO - -# With HTML_INDEX_NUM_ENTRIES one can control the preferred number of entries -# shown in the various tree structured indices initially; the user can expand -# and collapse entries dynamically later on. Doxygen will expand the tree to -# such a level that at most the specified number of entries are visible (unless -# a fully collapsed tree already exceeds this amount). So setting the number of -# entries 1 will produce a full collapsed tree by default. 0 is a special value -# representing an infinite number of entries and will result in a full expanded -# tree by default. -# Minimum value: 0, maximum value: 9999, default value: 100. -# This tag requires that the tag GENERATE_HTML is set to YES. - -HTML_INDEX_NUM_ENTRIES = 100 - -# If the GENERATE_DOCSET tag is set to YES, additional index files will be -# generated that can be used as input for Apple's Xcode 3 integrated development -# environment (see: https://developer.apple.com/xcode/), introduced with OSX -# 10.5 (Leopard). To create a documentation set, doxygen will generate a -# Makefile in the HTML output directory. Running make will produce the docset in -# that directory and running make install will install the docset in -# ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find it at -# startup. See https://developer.apple.com/library/archive/featuredarticles/Doxy -# genXcode/_index.html for more information. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTML is set to YES. - -GENERATE_DOCSET = NO - -# This tag determines the name of the docset feed. A documentation feed provides -# an umbrella under which multiple documentation sets from a single provider -# (such as a company or product suite) can be grouped. -# The default value is: Doxygen generated docs. -# This tag requires that the tag GENERATE_DOCSET is set to YES. - -DOCSET_FEEDNAME = "Doxygen generated docs" - -# This tag specifies a string that should uniquely identify the documentation -# set bundle. This should be a reverse domain-name style string, e.g. -# com.mycompany.MyDocSet. Doxygen will append .docset to the name. -# The default value is: org.doxygen.Project. -# This tag requires that the tag GENERATE_DOCSET is set to YES. - -DOCSET_BUNDLE_ID = org.doxygen.Project - -# The DOCSET_PUBLISHER_ID tag specifies a string that should uniquely identify -# the documentation publisher. This should be a reverse domain-name style -# string, e.g. com.mycompany.MyDocSet.documentation. -# The default value is: org.doxygen.Publisher. -# This tag requires that the tag GENERATE_DOCSET is set to YES. - -DOCSET_PUBLISHER_ID = org.doxygen.Publisher - -# The DOCSET_PUBLISHER_NAME tag identifies the documentation publisher. -# The default value is: Publisher. -# This tag requires that the tag GENERATE_DOCSET is set to YES. - -DOCSET_PUBLISHER_NAME = Publisher - -# If the GENERATE_HTMLHELP tag is set to YES then doxygen generates three -# additional HTML index files: index.hhp, index.hhc, and index.hhk. The -# index.hhp is a project file that can be read by Microsoft's HTML Help Workshop -# (see: https://www.microsoft.com/en-us/download/details.aspx?id=21138) on -# Windows. -# -# The HTML Help Workshop contains a compiler that can convert all HTML output -# generated by doxygen into a single compiled HTML file (.chm). Compiled HTML -# files are now used as the Windows 98 help format, and will replace the old -# Windows help format (.hlp) on all Windows platforms in the future. Compressed -# HTML files also contain an index, a table of contents, and you can search for -# words in the documentation. The HTML workshop also contains a viewer for -# compressed HTML files. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTML is set to YES. - -GENERATE_HTMLHELP = NO - -# The CHM_FILE tag can be used to specify the file name of the resulting .chm -# file. You can add a path in front of the file if the result should not be -# written to the html output directory. -# This tag requires that the tag GENERATE_HTMLHELP is set to YES. - -CHM_FILE = - -# The HHC_LOCATION tag can be used to specify the location (absolute path -# including file name) of the HTML help compiler (hhc.exe). If non-empty, -# doxygen will try to run the HTML help compiler on the generated index.hhp. -# The file has to be specified with full path. -# This tag requires that the tag GENERATE_HTMLHELP is set to YES. - -HHC_LOCATION = - -# The GENERATE_CHI flag controls if a separate .chi index file is generated -# (YES) or that it should be included in the master .chm file (NO). -# The default value is: NO. -# This tag requires that the tag GENERATE_HTMLHELP is set to YES. - -GENERATE_CHI = NO - -# The CHM_INDEX_ENCODING is used to encode HtmlHelp index (hhk), content (hhc) -# and project file content. -# This tag requires that the tag GENERATE_HTMLHELP is set to YES. - -CHM_INDEX_ENCODING = - -# The BINARY_TOC flag controls whether a binary table of contents is generated -# (YES) or a normal table of contents (NO) in the .chm file. Furthermore it -# enables the Previous and Next buttons. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTMLHELP is set to YES. - -BINARY_TOC = NO - -# The TOC_EXPAND flag can be set to YES to add extra items for group members to -# the table of contents of the HTML help documentation and to the tree view. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTMLHELP is set to YES. - -TOC_EXPAND = NO - -# If the GENERATE_QHP tag is set to YES and both QHP_NAMESPACE and -# QHP_VIRTUAL_FOLDER are set, an additional index file will be generated that -# can be used as input for Qt's qhelpgenerator to generate a Qt Compressed Help -# (.qch) of the generated HTML documentation. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTML is set to YES. - -GENERATE_QHP = NO - -# If the QHG_LOCATION tag is specified, the QCH_FILE tag can be used to specify -# the file name of the resulting .qch file. The path specified is relative to -# the HTML output folder. -# This tag requires that the tag GENERATE_QHP is set to YES. - -QCH_FILE = - -# The QHP_NAMESPACE tag specifies the namespace to use when generating Qt Help -# Project output. For more information please see Qt Help Project / Namespace -# (see: https://doc.qt.io/archives/qt-4.8/qthelpproject.html#namespace). -# The default value is: org.doxygen.Project. -# This tag requires that the tag GENERATE_QHP is set to YES. - -QHP_NAMESPACE = org.doxygen.Project - -# The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating Qt -# Help Project output. For more information please see Qt Help Project / Virtual -# Folders (see: https://doc.qt.io/archives/qt-4.8/qthelpproject.html#virtual- -# folders). -# The default value is: doc. -# This tag requires that the tag GENERATE_QHP is set to YES. - -QHP_VIRTUAL_FOLDER = doc - -# If the QHP_CUST_FILTER_NAME tag is set, it specifies the name of a custom -# filter to add. For more information please see Qt Help Project / Custom -# Filters (see: https://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom- -# filters). -# This tag requires that the tag GENERATE_QHP is set to YES. - -QHP_CUST_FILTER_NAME = - -# The QHP_CUST_FILTER_ATTRS tag specifies the list of the attributes of the -# custom filter to add. For more information please see Qt Help Project / Custom -# Filters (see: https://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom- -# filters). -# This tag requires that the tag GENERATE_QHP is set to YES. - -QHP_CUST_FILTER_ATTRS = - -# The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this -# project's filter section matches. Qt Help Project / Filter Attributes (see: -# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#filter-attributes). -# This tag requires that the tag GENERATE_QHP is set to YES. - -QHP_SECT_FILTER_ATTRS = - -# The QHG_LOCATION tag can be used to specify the location of Qt's -# qhelpgenerator. If non-empty doxygen will try to run qhelpgenerator on the -# generated .qhp file. -# This tag requires that the tag GENERATE_QHP is set to YES. - -QHG_LOCATION = - -# If the GENERATE_ECLIPSEHELP tag is set to YES, additional index files will be -# generated, together with the HTML files, they form an Eclipse help plugin. To -# install this plugin and make it available under the help contents menu in -# Eclipse, the contents of the directory containing the HTML and XML files needs -# to be copied into the plugins directory of eclipse. The name of the directory -# within the plugins directory should be the same as the ECLIPSE_DOC_ID value. -# After copying Eclipse needs to be restarted before the help appears. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTML is set to YES. - -GENERATE_ECLIPSEHELP = NO - -# A unique identifier for the Eclipse help plugin. When installing the plugin -# the directory name containing the HTML and XML files should also have this -# name. Each documentation set should have its own identifier. -# The default value is: org.doxygen.Project. -# This tag requires that the tag GENERATE_ECLIPSEHELP is set to YES. - -ECLIPSE_DOC_ID = org.doxygen.Project - -# If you want full control over the layout of the generated HTML pages it might -# be necessary to disable the index and replace it with your own. The -# DISABLE_INDEX tag can be used to turn on/off the condensed index (tabs) at top -# of each HTML page. A value of NO enables the index and the value YES disables -# it. Since the tabs in the index contain the same information as the navigation -# tree, you can set this option to YES if you also set GENERATE_TREEVIEW to YES. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTML is set to YES. - -DISABLE_INDEX = NO - -# The GENERATE_TREEVIEW tag is used to specify whether a tree-like index -# structure should be generated to display hierarchical information. If the tag -# value is set to YES, a side panel will be generated containing a tree-like -# index structure (just like the one that is generated for HTML Help). For this -# to work a browser that supports JavaScript, DHTML, CSS and frames is required -# (i.e. any modern browser). Windows users are probably better off using the -# HTML help feature. Via custom style sheets (see HTML_EXTRA_STYLESHEET) one can -# further fine-tune the look of the index. As an example, the default style -# sheet generated by doxygen has an example that shows how to put an image at -# the root of the tree instead of the PROJECT_NAME. Since the tree basically has -# the same information as the tab index, you could consider setting -# DISABLE_INDEX to YES when enabling this option. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTML is set to YES. - -GENERATE_TREEVIEW = NO - -# The ENUM_VALUES_PER_LINE tag can be used to set the number of enum values that -# doxygen will group on one line in the generated HTML documentation. -# -# Note that a value of 0 will completely suppress the enum values from appearing -# in the overview section. -# Minimum value: 0, maximum value: 20, default value: 4. -# This tag requires that the tag GENERATE_HTML is set to YES. - -ENUM_VALUES_PER_LINE = 4 - -# If the treeview is enabled (see GENERATE_TREEVIEW) then this tag can be used -# to set the initial width (in pixels) of the frame in which the tree is shown. -# Minimum value: 0, maximum value: 1500, default value: 250. -# This tag requires that the tag GENERATE_HTML is set to YES. - -TREEVIEW_WIDTH = 250 - -# If the EXT_LINKS_IN_WINDOW option is set to YES, doxygen will open links to -# external symbols imported via tag files in a separate window. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTML is set to YES. - -EXT_LINKS_IN_WINDOW = NO - -# Use this tag to change the font size of LaTeX formulas included as images in -# the HTML documentation. When you change the font size after a successful -# doxygen run you need to manually remove any form_*.png images from the HTML -# output directory to force them to be regenerated. -# Minimum value: 8, maximum value: 50, default value: 10. -# This tag requires that the tag GENERATE_HTML is set to YES. - -FORMULA_FONTSIZE = 10 - -# Use the FORMULA_TRANSPARENT tag to determine whether or not the images -# generated for formulas are transparent PNGs. Transparent PNGs are not -# supported properly for IE 6.0, but are supported on all modern browsers. -# -# Note that when changing this option you need to delete any form_*.png files in -# the HTML output directory before the changes have effect. -# The default value is: YES. -# This tag requires that the tag GENERATE_HTML is set to YES. - -FORMULA_TRANSPARENT = YES - -# Enable the USE_MATHJAX option to render LaTeX formulas using MathJax (see -# https://www.mathjax.org) which uses client side Javascript for the rendering -# instead of using pre-rendered bitmaps. Use this if you do not have LaTeX -# installed or if you want to formulas look prettier in the HTML output. When -# enabled you may also need to install MathJax separately and configure the path -# to it using the MATHJAX_RELPATH option. -# The default value is: NO. -# This tag requires that the tag GENERATE_HTML is set to YES. - -USE_MATHJAX = YES - -# When MathJax is enabled you can set the default output format to be used for -# the MathJax output. See the MathJax site (see: -# http://docs.mathjax.org/en/latest/output.html) for more details. -# Possible values are: HTML-CSS (which is slower, but has the best -# compatibility), NativeMML (i.e. MathML) and SVG. -# The default value is: HTML-CSS. -# This tag requires that the tag USE_MATHJAX is set to YES. - -MATHJAX_FORMAT = HTML-CSS - -# When MathJax is enabled you need to specify the location relative to the HTML -# output directory using the MATHJAX_RELPATH option. The destination directory -# should contain the MathJax.js script. For instance, if the mathjax directory -# is located at the same level as the HTML output directory, then -# MATHJAX_RELPATH should be ../mathjax. The default value points to the MathJax -# Content Delivery Network so you can quickly see the result without installing -# MathJax. However, it is strongly recommended to install a local copy of -# MathJax from https://www.mathjax.org before deployment. -# The default value is: https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/. -# This tag requires that the tag USE_MATHJAX is set to YES. - -MATHJAX_RELPATH = https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/ - -# The MATHJAX_EXTENSIONS tag can be used to specify one or more MathJax -# extension names that should be enabled during MathJax rendering. For example -# MATHJAX_EXTENSIONS = TeX/AMSmath TeX/AMSsymbols -# This tag requires that the tag USE_MATHJAX is set to YES. - -MATHJAX_EXTENSIONS = - -# The MATHJAX_CODEFILE tag can be used to specify a file with javascript pieces -# of code that will be used on startup of the MathJax code. See the MathJax site -# (see: http://docs.mathjax.org/en/latest/output.html) for more details. For an -# example see the documentation. -# This tag requires that the tag USE_MATHJAX is set to YES. - -MATHJAX_CODEFILE = - -# When the SEARCHENGINE tag is enabled doxygen will generate a search box for -# the HTML output. The underlying search engine uses javascript and DHTML and -# should work on any modern browser. Note that when using HTML help -# (GENERATE_HTMLHELP), Qt help (GENERATE_QHP), or docsets (GENERATE_DOCSET) -# there is already a search function so this one should typically be disabled. -# For large projects the javascript based search engine can be slow, then -# enabling SERVER_BASED_SEARCH may provide a better solution. It is possible to -# search using the keyboard; to jump to the search box use + S -# (what the is depends on the OS and browser, but it is typically -# , / look for usefrom files in directory "dir" - -O generate types files in directory "dir" - -noextrap do not generate ModName_Input_ExtrapInterp or ModName_Output_ExtrapInterp routines - -D define symbol for conditional evaluation inside registry file - -ccode generate additional code for interfacing with C/C++ - -keep do not delete temporary files from registry program - -shownodes output a listing of the nodes in registry's AST - === alternate usage for generating templates === - -template ModuleName ModName - Generate a template Module file none exists - -registry ModuleName ModName - Generate a template registry file if none exists - -force Force generating of template or registry file - (the / character can be used in place of - when specifying options) -``` - -## Manual -For more information and syntax, please refer to the -[NWTC Programmer's Handbook](https://nwtc.nrel.gov/system/files/ProgrammingHandbook_Mod20130717.pdf). diff --git a/OpenFAST/modules/openfast-registry/src/FAST_preamble.h b/OpenFAST/modules/openfast-registry/src/FAST_preamble.h deleted file mode 100644 index 74de0a837..000000000 --- a/OpenFAST/modules/openfast-registry/src/FAST_preamble.h +++ /dev/null @@ -1,45 +0,0 @@ -static char *FAST_preamble[] = { -"!*********************************************************************************************************************************\n", -"! %s_Types\n", -"!.................................................................................................................................\n", -"! This file is part of %s.\n", -"!\n", -"! Copyright (C) 2012-2016 National Renewable Energy Laboratory\n", -"!\n", -"! Licensed under the Apache License, Version 2.0 (the \"License\");\n", -"! you may not use this file except in compliance with the License.\n", -"! You may obtain a copy of the License at\n", -"!\n", -"! http://www.apache.org/licenses/LICENSE-2.0\n", -"!\n", -"! Unless required by applicable law or agreed to in writing, software\n", -"! distributed under the License is distributed on an \"AS IS\" BASIS,\n", -"! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.\n", -"! See the License for the specific language governing permissions and\n", -"! limitations under the License.\n", -"!\n", -"!\n", -"! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost.\n", -"!\n", -"!*********************************************************************************************************************************\n", -"!> This module contains the user-defined types needed in %s. It also contains copy, destroy, pack, and\n", -"!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry.\n", -"MODULE %s_Types\n", -"!---------------------------------------------------------------------------------------------------------------------------------\n", -// We may be generating the types for the library, so defer writing this: "USE NWTC_Library\n", -// We may want to tack some more USE statements on so defer writing this: "IMPLICIT NONE\n", -0L} ; - - - - - - - - - - - - - - diff --git a/OpenFAST/modules/openfast-registry/src/Template_data.c b/OpenFAST/modules/openfast-registry/src/Template_data.c deleted file mode 100644 index 22aa731e7..000000000 --- a/OpenFAST/modules/openfast-registry/src/Template_data.c +++ /dev/null @@ -1,849 +0,0 @@ -char *template_data[] = { -"!**********************************************************************************************************************************", -"!> ## ModuleName", -"!! The ModuleName and ModuleName_Types modules make up a template for creating user-defined calculations in the FAST Modularization", -"!! Framework. ModuleName_Types will be auto-generated by the FAST registry program, based on the variables specified in the", -"!! ModuleName_Registry.txt file.", -"!!", -"! ..................................................................................................................................", -"!! ## LICENSING", -"!! Copyright (C) 2012-2013, 2015-2016 National Renewable Energy Laboratory", -"!!", -"!! This file is part of ModuleName.", -"!!", -"!! 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.", -"!**********************************************************************************************************************************", -"MODULE ModuleName", -"", -" USE ModuleName_Types", -" USE NWTC_Library", -"", -" IMPLICIT NONE", -"", -" PRIVATE", -"", -" TYPE(ProgDesc), PARAMETER :: ModName_Ver = ProgDesc( 'ModuleName', '', '' ) !< module date/version information", -"", -"", -" ! ..... Public Subroutines ...................................................................................................", -"", -" PUBLIC :: ModName_Init ! Initialization routine", -" PUBLIC :: ModName_End ! Ending routine (includes clean up)", -"", -" PUBLIC :: ModName_UpdateStates ! Loose coupling routine for solving for constraint states, integrating", -" ! continuous states, and updating discrete states", -" PUBLIC :: ModName_CalcOutput ! Routine for computing outputs", -"", -" PUBLIC :: ModName_CalcConstrStateResidual ! Tight coupling routine for returning the constraint state residual", -" PUBLIC :: ModName_CalcContStateDeriv ! Tight coupling routine for computing derivatives of continuous states", -" PUBLIC :: ModName_UpdateDiscState ! Tight coupling routine for updating discrete states", -"", -" PUBLIC :: ModName_JacobianPInput ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete -", -" ! (Xd), and constraint - state(Z) functions all with respect to the inputs(u)", -" PUBLIC :: ModName_JacobianPContState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete -", -" ! (Xd), and constraint - state(Z) functions all with respect to the continuous", -" ! states(x)", -" PUBLIC :: ModName_JacobianPDiscState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete -", -" ! (Xd), and constraint - state(Z) functions all with respect to the discrete", -" ! states(xd)", -" PUBLIC :: ModName_JacobianPConstrState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete -", -" ! (Xd), and constraint - state(Z) functions all with respect to the constraint", -" ! states(z)", -" PUBLIC :: ModName_GetOP ! Routine to get the operating-point values for linearization (from data structures to arrays)", -"", -"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 ModName_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, InitOut, ErrStat, ErrMsg )", -"!..................................................................................................................................", -"", -" TYPE(ModName_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine", -" TYPE(ModName_InputType), INTENT( OUT) :: u !< An initial guess for the input; input mesh must be defined", -" TYPE(ModName_ParameterType), INTENT( OUT) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT( OUT) :: x !< Initial continuous states", -" TYPE(ModName_DiscreteStateType), INTENT( OUT) :: xd !< Initial discrete states", -" TYPE(ModName_ConstraintStateType), INTENT( OUT) :: z !< Initial guess of the constraint states", -" TYPE(ModName_OtherStateType), INTENT( OUT) :: OtherState !< Initial other states (logical, etc)", -" TYPE(ModName_OutputType), INTENT( OUT) :: y !< Initial system outputs (outputs are not calculated;", -" !! only the output mesh is initialized)", -" TYPE(ModName_MiscVarType), INTENT( OUT) :: misc !< Misc variables for optimization (not copied in glue code)", -" REAL(DbKi), INTENT(INOUT) :: Interval !< Coupling interval in seconds: the rate that", -" !! (1) ModName_UpdateStates() is called in loose coupling &", -" !! (2) ModName_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.", -" TYPE(ModName_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", -"", -" INTEGER(IntKi) :: NumOuts ! number of outputs; would probably be in the parameter type", -" INTEGER(IntKi) :: ErrStat2 ! local error status", -" CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message", -" CHARACTER(*), PARAMETER :: RoutineName = 'ModName_Init'", -"", -" !! Initialize variables", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -" NumOuts = 2", -"", -"", -" ! Initialize the NWTC Subroutine Library", -"", -" call NWTC_Init( )", -"", -" ! Display the module information", -"", -" call DispNVD( ModName_Ver )", -"", -"", -" ! Define parameters here:", -"", -" p%DT = Interval", -"", -"", -" ! Define initial system states here:", -"", -" x%DummyContState = 0.0_ReKi", -" xd%DummyDiscState = 0.0_ReKi", -" z%DummyConstrState = 0.0_ReKi", -" OtherState%DummyOtherState = 0.0_ReKi", -"", -" ! define optimization variables here:", -" misc%DummyMiscVar = 0.0_ReKi", -"", -" ! Define initial guess for the system inputs here:", -"", -" u%DummyInput = 0.0_ReKi", -"", -"", -" ! Define system output initializations (set up mesh) here:", -" call AllocAry( y%WriteOutput, NumOuts, 'WriteOutput', ErrStat2, ErrMsg2 )", -" call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! set return error status based on local (concatenate errors)", -" if (ErrStat >= AbortErrLev) return ! if there are local variables that need to be deallocated, do so before early return", -" ", -" y%DummyOutput = 0", -" y%WriteOutput = 0", -"", -"", -" ! Define initialization-routine output here:", -" call AllocAry(InitOut%WriteOutputHdr,NumOuts,'WriteOutputHdr',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" call AllocAry(InitOut%WriteOutputUnt,NumOuts,'WriteOutputUnt',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" if (ErrStat >= AbortErrLev) return ! if there are local variables that need to be deallocated, do so before early return", -"", -" InitOut%WriteOutputHdr = (/ 'Time ', 'Column2' /)", -" InitOut%WriteOutputUnt = (/ '(s)', '(-)' /)", -"", -"", -" ! If you want to choose your own rate instead of using what the glue code suggests, tell the glue code the rate at which", -" ! this module must be called here:", -"", -" !Interval = p%DT", -"", -"", -" if (InitInp%Linearize) then", -"", -" ! If this module does not implement the four Jacobian routines at the end of this template, or the module cannot", -" ! linearize with the features that are enabled, stop the simulation if InitInp%Linearize is true.", -"", -" CALL SetErrStat( ErrID_Fatal, 'ModuleName cannot perform linearization analysis.', ErrStat, ErrMsg, RoutineName)", -"", -" ! Otherwise, if the module does allow linearization, return the appropriate Jacobian row/column names and rotating-frame flags here:", -" ! Allocate and set these variables: InitOut%LinNames_y, InitOut%LinNames_x, InitOut%LinNames_xd, InitOut%LinNames_z, InitOut%LinNames_u", -" ! Allocate and set these variables: InitOut%RotFrame_y, InitOut%RotFrame_x, InitOut%RotFrame_xd, InitOut%RotFrame_z, InitOut%RotFrame_u", -" ! Allocate and set these variables: InitOut%IsLoad_u, InitOut%DerivOrder_x", -"", -" end if", -"", -"", -"END SUBROUTINE ModName_Init", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> This routine is called at the end of the simulation.", -"SUBROUTINE ModName_End( u, p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg )", -"!..................................................................................................................................", -"", -" TYPE(ModName_InputType), INTENT(INOUT) :: u !< System inputs", -" TYPE(ModName_ParameterType), INTENT(INOUT) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states", -" TYPE(ModName_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states", -" TYPE(ModName_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states", -" TYPE(ModName_OtherStateType), INTENT(INOUT) :: OtherState !< Other states", -" TYPE(ModName_OutputType), INTENT(INOUT) :: y !< System outputs", -" TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code)", -" 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 ! local error status", -" CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message", -" CHARACTER(*), PARAMETER :: RoutineName = 'ModName_End'", -"", -" ! Initialize ErrStat", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -"", -"", -" !! Place any last minute operations or calculations here:", -"", -"", -" !! Close files here (but because of checkpoint-restart capability, it is not recommended to have files open during the simulation):", -"", -"", -" !! Destroy the input data:", -"", -" call ModName_DestroyInput( u, ErrStat2, ErrMsg2 )", -" call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -"", -"", -" !! Destroy the parameter data:", -"", -" call ModName_DestroyParam( p, ErrStat2, ErrMsg2 )", -" call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -"", -" !! Destroy the state data:", -"", -" call ModName_DestroyContState( x, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" call ModName_DestroyDiscState( xd, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" call ModName_DestroyConstrState( z, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" call ModName_DestroyOtherState( OtherState, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -"", -"", -" !! Destroy the output data:", -"", -" call ModName_DestroyOutput( y, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -"", -" ", -" !! Destroy the misc data:", -"", -" call ModName_DestroyMisc( misc, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -"", -"", -"END SUBROUTINE ModName_End", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> This is a loose coupling routine for solving constraint states, integrating continuous states, and updating discrete and other ", -"!! states. Continuous, constraint, discrete, and other states are updated to values at t + Interval.", -"SUBROUTINE ModName_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, misc, ErrStat, ErrMsg )", -"!..................................................................................................................................", -"", -" REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds", -" INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval", -" TYPE(ModName_InputType), INTENT(INOUT) :: Inputs(:) !< Inputs at InputTimes (output from this routine only ", -" !! because of record keeping in routines that copy meshes)", -" REAL(DbKi), INTENT(IN ) :: InputTimes(:) !< Times in seconds associated with Inputs", -" TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(INOUT) :: x !< Input: Continuous states at t;", -" !! Output: Continuous states at t + Interval", -" TYPE(ModName_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t;", -" !! Output: Discrete states at t + Interval", -" TYPE(ModName_ConstraintStateType), INTENT(INOUT) :: z !< Input: Constraint states at t;", -" !! Output: Constraint states at t + Interval", -" TYPE(ModName_OtherStateType), INTENT(INOUT) :: OtherState !< Other states: Other states at t;", -" !! Output: Other states at t + Interval", -" TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code)", -" INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation", -" CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None", -"", -" ! Local variables", -"", -" TYPE(ModName_ContinuousStateType) :: dxdt ! Continuous state derivatives at t", -" TYPE(ModName_DiscreteStateType) :: xd_t ! Discrete states at t (copy)", -" TYPE(ModName_ConstraintStateType) :: z_Residual ! Residual of the constraint state functions (Z)", -" TYPE(ModName_InputType) :: u ! Instantaneous inputs", -" ", -" INTEGER(IntKi) :: ErrStat2 ! local error status", -" CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message", -" CHARACTER(*), PARAMETER :: RoutineName = 'ModName_UpdateStates'", -"", -"", -" ! Initialize variables", -"", -" ErrStat = ErrID_None ! no error has occurred", -" ErrMsg = ''", -"", -"", -" ! This subroutine contains an example of how the states could be updated. Developers will", -" ! want to adjust the logic as necessary for their own situations.", -"", -"", -"", -" ! Get the inputs at time t, based on the array of values sent by the glue code:", -"", -" ! before calling ExtrapInterp routine, memory in u must be allocated; we can do that with a copy:", -" call ModName_CopyInput( Inputs(1), u, MESH_NEWCOPY, ErrStat2, ErrMsg2 )", -" call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" if ( ErrStat >= AbortErrLev ) then", -" call cleanup() ! to avoid memory leaks, we have to destroy the local variables that may have allocatable arrays or meshes", -" return", -" end if", -"", -" call ModName_Input_ExtrapInterp( Inputs, InputTimes, u, t, ErrStat2, ErrMsg2 ) ", -" call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" if ( ErrStat >= AbortErrLev ) then", -" call cleanup()", -" return", -" end if", -"", -"", -"", -" ! Get first time derivatives of continuous states (dxdt):", -"", -" call ModName_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, misc, dxdt, ErrStat2, ErrMsg2 )", -" call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" if ( ErrStat >= AbortErrLev ) then", -" call cleanup()", -" return", -" end if", -"", -"", -" ! Update discrete states:", -" ! Note that xd [discrete state] is changed in ModName_UpdateDiscState() so xd will now contain values at t+Interval", -" ! We'll first make a copy that contains xd at time t, which will be used in computing the constraint states", -" call ModName_CopyDiscState( xd, xd_t, MESH_NEWCOPY, ErrStat2, ErrMsg2 )", -" call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" if ( ErrStat >= AbortErrLev ) then", -" call cleanup()", -" return", -" end if", -"", -" call ModName_UpdateDiscState( t, n, u, p, x, xd, z, OtherState, misc, ErrStat2, ErrMsg2 )", -" call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" if ( ErrStat >= AbortErrLev ) then", -" call cleanup()", -" return", -" end if", -"", -"", -" ! Solve for the constraint states (z) here:", -"", -" ! Iterate until the value is within a given tolerance.", -"", -" ! DO ", -"", -" call ModName_CalcConstrStateResidual( t, u, p, x, xd_t, z, OtherState, misc, Z_Residual, ErrStat2, ErrMsg2 )", -" call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" if ( ErrStat >= AbortErrLev ) then", -" call cleanup()", -" return", -" end if", -"", -" ! z =", -"", -" ! END DO", -"", -"", -"", -" ! Integrate (update) continuous states (x) here:", -"", -" !x = function of dxdt and x", -"", -"", -" ! Destroy local variables before returning", -" call cleanup()", -"", -"", -"CONTAINS", -" SUBROUTINE cleanup()", -" ! note that this routine inherits all of the data in ModName_UpdateStates", -"", -"", -" CALL ModName_DestroyInput( u, ErrStat2, ErrMsg2)", -" CALL ModName_DestroyConstrState( Z_Residual, ErrStat2, ErrMsg2)", -" CALL ModName_DestroyContState( dxdt, ErrStat2, ErrMsg2)", -" CALL ModName_DestroyDiscState( xd_t, ErrStat2, ErrMsg2) ", -"", -" END SUBROUTINE cleanup", -"END SUBROUTINE ModName_UpdateStates", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> This is a routine for computing outputs, used in both loose and tight coupling.", -"SUBROUTINE ModName_CalcOutput( t, u, p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg )", -"!..................................................................................................................................", -"", -" REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds", -" TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at t", -" TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t", -" TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t", -" TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t", -" TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t", -" TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code)", -" TYPE(ModName_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con-", -" !! nectivity information does not have to be recalculated)", -" INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation", -" CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None", -"", -"", -" ! Initialize ErrStat", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -"", -"", -" ! Compute outputs here:", -" y%DummyOutput = 2.0_ReKi", -"", -" y%WriteOutput(1) = REAL(t,ReKi)", -" y%WriteOutput(2) = 1.0_ReKi", -"", -"", -"END SUBROUTINE ModName_CalcOutput", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> This is a tight coupling routine for computing derivatives of continuous states.", -"SUBROUTINE ModName_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, misc, dxdt, ErrStat, ErrMsg )", -"!..................................................................................................................................", -"", -" REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds", -" TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at t", -" TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t", -" TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t", -" TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t", -" TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t", -" TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code)", -" TYPE(ModName_ContinuousStateType), INTENT( OUT) :: dxdt !< Continuous state derivatives at t", -" INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation", -" CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None", -"", -"", -" ! Initialize ErrStat", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -"", -"", -" ! Compute the first time derivatives of the continuous states here:", -"", -" dxdt%DummyContState = 0.0_ReKi", -"", -"", -"END SUBROUTINE ModName_CalcContStateDeriv", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> This is a tight coupling routine for updating discrete states.", -"SUBROUTINE ModName_UpdateDiscState( t, n, u, p, x, xd, z, OtherState, misc, ErrStat, ErrMsg )", -"!..................................................................................................................................", -"", -" REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds", -" INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval", -" TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at t", -" TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t", -" TYPE(ModName_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t;", -" !! Output: Discrete states at t + Interval", -" TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t", -" TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t", -" TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code)", -" INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation", -" CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None", -"", -"", -" ! Initialize ErrStat", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -"", -"", -" ! Update discrete states here:", -"", -" xd%DummyDiscState = 0.0_Reki", -"", -"END SUBROUTINE ModName_UpdateDiscState", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> This is a tight coupling routine for solving for the residual of the constraint state functions.", -"SUBROUTINE ModName_CalcConstrStateResidual( t, u, p, x, xd, z, OtherState, misc, Z_residual, ErrStat, ErrMsg )", -"!..................................................................................................................................", -"", -" REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds", -" TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at t", -" TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t", -" TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t", -" TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t (possibly a guess)", -" TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t", -" TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code)", -" TYPE(ModName_ConstraintStateType), INTENT( OUT) :: Z_residual !< Residual of the constraint state functions using", -" !! the input values described above", -" INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation", -" CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None", -"", -"", -" ! Initialize ErrStat", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -"", -"", -" ! Solve for the residual of the constraint state functions here:", -"", -" Z_residual%DummyConstrState = 0.0_ReKi", -"", -"END SUBROUTINE ModName_CalcConstrStateResidual", -"", -"", -"!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++", -"! ###### The following four routines are Jacobian routines for linearization capabilities #######", -"! If the module does not implement them, set ErrStat = ErrID_Fatal in ModName_Init() when InitInp%Linearize is .true.", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions", -"!! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned.", -"SUBROUTINE ModName_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu)", -"!..................................................................................................................................", -"", -" REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point", -" TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required)", -" TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point", -" TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point", -" TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point", -" TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point", -" TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required);", -" !! Output fields are not used by this routine, but type is", -" !! available here so that mesh parameter information (i.e.,", -" !! connectivity) does not have to be recalculated for dYdu.", -" TYPE(ModName_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", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect", -" !! to the inputs (u) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with", -" !! respect to the inputs (u) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with", -" !! respect to the inputs (u) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with", -" !! respect to the inputs (u) [intent in to avoid deallocation]", -"", -"", -" ! Initialize ErrStat", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -"", -"", -" IF ( PRESENT( dYdu ) ) THEN", -"", -" ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here:", -"", -" ! allocate and set dYdu", -"", -" END IF", -"", -" IF ( PRESENT( dXdu ) ) THEN", -"", -" ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here:", -"", -" ! allocate and set dXdu", -"", -" END IF", -"", -" IF ( PRESENT( dXddu ) ) THEN", -"", -" ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the inputs (u) here:", -"", -" ! allocate and set dXddu", -"", -" END IF", -"", -" IF ( PRESENT( dZdu ) ) THEN", -"", -" ! Calculate the partial derivative of the constraint state functions (Z) with respect to the inputs (u) here:", -"", -" ! allocate and set dZdu", -"", -" END IF", -"", -"", -"END SUBROUTINE ModName_JacobianPInput", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions", -"!! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned.", -"SUBROUTINE ModName_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx )", -"!..................................................................................................................................", -"", -" REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point", -" TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required)", -" TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point", -" TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point", -" TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point", -" TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point", -" TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required);", -" !! Output fields are not used by this routine, but type is", -" !! available here so that mesh parameter information (i.e.,", -" !! connectivity) does not have to be recalculated for dYdx.", -" TYPE(ModName_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", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions", -" !! (Y) with respect to the continuous", -" !! states (x) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state", -" !! functions (X) with respect to", -" !! the continuous states (x) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state", -" !! functions (Xd) with respect to", -" !! the continuous states (x) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state", -" !! functions (Z) with respect to", -" !! the continuous states (x) [intent in to avoid deallocation]", -"", -"", -" ! Initialize ErrStat", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -"", -"", -"", -" IF ( PRESENT( dYdx ) ) THEN", -"", -" ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here:", -"", -" ! allocate and set dYdx", -"", -" END IF", -"", -" IF ( PRESENT( dXdx ) ) THEN", -"", -" ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here:", -"", -" ! allocate and set dXdx", -"", -" END IF", -"", -" IF ( PRESENT( dXddx ) ) THEN", -"", -" ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the continuous states (x) here:", -"", -" ! allocate and set dXddx", -"", -" END IF", -"", -" IF ( PRESENT( dZdx ) ) THEN", -"", -"", -" ! Calculate the partial derivative of the constraint state functions (Z) with respect to the continuous states (x) here:", -"", -" ! allocate and set dZdx", -"", -" END IF", -"", -"", -"END SUBROUTINE ModName_JacobianPContState", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions", -"!! with respect to the discrete states (xd). The partial derivatives dY/dxd, dX/dxd, dXd/dxd, and dZ/dxd are returned.", -"SUBROUTINE ModName_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd )", -"!..................................................................................................................................", -"", -" REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point", -" TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required)", -" TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point", -" TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point", -" TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point", -" TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point", -" TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required);", -" !! Output fields are not used by this routine, but type is", -" !! available here so that mesh parameter information (i.e.,", -" !! connectivity) does not have to be recalculated for dYdxd.", -" TYPE(ModName_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", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdxd(:,:) !< Partial derivatives of output functions", -" !! (Y) with respect to the discrete", -" !! states (xd) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdxd(:,:) !< Partial derivatives of continuous state", -" !! functions (X) with respect to the", -" !! discrete states (xd) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddxd(:,:)!< Partial derivatives of discrete state", -" !! functions (Xd) with respect to the", -" !! discrete states (xd) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdxd(:,:) !< Partial derivatives of constraint state", -" !! functions (Z) with respect to the", -" !! discrete states (xd) [intent in to avoid deallocation]", -"", -"", -" ! Initialize ErrStat", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -"", -"", -" IF ( PRESENT( dYdxd ) ) THEN", -"", -" ! Calculate the partial derivative of the output functions (Y) with respect to the discrete states (xd) here:", -"", -" ! allocate and set dYdxd", -"", -" END IF", -"", -" IF ( PRESENT( dXdxd ) ) THEN", -"", -" ! Calculate the partial derivative of the continuous state functions (X) with respect to the discrete states (xd) here:", -"", -" ! allocate and set dXdxd", -"", -" END IF", -"", -" IF ( PRESENT( dXddxd ) ) THEN", -"", -" ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the discrete states (xd) here:", -"", -" ! allocate and set dXddxd", -"", -" END IF", -"", -" IF ( PRESENT( dZdxd ) ) THEN", -"", -" ! Calculate the partial derivative of the constraint state functions (Z) with respect to the discrete states (xd) here:", -"", -" ! allocate and set dZdxd", -"", -" END IF", -"", -"", -"END SUBROUTINE ModName_JacobianPDiscState", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions", -"!! with respect to the constraint states (z). The partial derivatives dY/dz, dX/dz, dXd/dz, and dZ/dz are returned.", -"SUBROUTINE ModName_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz )", -"!..................................................................................................................................", -"", -" REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point", -" TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required)", -" TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point", -" TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point", -" TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point", -" TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point", -" TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required);", -" !! Output fields are not used by this routine, but type is", -" !! available here so that mesh parameter information (i.e.,", -" !! connectivity) does not have to be recalculated for dYdz.", -" TYPE(ModName_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", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdz(:,:) !< Partial derivatives of output", -" !! functions (Y) with respect to the", -" !! constraint states (z) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdz(:,:) !< Partial derivatives of continuous", -" !! state functions (X) with respect to", -" !! the constraint states (z) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddz(:,:) !< Partial derivatives of discrete state", -" !! functions (Xd) with respect to the", -" !! constraint states (z) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdz(:,:) !< Partial derivatives of constraint", -" !! state functions (Z) with respect to", -" !! the constraint states (z) [intent in to avoid deallocation]", -"", -"", -" ! Initialize ErrStat", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -"", -" IF ( PRESENT( dYdz ) ) THEN", -"", -" ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z) here:", -"", -" ! allocate and set dYdz", -"", -" END IF", -"", -" IF ( PRESENT( dXdz ) ) THEN", -"", -" ! Calculate the partial derivative of the continuous state functions (X) with respect to the constraint states (z) here:", -"", -" ! allocate and set dXdz", -"", -" END IF", -"", -" IF ( PRESENT( dXddz ) ) THEN", -"", -" ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the constraint states (z) here:", -"", -" ! allocate and set dXddz", -"", -" END IF", -"", -" IF ( PRESENT( dZdz ) ) THEN", -"", -" ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z) here:", -"", -" ! allocate and set dZdz", -"", -" END IF", -"", -"", -"END SUBROUTINE ModName_JacobianPConstrState", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> Routine to pack the data structures representing the operating points into arrays for linearization.", -"SUBROUTINE ModName_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op )", -"", -" REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point", -" TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required)", -" TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point", -" TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point", -" TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point", -" TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point", -" TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output at operating point", -" TYPE(ModName_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", -" REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs", -" REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs", -" REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states", -" REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states", -" REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states", -" REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states", -"", -"", -" ! Initialize ErrStat", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -"", -" IF ( PRESENT( u_op ) ) THEN", -"", -" END IF", -"", -" IF ( PRESENT( y_op ) ) THEN", -" END IF", -"", -" IF ( PRESENT( x_op ) ) THEN", -"", -" END IF", -"", -" IF ( PRESENT( dx_op ) ) THEN", -"", -" END IF", -"", -" IF ( PRESENT( xd_op ) ) THEN", -"", -" END IF", -"", -" IF ( PRESENT( z_op ) ) THEN", -"", -" END IF", -"", -"END SUBROUTINE ModName_GetOP", -"!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++", -"", -"END MODULE ModuleName", -"!**********************************************************************************************************************************", -0L } ; diff --git a/OpenFAST/modules/openfast-registry/src/Template_registry.c b/OpenFAST/modules/openfast-registry/src/Template_registry.c deleted file mode 100644 index e06dc7dca..000000000 --- a/OpenFAST/modules/openfast-registry/src/Template_registry.c +++ /dev/null @@ -1,81 +0,0 @@ -char *template_registry[] = { -"###################################################################################################################################", -"# Registry for ModuleName in the FAST Modularization Framework", -"# This Registry file is used to create MODULE ModuleName_Types, which contains all of the user-defined types needed in ModuleName.", -"# It also contains copy, destroy, pack, and unpack routines associated with each defined data types.", -"#", -"# Entries are of the form", -"# keyword ", -"#", -"# Use ^ as a shortcut for the value from the previous line.", -"# See NWTC Programmer's Handbook at https://nwtc.nrel.gov/FAST-Developers for further information on the format/contents of this file.", -"###################################################################################################################################", -"", -"# ...... Include files (definitions from NWTC Library) ............................................................................", -"include Registry_NWTC_Library.txt", -"", -"", -"# ..... Initialization data .......................................................................................................", -"# Define inputs that the initialization routine may need here:", -"# e.g., the name of the input file, the file root name, etc.", -"typedef ModuleName/ModName InitInputType CHARACTER(1024) InputFile - - - \"Name of the input file; remove if there is no file\" -", -"typedef ^ ^ LOGICAL Linearize - .FALSE. - \"Flag that tells this module if the glue code wants to linearize.\" -", -"", -"# Define outputs from the initialization routine here:", -"typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - \"Names of the output-to-file channels\" -", -"typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - \"Units of the output-to-file channels\" -", -"# if this module has implemented linearization, return the names of the rows/columns of the Jacobian matrices:", -"#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - \"Names of the outputs used in linearization\" - ", -"#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_x {:} - - \"Names of the continuous states used in linearization\" -", -"#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_xd {:} - - \"Names of the discrete states used in linearization\" -", -"#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_z {:} - - \"Names of the constraint states used in linearization\" -", -"#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_u {:} - - \"Names of the inputs used in linearization\" -", -"#typedef ^ InitOutputType LOGICAL RotFrame_y {:} - - \"Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame\" -", -"#typedef ^ InitOutputType LOGICAL RotFrame_x {:} - - \"Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame\" -", -"#typedef ^ InitOutputType LOGICAL RotFrame_xd {:} - - \"Flag that tells FAST if the discrete states used in linearization are in the rotating frame\" -", -"#typedef ^ InitOutputType LOGICAL RotFrame_z {:} - - \"Flag that tells FAST if the constraint states used in linearization are in the rotating frame\" -", -"#typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - \"Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame\" -", -"#typedef ^ InitOutputType LOGICAL IsLoad_u {:} - - \"Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrices)\" -", -"#typedef ^ InitOutputType IntKi DerivOrder_x {:} - - \"Integer that tells FAST/MBC3 the order derivative for the continuous states used in linearization\" -", -"", -"", -"# ..... States ....................................................................................................................", -"# Define continuous (differentiable) states here:", -"typedef ^ ContinuousStateType ReKi DummyContState - - - \"Remove this variable if you have continuous states\" -", -"", -"# Define discrete (nondifferentiable) states here:", -"typedef ^ DiscreteStateType ReKi DummyDiscState - - - \"Remove this variable if you have discrete states\" -", -"", -"# Define constraint states here:", -"typedef ^ ConstraintStateType ReKi DummyConstrState - - - \"Remove this variable if you have constraint states\" -", -"", -"# Define any other states, including integer or logical states here:", -"typedef ^ OtherStateType IntKi DummyOtherState - - - \"Remove this variable if you have other states\" -", -"", -"", -"# ..... Misc/Optimization variables.................................................................................................", -"# 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 ReKi DummyMiscVar - - - \"Remove this variable if you have misc/optimization variables\" -", -"", -"", -"# ..... Parameters ................................................................................................................", -"# Define parameters here:", -"# Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states:", -"typedef ^ ParameterType DbKi DT - - - \"Time step for cont. state integration & disc. state update\" seconds", -"", -"", -"# ..... Inputs ....................................................................................................................", -"# Define inputs that are contained on the mesh here:", -"#typedef ^ InputType MeshType MeshedInput - - - \"Meshed data\" -", -"# Define inputs that are not on this mesh here:", -"typedef ^ InputType ReKi DummyInput - - - \"Remove this variable if you have input data\" -", -"", -"", -"# ..... Outputs ...................................................................................................................", -"# Define outputs that are contained on the mesh here:", -"#typedef ^ OutputType MeshType MeshedOutput - - - \"Meshed data\" -", -"# Define outputs that are not on this mesh here:", -"typedef ^ OutputType ReKi WriteOutput {:} - - \"Example of data to be written to an output file\" \"s,-\"", -"", -0L } ; diff --git a/OpenFAST/modules/openfast-registry/src/data.c b/OpenFAST/modules/openfast-registry/src/data.c deleted file mode 100644 index 3224b9118..000000000 --- a/OpenFAST/modules/openfast-registry/src/data.c +++ /dev/null @@ -1,229 +0,0 @@ -#include -#include -#include -#ifdef _WIN32 -#define rindex(X,Y) strrchr(X,Y) -#define index(X,Y) strchr(X,Y) -#define bzero(X,Y) memset(X,0,Y) -#else -# include -#endif - -#include "registry.h" -#include "protos.h" -#include "data.h" - -int -init_modname_table() -{ - ModNames = NULL ; - return(0) ; -} - -int -init_dim_table() -{ - Dim = NULL ; - return(0) ; -} - -node_t * -new_node ( int kind ) -{ node_t *p ; - p = (node_t *)malloc(sizeof(node_t)) ; - bzero(p,sizeof(node_t)); - p->node_kind = kind ; - - p->fields = NULL; - p->params = NULL; - p->type = NULL; - p->module = NULL; - p->module_ddt_list = NULL; - p->next = NULL; - //p->coord_end_param = NULL; - strcpy(p->dim_param_name, ""); - p->dim_param = 0; - p->type_type = 0; - p->max_ndims = 0; - p->containsPtr = 0; - p->ndims = 0; - p->deferred = 0; - p->usefrom = 0; - p->is_interface_type = 0; - strcpy(p->name, ""); - strcpy(p->mapsto, ""); - strcpy(p->nickname, ""); - strcpy(p->descrip, ""); - strcpy(p->units, ""); - - return (p) ; } - -int -add_node_to_end ( node_t * node , node_t ** list ) -{ - node_t * p ; - if ( *list == NULL ) - { *list = node ; } - else - { - for ( p = *list ; p->next != NULL ; p = p->next ) ; - p->next = node ; - } - return(0) ; -} - -int -add_node_to_beg ( node_t * node , node_t ** list ) -{ - node_t * p ; - if ( *list == NULL ) - { - *list = node ; - (*list)->next = NULL ; - } - else - { -//fprintf(stderr," add_node_to_beg: node %s to existing list. CH %s CN %08x\n", node->name,(*list)->name,(*list)->next) ; -//if ( (*list)->next ) fprintf(stderr," CN name %s\n",(*list)->next->name ) ; - p = (*list) ; - *list = node ; - (*list)->next = p ; - } - return(0) ; -} - - -#if 0 -int -add_node_to_end_4d ( node_t * node , node_t ** list ) -{ - node_t * p ; - if ( *list == NULL ) - { *list = node ; } - else - { - for ( p = *list ; p->next4d != NULL ; p = p->next4d ) ; - p->next4d = node ; - } - return(0) ; -} -#endif - -#if 1 - -void -show_nodelist( node_t * p ) -{ - show_nodelist1( p , 0 ) ; -} - -void -show_nodelist1( node_t * p , int indent ) -{ - if ( p == NULL ) return; - show_node1( p, indent) ; - show_nodelist1( p->next, indent ) ; -} - -int -show_node( node_t * p ) -{ - return(show_node1(p,0)) ; -} - -int -show_node1( node_t * p, int indent ) -{ - char spaces[] = " " ; - char tmp[25] , t1[25] , t2[25] ; - char * x, *ca, *ld, *ss, *se, *sg ; - char *nodekind ; - int nl ; - int i ; - - if ( p == NULL ) return(1) ; - strcpy(tmp, spaces) ; - if ( indent >= 0 && indent < 20 ) tmp[indent] = '\0' ; - -// this doesn't make much sense any more, ever since node_kind was -// changed to a bit mask - nodekind = "" ; - if ( p->node_kind & FIELD ) nodekind = "FIELD" ; - else if ( p->node_kind & MODNAME ) nodekind = "MODNAME" ; - else if ( p->node_kind & TYPE ) nodekind = "TYPE" ; - - switch ( p->node_kind ) - { - case MODNAME : - fprintf(stderr,"%s%s : %s nickname %s\n",tmp,nodekind,p->name,p->nickname) ; - show_nodelist1(p->module_ddt_list, indent+1) ; - break ; - case FIELD : - fprintf(stderr,"%s%s : %10s ndims %1d\n",tmp,nodekind,p->name, p->ndims) ; - for ( i = 0 ; i < p->ndims ; i++ ) - { - sg = "" ; - ca = "" ; - switch ( p->dims[i]->coord_axis ) { - case COORD_C : ca = "C" ; break ; - } - switch ( p->dims[i]->len_defined_how ) { - case DOMAIN_STANDARD : ld = "STANDARD" ; ss = "" ; se = "" ; break ; - case CONSTANT : ld = "CONSTANT" ; sprintf(t1,"%d",p->dims[i]->coord_start) ; ss = t1 ; - sprintf(t2,"%d",p->dims[i]->coord_end ) ; se = t2 ; - break ; - } - fprintf(stderr," dim %0d: {%s} %2s%s %10s %10s %10s\n",i,p->dims[i]->dim_name,ca,sg,ld,ss,se) ; - } - nl = 0 ; - if ( strlen( p->use ) > 0 ) { - nl = 1 ; fprintf(stderr," use: %s",p->use) ; - } - if ( strlen( p->descrip ) > 0 ) { nl = 1 ; fprintf(stderr," descrip: %s",p->descrip) ; } - if ( nl == 1 ) fprintf(stderr,"\n") ; - show_node1( p->type, indent+1 ) ; - break ; - case TYPE : - x = "derived" ; - if ( p->type_type == SIMPLE ) x = "simple" ; - fprintf(stderr,"%sTYPE : %10s %s ndims %1d\n",tmp,p->name,x, p->ndims) ; - show_nodelist1( p->fields, indent+1 ) ; - break ; - case DIM : - break ; - default : - break ; - } - return(0) ; -} -#endif - -int -set_mark ( int val , node_t * lst ) -{ - node_t * p ; - if ( lst == NULL ) return(0) ; - for ( p = lst ; p != NULL ; p = p->next ) - { - p->mark = val ; - set_mark( val , p->fields ) ; - } - return(0) ; -} - -#if 0 -int -set_mark_4d ( int val , node_t * lst ) -{ - node_t * p ; - if ( lst == NULL ) return(0) ; - for ( p = lst ; p != NULL ; p = p->next4d ) - { - p->mark = val ; - set_mark( val , p->fields ) ; - set_mark( val , p->members ) ; - } - return(0) ; -} -#endif - diff --git a/OpenFAST/modules/openfast-registry/src/data.h b/OpenFAST/modules/openfast-registry/src/data.h deleted file mode 100644 index bc81980c7..000000000 --- a/OpenFAST/modules/openfast-registry/src/data.h +++ /dev/null @@ -1,132 +0,0 @@ -#ifndef DATA_H -#include "registry.h" - -typedef struct node_struct { - - int node_kind ; - int type_type ; - char name[NAMELEN] ; - char mapsto[NAMELEN] ; - char nickname[NAMELEN] ; - struct node_struct * fields ; - struct node_struct * params ; - struct node_struct * type ; - struct node_struct * module ; /* type node pointer back to module node it is defined in */ - int max_ndims; // max number of dimensions (so we don't have hundreds of unused variables that produce warnings) - int containsPtr; // if contains a pointer in type/subtype - int ndims ; - struct node_struct * dims[MAXDIMS] ; - int proc_orient ; /* ALL_[ZXY]_ON_PROC which dimension is all on processor */ - int ntl ; - int subject_to_communication ; - int boundary_array ; - int boundary_array_4d ; - char use[NAMELEN] ; - char inival[NAMELEN] ; - char descrip[NAMELEN] ; - char units[NAMELEN] ; - -/* I/O flags */ - int restart ; - int boundary ; - int namelist ; - char namelistsection[NAMELEN] ; - -/* Fields for Modname */ - struct node_struct * module_ddt_list ; - - -/* CTRL */ - int gen_periodic ; - struct node_struct * next ; - -/* fields used by rconfig nodes */ - char nentries[NAMELEN] ; - char howset[NAMELEN] ; - char dflt[NAMELEN] ; - -/* fields used by Dim nodes */ - - char dim_name[32] ; - char dim_data_name[NAMELEN] ; - int coord_axis ; /* X, Y, Z, C */ - /* DOMAIN_STANDARD, NAMELIST, CONSTANT */ - int len_defined_how ; - char assoc_nl_var_s[NAMELEN] ; /* for NAMELIST */ - char assoc_nl_var_e[NAMELEN] ; /* for NAMELIST */ - int coord_start ; /* for CONSTANT */ - int coord_end ; /* for CONSTANT */ - int dim_param; /* for using PARAMETER dimension */ - char dim_param_name[NAMELEN]; /* for using PARAMETER dimension */ - - int dim_order ; /* order that dimensions are specified - in framework */ - int subgrid ; /* 1=subgrid dimension */ - int deferred ; /* a deferred-shape dimension, that is, a colon */ - - int usefrom ; - -/* fields used by Package nodes */ - char pkg_assoc[NAMELEN] ; - char pkg_statevars[NAMELEN] ; - char pkg_4dscalars[NAMELEN_LONG] ; - -/* fields used by Comm (halo, period, xpose) nodes */ - char comm_define[2*8192] ; - - int is_interface_type ; - -/* marker */ - int mark ; - -} node_t ; - -#ifndef DEFINE_GLOBALS -# define EXTERN extern -#else -# define EXTERN -#endif - -EXTERN int sw_output_template_force ; -EXTERN char sw_commpath[NAMELEN] ; -EXTERN char sw_modname_subst[NAMELEN] ; -EXTERN char sw_modnickname_subst[NAMELEN] ; -EXTERN int sw_new_bdys ; /* 20070207 JM support decomposed boundary arrays */ -EXTERN int sw_unidir_shift_halo ; /* 20100210 JM assume that halo to shift is same in both directions and only gen one of them */ -EXTERN int sw_new_with_old_bdys ; /* 20070207 JM for debugging interim phase, new comms w/ old data structs */ -EXTERN int sw_norealloc_lsh; /* 20070207 addresses compilers like gfortran that do not /assume:realloc_lhs */ -EXTERN int sw_ccode ; /* 20130523 generate C code too */ -EXTERN int sw_noextrap; -EXTERN char sw_shownodes ; - -EXTERN node_t * Type ; -EXTERN node_t * Dim ; -EXTERN node_t * Packages ; -EXTERN node_t * Halos ; -EXTERN node_t * Periods ; -EXTERN node_t * Xposes ; -EXTERN node_t * FourD ; -EXTERN node_t * Swaps ; -EXTERN node_t * Cycles ; -EXTERN node_t * ModNames ; - -EXTERN node_t Domain ; - -EXTERN char t1[NAMELEN], t2[NAMELEN], t3[NAMELEN], t4[NAMELEN], t5[NAMELEN], t6[NAMELEN] ; -EXTERN char thiscom[NAMELEN] ; - -EXTERN int max_time_level ; /* Maximum number of time levels of any state variable */ - -#define MAXINCLDIRS 50 -EXTERN int nincldirs ; -EXTERN char IncludeDirs[MAXINCLDIRS][NAMELEN] ; -EXTERN char OutDir[NAMELEN]; - -#define P_XSB 1 -#define P_XEB 2 -#define P_YSB 3 -#define P_YEB 4 - - -#define DATA_H -#endif diff --git a/OpenFAST/modules/openfast-registry/src/gen_c_types.c b/OpenFAST/modules/openfast-registry/src/gen_c_types.c deleted file mode 100644 index 74bd14d66..000000000 --- a/OpenFAST/modules/openfast-registry/src/gen_c_types.c +++ /dev/null @@ -1,428 +0,0 @@ -#include -#include -#include -#include -#ifndef _WIN32 -# include -#endif - -#include "protos.h" -#include "registry.h" -#include "data.h" - - -#if 0 -void -gen_c_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) -{ - char tmp[NAMELEN], tmp2[NAMELEN], tmp3[NAMELEN], tmp4[NAMELEN], addnick[NAMELEN], nonick[NAMELEN] ; - node_t *q, * r ; - int d, idim, frst ; - - remove_nickname(ModName->nickname,inout,nonick) ; - append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; - sprintf(tmp,"%s",addnick) ; - if (( q = get_entry( make_lower_temp(tmp),ModName->module_ddt_list ) ) == NULL ) - { - fprintf(stderr,"Registry warning: generating %s_Unpack%s: cannot find definition for %s\n",ModName->nickname,nonick,tmp) ; - return;//(1) ; - } - -fprintf(fp,"\nint\n") ; -fprintf(fp,"C_%s_Unpack%s( float * ReKiBuf, \n",ModName->nickname,nonick) ; -fprintf(fp," double * DbKiBuf, \n") ; -fprintf(fp," int * IntKiBuf, \n") ; -fprintf(fp," %s_t *OutData, char * ErrMsg )\n", addnick) ; -fprintf(fp,"{\n") ; -fprintf(fp," int ErrStat = 0;\n") ; -fprintf(fp," int Re_BufSz2 = 0 ;\n") ; -fprintf(fp," int Db_BufSz2 = 0 ;\n") ; -fprintf(fp," int Int_BufSz2 = 0 ;\n") ; -fprintf(fp," int Re_Xferred = 0 ;\n") ; -fprintf(fp," int Db_Xferred = 0 ;\n") ; -fprintf(fp," int Int_Xferred = 0 ;\n") ; -fprintf(fp," int Re_CurrSz = 0 ;\n") ; -fprintf(fp," int Db_CurrSz = 0 ;\n") ; -fprintf(fp," int Int_CurrSz = 0 ;\n") ; -fprintf(fp," int one = 1 ;\n") ; -fprintf(fp," int i,i1,i2,i3,i4,i5 ;\n") ; - - fprintf(fp," // buffers to store meshes, if any\n") ; - for ( r = q->fields ; r ; r = r->next ) - { - if ( r->type == NULL ) { - fprintf(stderr,"Registry warning generating %s_Unpack%s: %s has no type.\n",ModName->nickname,nonick,r->name) ; - return ; // EARLY RETURN - } else { - if ( !strcmp( r->type->name, "meshtype" ) || (r->type->type_type == DERIVED && ! r->type->usefrom ) ) { - fprintf(fp," float * Re_%s_Buf ;\n",r->name) ; - fprintf(fp," double * Db_%s_Buf ;\n",r->name) ; - fprintf(fp," int * Int_%s_Buf ;\n",r->name) ; - } - } - } -fprintf(fp," ReKiBuf = NULL ;\n") ; -fprintf(fp," DbKiBuf = NULL ;\n") ; -fprintf(fp," IntKiBuf = NULL ;\n") ; - - // Unpack data - frst = 1 ; - for ( r = q->fields ; r ; r = r->next ) - { - if ( r->type->type_type == DERIVED && ! r->type->usefrom && strcmp(make_lower_temp(r->type->mapsto),"meshtype") ) { - char nonick2[NAMELEN] ; - remove_nickname(ModName->nickname,r->type->name,nonick2) ; - fprintf(fp," // first call %s_Pack%s to get correctly sized buffers for unpacking\n", - ModName->nickname,fast_interface_type_shortname(nonick2)) ; - fprintf(fp," ErrStat = C_%s_Pack%s( Re_%s_Buf, &Re_BufSz2, Db_%s_Buf, &Db_BufSz2, Int_%s_Buf, &Int_BufSz2, &(OutData->%s%s), ErrMsg, &one ) ; // %s \n", - ModName->nickname,fast_interface_type_shortname(nonick2), r->name, r->name, r->name, r->name, dimstr_c(r->ndims),r->name ) ; - - fprintf(fp," if ( Re_%s_Buf != NULL ) {\n",r->name) ; - fprintf(fp," memcpy( Re_%s_Buf, &(ReKiBuf[ Re_Xferred] ), Re_BufSz2 ) ;\n",r->name ) ; - fprintf(fp," Re_Xferred += Re_BufSz2 ; // %s \n",r->name) ; - fprintf(fp," }\n" ) ; - fprintf(fp," if ( Db_%s_Buf != NULL ) {\n",r->name) ; - fprintf(fp," memcpy( Db_%s_Buf, &(DbKiBuf[ Db_Xferred] ), Db_BufSz2 ) ;\n",r->name ) ; - fprintf(fp," Db_Xferred += Db_BufSz2 ; // %s \n",r->name) ; - fprintf(fp," }\n" ) ; - fprintf(fp," if ( Int_%s_Buf != NULL ) {\n",r->name) ; - fprintf(fp," memcpy( Int_%s_Buf, &(IntKiBuf[ Int_Xferred] ), Int_BufSz2 ) ;\n",r->name ) ; - fprintf(fp," Int_Xferred += Int_BufSz2 ; // %s \n",r->name) ; - fprintf(fp," }\n" ) ; - fprintf(fp," ErrStat = C_%s_Unpack%s( Re_%s_Buf, Db_%s_Buf, Int_%s_Buf, &(OutData->%s%s), ErrMsg ) ; // %s \n", - ModName->nickname,fast_interface_type_shortname(nonick2), r->name, r->name, r->name, r->name, - dimstr(r->ndims), - r->name ) ; -// fprintf(fp," if ( Re_%s_Buf != NULL) { free(Re_%s_Buf) ; Re_%s_Buf = NULL ;} \n",r->name, r->name, r->name) ; -// fprintf(fp," if ( Db_%s_Buf != NULL) { free(Db_%s_Buf) ; Db_%s_Buf = NULL ;}\n",r->name, r->name, r->name) ; -// fprintf(fp," if ( Int_%s_Buf != NULL) { free(Int_%s_Buf) ; Int_%s_Buf = NULL ;} \n",r->name, r->name, r->name) ; - - } else { - char * indent, * ty ; - char arrayname[NAMELEN], tmp[NAMELEN], tmp2[NAMELEN] ; - - sprintf(arrayname,"OutData%%%s",r->name) ; - sprintf(tmp2,"SIZE(OutData%%%s)",r->name) ; - if ( r->ndims==0 ) { strcpy(tmp3,"") ; } - else if ( r->ndims==1 ) { strcpy(tmp3,"") ; } - else if ( r->ndims==2 ) { sprintf(tmp3,"(1:(%s),1)",tmp2) ; } - else if ( r->ndims==3 ) { sprintf(tmp3,"(1:(%s),1,1)",tmp2) ; } - else if ( r->ndims==4 ) { sprintf(tmp3,"(1:(%s),1,1,1)",tmp2) ; } - else if ( r->ndims==5 ) { sprintf(tmp3,"(1:(%s),1,1,1,1)",tmp2) ; } - else { fprintf(stderr,"Registry WARNING: too many dimensions for %s\n",r->name) ; } - indent = "" ; - if ( !strcmp( r->type->mapsto, "REAL(ReKi)") || - !strcmp( r->type->mapsto, "REAL(DbKi)") || - !strcmp( r->type->mapsto, "INTEGER(IntKi)") ) { - if ( r->ndims > 0 && has_deferred_dim( r, 0 )) { - fprintf(fp," if ( OutData->%s != NULL ) {\n", r->name ) ; - indent = " " ; - } - - if ( !strcmp( r->type->mapsto, "REAL(ReKi)") ) ty = "Re" ; - if ( !strcmp( r->type->mapsto, "REAL(DbKi)") ) ty = "Db" ; - if ( !strcmp( r->type->mapsto, "REAL(IntKi)") ) ty = "Int" ; - - if ( r->ndims > 0 ) { - if ( has_deferred_dim( r, 0 ) ) { - fprintf(fp,"%s memcpy( OutData->%s,&(%sKiBuf[ %s_Xferred ]),OutData->%s_Len) ;\n",indent,r->name,ty,ty,r->name) ; - fprintf(fp,"%s %s_Xferred = %s_Xferred + OutData->%s_Len ; \n",indent,ty,ty,r->name ) ; - } else { - int i ; - strcpy(tmp2,"") ; - for ( i = 0 ; i < r->ndims ; i++ ) - { - sprintf(tmp,"((%d)-(%d)+1)",r->dims[i]->coord_end,r->dims[i]->coord_start) ; - strcat(tmp2,tmp) ; - if ( i < r->ndims-1 ) strcat(tmp2,"*") ; - } - fprintf(fp,"%s memcpy( OutData->%s,&(%sKiBuf[ %s_Xferred ]),(%s)*sizeof(%s)) ;\n", - indent,r->name,ty,ty,tmp2,C_type(r->type->mapsto)) ; - fprintf(fp,"%s %s_Xferred = %s_Xferred + (%s)*sizeof(%s) ; \n", - indent,ty,ty,tmp2,C_type(r->type->mapsto) ) ; - } - } else { - fprintf(fp,"%s OutData->%s = %sKiBuf [ %s_Xferred ] ; \n",indent,r->name,ty,ty) ; - fprintf(fp,"%s %s_Xferred = %s_Xferred + 1 ; \n",indent,ty,ty ) ; - } - - if ( r->ndims > 0 && has_deferred_dim( r, 0 )) { - fprintf(fp," }\n" ) ; - } - - } - } - } - fprintf(fp," if ( ReKiBuf != NULL ) free(ReKiBuf) ;\n") ; - fprintf(fp," if ( DbKiBuf != NULL ) free(DbKiBuf) ;\n") ; - fprintf(fp," if ( IntKiBuf != NULL ) free(IntKiBuf) ;\n") ; - fprintf(fp," return(ErrStat) ;\n") ; - fprintf(fp,"}\n") ; - return;//(0) ; -} - -void -gen_c_pack( FILE * fp, const node_t * ModName, char * inout, char *inoutlong ) -{ - char tmp[NAMELEN], tmp2[NAMELEN], tmp3[NAMELEN], addnick[NAMELEN], nonick[NAMELEN] ; - node_t *q, * r ; - int frst, d ; - - remove_nickname(ModName->nickname,inout,nonick) ; - append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; - sprintf(tmp,"%s",addnick) ; - if (( q = get_entry( make_lower_temp(tmp),ModName->module_ddt_list ) ) == NULL ) - { - fprintf(stderr,"Registry warning: generating %s_Pack%s: cannot find definition for %s\n",ModName->nickname,nonick,tmp) ; - return;//(1) ; - } -fprintf(fp,"\nint\n") ; -fprintf(fp,"C_%s_Pack%s( float * ReKiBuf, int * Re_BufSz ,\n",ModName->nickname,nonick) ; -fprintf(fp," double * DbKiBuf, int * Db_BufSz ,\n") ; -fprintf(fp," int * IntKiBuf, int * Int_BufSz ,\n") ; -fprintf(fp," %s_t *InData, char * ErrMsg, int *SizeOnly )\n", addnick) ; -fprintf(fp,"{\n") ; -fprintf(fp," int ErrStat = 0;\n") ; -fprintf(fp," int OnlySize ;\n") ; -fprintf(fp," int Re_BufSz2 ;\n") ; -fprintf(fp," int Db_BufSz2 ;\n") ; -fprintf(fp," int Int_BufSz2 ;\n") ; -fprintf(fp," int Re_Xferred = 0 ;\n") ; -fprintf(fp," int Db_Xferred = 0 ;\n") ; -fprintf(fp," int Int_Xferred = 0 ;\n") ; -fprintf(fp," int one = 1 ;\n") ; -fprintf(fp," int i,i1,i2,i3,i4,i5 ;\n") ; -fprintf(fp," // buffers to store meshes and subtypes, if any\n") ; - - for ( r = q->fields ; r ; r = r->next ) - { - if ( r->type == NULL ) { - fprintf(stderr,"Registry warning generating %s_Pack%s: %s has no type.\n",ModName->nickname,nonick,r->name) ; - return ; // EARLY RETURN - } else { - if ( !strcmp( r->type->name, "meshtype" ) || (r->type->type_type == DERIVED && ! r->type->usefrom ) ) { - fprintf(fp," float * Re_%s_Buf ;\n",r->name) ; - fprintf(fp," double * Db_%s_Buf ;\n",r->name) ; - fprintf(fp," int * Int_%s_Buf ;\n",r->name) ; - } - } - } - -fprintf(fp,"\n") ; -fprintf(fp," OnlySize = *SizeOnly ;\n") ; -fprintf(fp,"\n") ; -fprintf(fp," *Re_BufSz = 0 ;\n") ; -fprintf(fp," *Db_BufSz = 0 ;\n") ; -fprintf(fp," *Int_BufSz = 0 ;\n") ; -fprintf(fp," ReKiBuf = NULL ;\n") ; -fprintf(fp," DbKiBuf = NULL ;\n") ; -fprintf(fp," IntKiBuf = NULL ;\n") ; - frst = 1 ; - for ( r = q->fields ; r ; r = r->next ) - { - if ( r->type->type_type == DERIVED && ! r->type->usefrom && strcmp(make_lower_temp(r->type->mapsto),"meshtype") ) { - char nonick2[NAMELEN] ; - remove_nickname(ModName->nickname,r->type->name,nonick2) ; - fprintf(fp," ErrStat = C_%s_Pack%s( Re_%s_Buf, &Re_BufSz2 ,\n", - ModName->nickname,fast_interface_type_shortname(nonick2), r->name) ; - fprintf(fp," Db_%s_Buf, &Db_BufSz2 ,\n",r->name ) ; - fprintf(fp," Int_%s_Buf, &Int_BufSz2 , &(InData->%s%s), ErrMsg, &one ) ; // %s \n", - r->name, r->name, dimstr(r->ndims), r->name ) ; - fprintf(fp," *Re_BufSz += Re_BufSz2 ; // %s\n",r->name ) ; - fprintf(fp," *Db_BufSz += Db_BufSz2 ; // %s\n",r->name ) ; - fprintf(fp," *Int_BufSz += Int_BufSz2 ; // %s\n",r->name ) ; - fprintf(fp," if ( Re_%s_Buf != NULL) { free(Re_%s_Buf) ; Re_%s_Buf = NULL ;} \n",r->name, r->name, r->name) ; - fprintf(fp," if ( Db_%s_Buf != NULL) { free(Db_%s_Buf) ; Db_%s_Buf = NULL ;}\n",r->name, r->name, r->name) ; - fprintf(fp," if ( Int_%s_Buf != NULL) { free(Int_%s_Buf) ; Int_%s_Buf = NULL ;} \n",r->name, r->name, r->name) ; - } else if ( r->ndims == 0 ) { // scalars - if ( !strcmp( r->type->mapsto, "REAL(ReKi)") ) { - fprintf(fp," *Re_BufSz += 1 ; // %s\n",r->name ) ; - } - else if ( !strcmp( r->type->mapsto, "REAL(DbKi)") ) { - fprintf(fp," *Db_BufSz += 1 ; // %s\n",r->name ) ; - } - else if ( !strcmp( r->type->mapsto, "INTEGER(IntKi)") ) { - fprintf(fp," *Int_BufSz += 1 ; // %s\n",r->name ) ; - } - } else { // r->ndims > 0 - if ( r->dims[0]->deferred ) { - if ( !strcmp( r->type->mapsto, "REAL(ReKi)") ) { - fprintf(fp," *Re_BufSz += InData->%s_Len ; // %s \n", r->name , r->name ) ; - } - else if ( !strcmp( r->type->mapsto, "REAL(DbKi)") ) { - fprintf(fp," *Db_BufSz += InData->%s_Len ; // %s \n", r->name , r->name ) ; - } - else if ( !strcmp( r->type->mapsto, "INTEGER(IntKi)") ) { - fprintf(fp," *Int_BufSz += InData->%s_Len ; // %s \n", r->name , r->name ) ; - } - } else { - } - } - } - - fprintf(fp," if ( ! OnlySize ) {\n") ; - // Allocate buffers - fprintf(fp," if ( *Re_BufSz > 0 ) ReKiBuf = (float *)malloc(*Re_BufSz*sizeof(float) ) ;\n") ; - fprintf(fp," if ( *Db_BufSz > 0 ) DbKiBuf = (double *)malloc(*Db_BufSz*sizeof(double) ) ;\n") ; - fprintf(fp," if ( *Int_BufSz > 0 ) IntKiBuf = (int *)malloc(*Int_BufSz*sizeof(int) ) ;\n") ; - - // Pack data - for ( r = q->fields ; r ; r = r->next ) - { - if ( r->type->type_type == DERIVED && ! r->type->usefrom && strcmp(make_lower_temp(r->type->mapsto),"meshtype") ) { - char nonick2[NAMELEN] ; - remove_nickname(ModName->nickname,r->type->name,nonick2) ; - fprintf(fp," ErrStat = C_%s_Pack%s( Re_%s_Buf, &Re_BufSz2 ,\n", - ModName->nickname,fast_interface_type_shortname(nonick2), r->name) ; - fprintf(fp," Db_%s_Buf, &Db_BufSz2 ,\n",r->name ) ; - fprintf(fp," Int_%s_Buf, &Int_BufSz2 , &(InData->%s%s), ErrMsg, &one ) ; // %s \n", - r->name, r->name, dimstr(r->ndims), r->name ) ; - - fprintf(fp," if ( Re_%s_Buf != NULL ) {\n",r->name) ; - fprintf(fp," memcpy( &ReKiBuf[Re_Xferred], Re_%s_Buf, Re_BufSz2*sizeof(float) ) ;\n",r->name) ; - fprintf(fp," Re_Xferred += Re_BufSz2 ;\n") ; - fprintf(fp," }\n" ) ; - fprintf(fp," if ( Db_%s_Buf != NULL ) {\n",r->name) ; - fprintf(fp," memcpy( &DbKiBuf[Db_Xferred], Db_%s_Buf, Db_BufSz2*sizeof(double) ) ;\n",r->name) ; - fprintf(fp," Db_Xferred += Db_BufSz2 ;\n") ; - fprintf(fp," }\n" ) ; - fprintf(fp," if ( Int_%s_Buf != NULL ) {\n",r->name) ; - fprintf(fp," memcpy( &IntKiBuf[Int_Xferred], Int_%s_Buf, Int_BufSz2*sizeof(int) ) ;\n",r->name) ; - fprintf(fp," Int_Xferred += Int_BufSz2 ;\n") ; - fprintf(fp," }\n" ) ; - fprintf(fp," if ( Re_%s_Buf != NULL) { free(Re_%s_Buf) ; Re_%s_Buf = NULL ;} \n",r->name, r->name, r->name) ; - fprintf(fp," if ( Db_%s_Buf != NULL) { free(Db_%s_Buf) ; Db_%s_Buf = NULL ;}\n",r->name, r->name, r->name) ; - fprintf(fp," if ( Int_%s_Buf != NULL) { free(Int_%s_Buf) ; Int_%s_Buf = NULL ;} \n",r->name, r->name, r->name) ; - - } else { - char * indent, *ty, *cty ; - sprintf(tmp2,"InData->%s_Len)",r->name) ; - if ( r->ndims==0 ) { - strcpy(tmp3,"") ; - } else if ( r->ndims==1 ) { - strcpy(tmp3,"") ; - } else if ( r->ndims==2 ) { - sprintf(tmp3,"(1:(%s),1)",tmp2) ; - } else if ( r->ndims==3 ) { - sprintf(tmp3,"(1:(%s),1,1)",tmp2) ; - } else if ( r->ndims==4 ) { - sprintf(tmp3,"(1:(%s),1,1,1)",tmp2) ; - } else if ( r->ndims==5 ) { - sprintf(tmp3,"(1:(%s),1,1,1,1)",tmp2) ; - } else { - fprintf(stderr,"Registry WARNING: too many dimensions for %s\n",r->name) ; - } - indent = " " ; - if ( !strcmp( r->type->mapsto, "REAL(ReKi)") || - !strcmp( r->type->mapsto, "REAL(DbKi)") || - !strcmp( r->type->mapsto, "INTEGER(IntKi)") ) - { - if ( !strcmp( r->type->mapsto, "REAL(ReKi)") ) {ty = "Re" ; cty = "float" ; } - else if ( !strcmp( r->type->mapsto, "REAL(DbKi)") ) {ty = "Db" ; cty = "double" ; } - else if ( !strcmp( r->type->mapsto, "REAL(IntKi)") ) {ty = "Int" ; cty = "int" ; } - indent = " " ; - if ( r->ndims > 0 && has_deferred_dim( r, 0 )) { - fprintf(fp,"%sfor ( i = 0 ; i < InData->%s_Len ; i++ ) {\n",indent, r->name ) ; - fprintf(fp,"%s if ( !OnlySize ) memcpy( &(%sKiBuf[%s_Xferred+i]), &(InData->%s[i]), sizeof(%s)) ;\n", - indent,ty,ty,r->name,cty ) ; - fprintf(fp,"%s %s_Xferred++ ;\n",indent,ty) ; - fprintf(fp,"%s}\n",indent) ; - } else if ( r->ndims == 0 ) { - fprintf(fp," %sKiBuf[%s_Xferred++] = InData->%s ;\n",ty,ty,r->name) ; - } - } - } - } - -fprintf(fp," }\n") ; -fprintf(fp," return(ErrStat) ;\n") ; -fprintf(fp,"}\n") ; -return;//(0) ; -} -#endif - - -void -gen_c_module( FILE * fph, node_t * ModName ) -{ - node_t * q, * r ; - int i ; - char nonick[NAMELEN], star ; - - if ( strlen(ModName->nickname) > 0 ) { -// generate each derived data type - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - if ( q->usefrom == 0 ) { - if (*q->mapsto) remove_nickname(ModName->nickname, make_lower_temp(q->mapsto), nonick); - fprintf(fph, " typedef struct %s {\n",q->mapsto) ; - //if (!strcmp(make_lower_temp(nonick), "otherstatetype") !strcmp(make_lower_temp(nonick), "initinputtype")){ - fprintf(fph, " void * object ;\n"); - //} - for ( r = q->fields ; r ; r = r->next ) - { - if ( r->type != NULL ) { - star = ' ' ; - if ( r->ndims > 0 ) { - if ( has_deferred_dim(r, 0) ) star = '*'; - } - if ( r->type->type_type == DERIVED ) { - if ( strcmp(make_lower_temp(r->type->mapsto),"meshtype") ) { // do not output mesh types for C code, - //fprintf(fph," struct %s %c%s",r->type->mapsto,star,r->name ) ; - } - } else { - char tmp[NAMELEN] ; tmp[0] = '\0' ; - if (*q->mapsto) remove_nickname( ModName->nickname, make_lower_temp(q->mapsto) , tmp ) ; - if (r->ndims > 0 && has_deferred_dim(r, 0)) { - fprintf(fph," %s * %s ; ",C_type( r->type->mapsto), r->name ) ; - fprintf(fph," int %s_Len ;",r->name ) ; - } else { - char *p = r->type->mapsto; - char buf[10]; -// bjj: this assumes all character strings are defined with numeric lengths -// It should be modified to allow use of parameters, too. (and parameters defined in the registry should also be defined in the .h file) - while (*p) { - if (isdigit(*p)) { - long val = strtol(p, &p, 10); - snprintf(buf, 10, "%lu", val); - } else { - p++; - } - - - } - if (strcmp(C_type(r->type->mapsto), "char") == 0 ){ // if it's a char we need to add the array size - if (r->ndims == 0) - fprintf(fph," %s %s[%s] ;",C_type( r->type->mapsto ),r->name,buf ) ; - } else { // else, it's just a double or int value - fprintf(fph," %s %s ;",C_type( r->type->mapsto ),r->name ) ; - } - } - } - for ( i = 0 ; i < r->ndims ; i++ ) - { - if (!has_deferred_dim(r, 0) && (strcmp(C_type(r->type->mapsto), "char") || r->ndims == 0)) // skip this for characters? - fprintf(fph,"[%d] ;",r->dims[i]->coord_end - r->dims[i]->coord_start +1) ; - } - fprintf(fph, "\n"); - } - } - fprintf(fph," } %s_t ;\n", q->mapsto ) ; - } - } - - - fprintf(fph," typedef struct %s_UserData {\n", ModName->nickname) ; - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - remove_nickname(ModName->nickname,q->name,nonick) ; - if ( is_a_fast_interface_type(nonick) ) { - char temp[NAMELEN] ; - sprintf(temp, "%s_t", q->mapsto ) ; - fprintf(fph," %-30s %s_%s ;\n", temp, ModName->nickname, fast_interface_type_shortname(nonick) ) ; - } - } - fprintf(fph," } %s_t ;\n", ModName->nickname ) ; - - } -} diff --git a/OpenFAST/modules/openfast-registry/src/gen_module_files.c b/OpenFAST/modules/openfast-registry/src/gen_module_files.c deleted file mode 100644 index df4acfe9d..000000000 --- a/OpenFAST/modules/openfast-registry/src/gen_module_files.c +++ /dev/null @@ -1,2466 +0,0 @@ -#include -#include -#include -#ifndef _WIN32 -# include -#endif - -#include "protos.h" -#include "registry.h" -#include "data.h" - -#include "FAST_preamble.h" - -void gen_mask_alloc( FILE *fp, int ndims, char *tmp ); - -/** - * ============== Create the C2Farry Copy Subroutine in ModName_Types.f90 ====================== - * - * In the C2F routines, we associate the pointer created in C with the variables in the - * corresponding Fortran types. - * ====================================================================================== - */ -int -gen_copy_c2f( FILE *fp , // *.f90 file we are writting to - const node_t *ModName , // module name - char *inout , // character string written out - char *inoutlong ) // not sure what this is used for -{ - node_t *q, *r ; - char tmp[NAMELEN]; - char addnick[NAMELEN]; - char nonick[NAMELEN] ; - - remove_nickname(ModName->nickname,inout,nonick) ; - append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; - fprintf(fp," SUBROUTINE %s_C2Fary_Copy%s( %sData, ErrStat, ErrMsg, SkipPointers )\n", ModName->nickname, nonick,nonick ); - fprintf(fp," TYPE(%s), INTENT(INOUT) :: %sData\n" , addnick, nonick ); - fprintf(fp," INTEGER(IntKi), INTENT( OUT) :: ErrStat\n" ); - fprintf(fp," CHARACTER(*), INTENT( OUT) :: ErrMsg\n" ); - fprintf(fp," LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers\n" ); - fprintf(fp," ! \n" ); - fprintf(fp," LOGICAL :: SkipPointers_local\n"); - fprintf(fp," ErrStat = ErrID_None\n" ); - fprintf(fp," ErrMsg = \"\"\n\n" ); - fprintf(fp," IF (PRESENT(SkipPointers)) THEN\n"); - fprintf(fp," SkipPointers_local = SkipPointers\n"); - fprintf(fp," ELSE\n"); - fprintf(fp," SkipPointers_local = .false.\n"); - fprintf(fp," END IF\n"); - - sprintf(tmp,"%s",addnick) ; - - if (( q = get_entry( make_lower_temp(tmp),ModName->module_ddt_list ) ) == NULL ) - { - fprintf(stderr,"Registry warning: generating %s_C2Fary_Copy%s: cannot find definition for %s\n",ModName->nickname,nonick,tmp) ; - } else { - for ( r = q->fields ; r ; r = r->next ) - { - if ( r->type != NULL ) { - if ( r->type->type_type == DERIVED ) { // && ! r->type->usefrom - fprintf(stderr,"Registry WARNING: derived data type %s of type %s is not passed through C interface\n",r->name,r->type->name) ; - } else { - if ( is_pointer(r) ) { - fprintf(fp,"\n ! -- %s %s Data fields\n",r->name,nonick) ; - fprintf(fp," IF ( .NOT. SkipPointers_local ) THEN\n"); - fprintf(fp," IF ( .NOT. C_ASSOCIATED( %sData%%C_obj%%%s ) ) THEN\n",nonick,r->name) ; - fprintf(fp," NULLIFY( %sData%%%s )\n",nonick,r->name) ; - fprintf(fp," ELSE\n") ; - fprintf(fp," CALL C_F_POINTER(%sData%%C_obj%%%s, %sData%%%s, (/%sData%%C_obj%%%s_Len/))\n",nonick,r->name,nonick,r->name,nonick,r->name) ; - fprintf(fp," END IF\n") ; - fprintf(fp, " END IF\n"); - } - else if (!has_deferred_dim(r, 0)) { - if (!strcmp(r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)") || - !strcmp(r->type->mapsto, "REAL(DbKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)") || - !strcmp(r->type->mapsto, "INTEGER(IntKi)") || - !strcmp(r->type->mapsto, "LOGICAL")) - { - fprintf(fp, " %sData%%%s = %sData%%C_obj%%%s\n", nonick, r->name, nonick, r->name); - } - else { // characters need to be copied differently - if (r->ndims == 0){ - fprintf(fp, " %sData%%%s = TRANSFER(%sData%%C_obj%%%s, %sData%%%s )\n", nonick, r->name, nonick, r->name, nonick, r->name); - } - } - } - } - } - } - } - - fprintf(fp," END SUBROUTINE %s_C2Fary_Copy%s\n\n", ModName->nickname,nonick ) ; - return(0) ; -} - -int -gen_copy_f2c(FILE *fp, // *.f90 file we are writting to - const node_t *ModName, // module name - char *inout, // character string written out - char *inoutlong) // not sure what this is used for -{ - node_t *q, *r; - char tmp[NAMELEN]; - char addnick[NAMELEN]; - char nonick[NAMELEN]; - - remove_nickname(ModName->nickname, inout, nonick); - append_nickname((is_a_fast_interface_type(inoutlong)) ? ModName->nickname : "", inoutlong, addnick); - fprintf(fp, " SUBROUTINE %s_F2C_Copy%s( %sData, ErrStat, ErrMsg, SkipPointers )\n", ModName->nickname, nonick, nonick); - fprintf(fp, " TYPE(%s), INTENT(INOUT) :: %sData\n", addnick, nonick); - fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n"); - fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg\n"); - fprintf(fp, " LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers\n"); - fprintf(fp, " ! \n"); - fprintf(fp, " LOGICAL :: SkipPointers_local\n"); - fprintf(fp, " ErrStat = ErrID_None\n"); - fprintf(fp, " ErrMsg = \"\"\n\n"); - fprintf(fp, " IF (PRESENT(SkipPointers)) THEN\n"); - fprintf(fp, " SkipPointers_local = SkipPointers\n"); - fprintf(fp, " ELSE\n"); - fprintf(fp, " SkipPointers_local = .false.\n"); - fprintf(fp, " END IF\n"); - - sprintf(tmp, "%s", addnick); - - if ((q = get_entry(make_lower_temp(tmp), ModName->module_ddt_list)) == NULL) - { - fprintf(stderr, "Registry warning: generating %s_F2C_Copy%s: cannot find definition for %s\n", ModName->nickname, nonick, tmp); - } - else { - for (r = q->fields; r; r = r->next) - { - if (r->type != NULL) { - if (r->type->type_type == DERIVED) { // && ! r->type->usefrom - fprintf(stderr, "Registry WARNING: derived data type %s of type %s is not passed through F-C interface\n", r->name, r->type->name); - } - else { - if (is_pointer(r)) { - fprintf(fp, "\n ! -- %s %s Data fields\n", r->name, nonick); - fprintf(fp, " IF ( .NOT. SkipPointers_local ) THEN\n"); - fprintf(fp, " IF ( .NOT. %s(%sData%%%s)) THEN \n", assoc_or_allocated(r), nonick, r->name); - fprintf(fp, " %sData%%c_obj%%%s_Len = 0\n", nonick, r->name); - fprintf(fp, " %sData%%c_obj%%%s = C_NULL_PTR\n", nonick, r->name); - fprintf(fp, " ELSE\n"); - fprintf(fp, " %sData%%c_obj%%%s_Len = SIZE(%sData%%%s)\n", nonick, r->name, nonick, r->name); - fprintf(fp, " IF (%sData%%c_obj%%%s_Len > 0) &\n", nonick, r->name); - fprintf(fp, " %sData%%c_obj%%%s = C_LOC( %sData%%%s( LBOUND(%sData%%%s,1) ) ) \n", nonick, r->name, nonick, r->name, nonick, r->name ); - fprintf(fp, " END IF\n"); - fprintf(fp, " END IF\n"); - } - else if (!has_deferred_dim(r, 0)) { - if (!strcmp(r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)") || - !strcmp(r->type->mapsto, "REAL(DbKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)") || - !strcmp(r->type->mapsto, "INTEGER(IntKi)") || - !strcmp(r->type->mapsto, "LOGICAL")) - { - fprintf(fp, " %sData%%C_obj%%%s = %sData%%%s\n", nonick, r->name, nonick, r->name); - } - else { // characters need to be copied differently - if (r->ndims == 0) { - //fprintf(stderr, "Registry WARNING: character data type %s of type %s is not passed through F-C interface\n", r->name, r->type->name); - fprintf(fp, " %sData%%C_obj%%%s = TRANSFER(%sData%%%s, %sData%%C_obj%%%s )\n", nonick, r->name, nonick, r->name, nonick, r->name); - } - } - } - } - } - } - } - - fprintf(fp, " END SUBROUTINE %s_F2C_Copy%s\n\n", ModName->nickname, nonick); - return(0); -} - - -int -gen_copy( FILE * fp, const node_t * ModName, char * inout, char * inoutlong, const node_t * q_in ) -{ - char tmp[NAMELEN], tmp2[NAMELEN], addnick[NAMELEN], nonick[NAMELEN] ; - node_t *q, * r ; - int d ; - - remove_nickname(ModName->nickname,inout,nonick) ; - append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; - fprintf(fp," SUBROUTINE %s_Copy%s( Src%sData, Dst%sData, CtrlCode, ErrStat, ErrMsg )\n",ModName->nickname,nonick,nonick,nonick ) ; - fprintf(fp, " TYPE(%s), INTENT(%s) :: Src%sData\n", addnick, (q_in->containsPtr == 1) ? "INOUT" : "IN", nonick); -//fprintf(fp, " TYPE(%s), INTENT(INOUT) :: Src%sData\n", addnick, nonick); - fprintf(fp," TYPE(%s), INTENT(INOUT) :: Dst%sData\n",addnick,nonick) ; - fprintf(fp," INTEGER(IntKi), INTENT(IN ) :: CtrlCode\n") ; - fprintf(fp," INTEGER(IntKi), INTENT( OUT) :: ErrStat\n") ; - fprintf(fp," CHARACTER(*), INTENT( OUT) :: ErrMsg\n") ; - fprintf(fp,"! Local \n") ; - fprintf(fp," INTEGER(IntKi) :: i,j,k\n") ; - for (d = 1; d <= q_in->max_ndims; d++){ - fprintf(fp, " INTEGER(IntKi) :: i%d, i%d_l, i%d_u ! bounds (upper/lower) for an array dimension %d\n", d, d, d, d); - } - fprintf(fp," INTEGER(IntKi) :: ErrStat2\n") ; - fprintf(fp," CHARACTER(ErrMsgLen) :: ErrMsg2\n"); - fprintf(fp," CHARACTER(*), PARAMETER :: RoutineName = '%s_Copy%s'\n", ModName->nickname, nonick); - fprintf(fp, "! \n"); - fprintf(fp," ErrStat = ErrID_None\n") ; - fprintf(fp," ErrMsg = \"\"\n") ; - -// sprintf(tmp,"%s_%s",ModName->nickname,inoutlong) ; -// sprintf(tmp,"%s",inoutlong) ; - sprintf(tmp,"%s",addnick) ; - - sprintf(tmp2,"%s",make_lower_temp(tmp)) ; - - if (( q = get_entry( make_lower_temp(tmp),ModName->module_ddt_list ) ) == NULL ) - { - fprintf(stderr,"Registry warning: generating %s_Copy%s: cannot find definition for %s\n",ModName->nickname,nonick,tmp) ; - } else { - for ( r = q->fields ; r ; r = r->next ) - { - if ( r->type != NULL ) { - -// check if this is an allocatable array: - if ( r->ndims > 0 && has_deferred_dim(r,0) ) { - fprintf(fp,"IF (%s(Src%sData%%%s)) THEN\n",assoc_or_allocated(r),nonick,r->name) ; - strcpy(tmp,"") ; - - for (d = 1; d <= r->ndims; d++) { - fprintf(fp, " i%d_l = LBOUND(Src%sData%%%s,%d)\n", d, nonick, r->name, d); - fprintf(fp, " i%d_u = UBOUND(Src%sData%%%s,%d)\n", d, nonick, r->name, d); - sprintf(tmp2, ",i%d_l:i%d_u", d, d); - strcat(tmp, tmp2); - } -//fprintf(fp," nonick=%s\n", nonick ); - fprintf(fp," IF (.NOT. %s(Dst%sData%%%s)) THEN \n",assoc_or_allocated(r),nonick,r->name) ; - fprintf(fp," ALLOCATE(Dst%sData%%%s(%s),STAT=ErrStat2)\n",nonick,r->name,(char*)&(tmp[1])) ; - fprintf(fp," IF (ErrStat2 /= 0) THEN \n") ; - fprintf(fp," CALL SetErrStat(ErrID_Fatal, 'Error allocating Dst%sData%%%s.', ErrStat, ErrMsg,RoutineName)\n",nonick,r->name); - fprintf(fp," RETURN\n") ; - fprintf(fp," END IF\n") ; - - if ( sw_ccode && is_pointer(r) ) { // bjj: this needs to be updated if we've got multiple dimension arrays - fprintf(fp," Dst%sData%%c_obj%%%s_Len = SIZE(Dst%sData%%%s)\n",nonick,r->name,nonick,r->name) ; - fprintf(fp," IF (Dst%sData%%c_obj%%%s_Len > 0) &\n",nonick,r->name) ; - fprintf(fp," Dst%sData%%c_obj%%%s = C_LOC( Dst%sData%%%s(i1_l) ) \n",nonick,r->name, nonick,r->name ) ; - } - - fprintf(fp," END IF\n") ; // end dest allocated/associated - } - - if ( r->type->type_type == DERIVED ) { // includes mesh and dll_type - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp," DO i%d = LBOUND(Src%sData%%%s,%d), UBOUND(Src%sData%%%s,%d)\n",d,nonick,r->name,d,nonick,r->name,d ) ; - } - - if (!strcmp(r->type->name, "meshtype")) { - fprintf(fp," CALL MeshCopy( Src%sData%%%s%s, Dst%sData%%%s%s, CtrlCode, ErrStat2, ErrMsg2 )\n",nonick,r->name,dimstr(r->ndims),nonick,r->name,dimstr(r->ndims)) ; - fprintf(fp," CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"); - fprintf(fp," IF (ErrStat>=AbortErrLev) RETURN\n"); - } else if ( !strcmp( r->type->name, "dll_type" ) ) { - fprintf(fp," Dst%sData%%%s = Src%sData%%%s\n",nonick,r->name,nonick,r->name) ; - } - else { // && ! r->type->usefrom ) { - char nonick2[NAMELEN]; - remove_nickname(r->type->module->nickname, r->type->name, nonick2); - - fprintf(fp, " CALL %s_Copy%s( Src%sData%%%s%s, Dst%sData%%%s%s, CtrlCode, ErrStat2, ErrMsg2 )\n", - r->type->module->nickname, fast_interface_type_shortname(nonick2), - nonick, r->name, dimstr(r->ndims), - nonick, r->name, dimstr(r->ndims)); - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " IF (ErrStat>=AbortErrLev) RETURN\n"); - - } - - for ( d = r->ndims ; d >= 1 ; d-- ) { - fprintf(fp," ENDDO\n") ; - } - } else { // not a derived type - fprintf(fp, " Dst%sData%%%s = Src%sData%%%s\n",nonick,r->name,nonick,r->name) ; - if (sw_ccode && !is_pointer(r)){ - - //if (!strcmp(r->type->mapsto, "REAL(ReKi)") || - // !strcmp(r->type->mapsto, "REAL(SiKi)") || - // !strcmp(r->type->mapsto, "REAL(DbKi)") || - // !strcmp(r->type->mapsto, "REAL(R8Ki)") || - // !strcmp(r->type->mapsto, "INTEGER(IntKi)") || - // !strcmp(r->type->mapsto, "LOGICAL") || - // r->ndims == 0) - if ( r->ndims == 0 ) // scalar of any type OR a character array - { - // fprintf(fp, " Dst%sData%%C_obj%%%s = Dst%sData%%%s\n", nonick, r->name, nonick, r->name); - fprintf(fp, " Dst%sData%%C_obj%%%s = Src%sData%%C_obj%%%s\n", nonick, r->name, nonick, r->name); - } - } - } - -// close IF (check on allocatable array) - if ( r->ndims > 0 && has_deferred_dim(r,0) ) { - fprintf(fp,"ENDIF\n") ; - } - - } // if non-null field - } // each field - } - - fprintf(fp," END SUBROUTINE %s_Copy%s\n\n", ModName->nickname,nonick ) ; - return(0) ; -} - -void -gen_pack( FILE * fp, const node_t * ModName, char * inout, char *inoutlong ) -{ - - char tmp[NAMELEN], tmp2[NAMELEN], addnick[NAMELEN], nonick[NAMELEN] ; - char nonick2[NAMELEN], indent[NAMELEN], mainIndent[6]; - node_t *q, * r ; - int frst, d, i; - - remove_nickname(ModName->nickname,inout,nonick) ; - append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; -// sprintf(tmp,"%s_%s",ModName->nickname,inoutlong) ; -// sprintf(tmp,"%s",inoutlong) ; - sprintf(tmp,"%s",addnick) ; - if (( q = get_entry( make_lower_temp(tmp),ModName->module_ddt_list ) ) == NULL ) - { - fprintf(stderr,"Registry warning: generating %s_Pack%s: cannot find definition for %s\n",ModName->nickname,nonick,tmp) ; - return;//(1) ; - } - - fprintf(fp, " SUBROUTINE %s_Pack%s( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly )\n", ModName->nickname,nonick) ; - fprintf(fp, " REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:)\n") ; - fprintf(fp, " REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:)\n") ; - fprintf(fp, " INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:)\n") ; - fprintf(fp, " TYPE(%s), INTENT(IN) :: InData\n",addnick ) ; - fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n") ; - fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg\n") ; - fprintf(fp, " LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly\n") ; - fprintf(fp, " ! Local variables\n") ; - fprintf(fp, " INTEGER(IntKi) :: Re_BufSz\n") ; - fprintf(fp, " INTEGER(IntKi) :: Re_Xferred\n") ; - fprintf(fp, " INTEGER(IntKi) :: Db_BufSz\n") ; - fprintf(fp, " INTEGER(IntKi) :: Db_Xferred\n") ; - fprintf(fp, " INTEGER(IntKi) :: Int_BufSz\n") ; - fprintf(fp, " INTEGER(IntKi) :: Int_Xferred\n") ; - fprintf(fp, " INTEGER(IntKi) :: i,i1,i2,i3,i4,i5\n") ; - fprintf(fp, " LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers\n") ; - fprintf(fp, " INTEGER(IntKi) :: ErrStat2\n"); - fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2\n"); - fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_Pack%s'\n", ModName->nickname, nonick); - - fprintf(fp, " ! buffers to store subtypes, if any\n"); - fprintf(fp, " REAL(ReKi), ALLOCATABLE :: Re_Buf(:)\n"); - fprintf(fp, " REAL(DbKi), ALLOCATABLE :: Db_Buf(:)\n"); - fprintf(fp, " INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:)\n\n"); - - fprintf(fp," OnlySize = .FALSE.\n") ; - fprintf(fp," IF ( PRESENT(SizeOnly) ) THEN\n") ; - fprintf(fp," OnlySize = SizeOnly\n") ; - fprintf(fp," ENDIF\n") ; - fprintf(fp," !\n") ; - - fprintf(fp," ErrStat = ErrID_None\n") ; - fprintf(fp," ErrMsg = \"\"\n") ; - fprintf(fp," Re_BufSz = 0\n") ; - fprintf(fp," Db_BufSz = 0\n") ; - fprintf(fp," Int_BufSz = 0\n") ; - - - frst = 1; - for (r = q->fields; r; r = r->next) - { - if (r->type == NULL) { - fprintf(stderr, "Registry warning generating %s_Pack%s: %s has no type.\n", ModName->nickname, nonick, r->name); - return; // EARLY RETURN - } - - if (has_deferred_dim(r, 0)){ - //fprintf(fp, "\n"); - fprintf(fp, " Int_BufSz = Int_BufSz + 1 ! %s allocated yes/no\n", r->name); - - fprintf(fp, " IF ( %s(InData%%%s) ) THEN\n", assoc_or_allocated(r), r->name); - fprintf(fp, " Int_BufSz = Int_BufSz + 2*%d ! %s upper/lower bounds for each dimension\n", r->ndims, r->name); - } - - if (!strcmp(r->type->name, "meshtype") || - !strcmp(r->type->name, "dll_type") || - (r->type->type_type == DERIVED) ) { // call individual routines to pack data from subtypes: - - if (frst == 1) { - fprintf(fp, " ! Allocate buffers for subtypes, if any (we'll get sizes from these) \n"); frst = 0; - } - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " DO i%d = LBOUND(InData%%%s,%d), UBOUND(InData%%%s,%d)\n", d, r->name, d, r->name, d); - } - fprintf(fp, " Int_BufSz = Int_BufSz + 3 ! %s: size of buffers for each call to pack subtype\n", r->name); - - if ( !strcmp( r->type->name, "meshtype" ) ) { - fprintf(fp, " CALL MeshPack( InData%%%s%s, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! %s \n", - r->name,dimstr(r->ndims),r->name ) ; - } else if ( !strcmp( r->type->name, "dll_type" ) ) { - fprintf(fp, " CALL DLLTypePack( InData%%%s%s, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! %s \n", - r->name,dimstr(r->ndims), r->name ) ; - } else if (r->type->type_type == DERIVED) { // && ! r->type->usefrom ) { - remove_nickname(r->type->module->nickname, r->type->name, nonick2); - fprintf(fp, " CALL %s_Pack%s( Re_Buf, Db_Buf, Int_Buf, InData%%%s%s, ErrStat2, ErrMsg2, .TRUE. ) ! %s \n", - r->type->module->nickname, fast_interface_type_shortname(nonick2), r->name, - dimstr(r->ndims), r->name); - } - - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"); - fprintf(fp, " IF (ErrStat >= AbortErrLev) RETURN\n\n"); - - fprintf(fp, " IF(ALLOCATED(Re_Buf)) THEN ! %s\n", r->name); - fprintf(fp, " Re_BufSz = Re_BufSz + SIZE( Re_Buf )\n"); - fprintf(fp, " DEALLOCATE(Re_Buf)\n"); - fprintf(fp, " END IF\n"); - - fprintf(fp, " IF(ALLOCATED(Db_Buf)) THEN ! %s\n", r->name); - fprintf(fp, " Db_BufSz = Db_BufSz + SIZE( Db_Buf )\n"); - fprintf(fp, " DEALLOCATE(Db_Buf)\n"); - fprintf(fp, " END IF\n"); - - fprintf(fp, " IF(ALLOCATED(Int_Buf)) THEN ! %s\n", r->name); - fprintf(fp, " Int_BufSz = Int_BufSz + SIZE( Int_Buf )\n"); - fprintf(fp, " DEALLOCATE(Int_Buf)\n"); - fprintf(fp, " END IF\n"); - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " END DO\n"); - } - - } else { // intrinsic data types - - // do all dimensions of arrays (no need for loop over i%d) - - sprintf(tmp2, "SIZE(InData%%%s)", r->name); - - if ( !strcmp( r->type->mapsto, "REAL(ReKi)") || - !strcmp( r->type->mapsto, "REAL(SiKi)") ) { - fprintf(fp, " Re_BufSz = Re_BufSz + %s ! %s\n", (r->ndims>0) ? tmp2 : "1", r->name); - } - else if ( !strcmp( r->type->mapsto, "REAL(DbKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)")) { - fprintf(fp, " Db_BufSz = Db_BufSz + %s ! %s\n", (r->ndims>0) ? tmp2 : "1", r->name); - } - else if ( !strcmp( r->type->mapsto, "INTEGER(IntKi)") || - !strcmp( r->type->mapsto, "LOGICAL" ) ) { - fprintf(fp, " Int_BufSz = Int_BufSz + %s ! %s\n", (r->ndims>0) ? tmp2 : "1", r->name); - } - else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */{ - fprintf(fp, " Int_BufSz = Int_BufSz + %s*LEN(InData%%%s) ! %s\n", (r->ndims>0) ? tmp2 : "1", r->name, r->name); - } - /*else - { - fprintf(fp,"! missing buffer for %s\n",r->name ) ; - }*/ - } - - if (has_deferred_dim(r, 0)){ - fprintf(fp, " END IF\n"); - } - // fprintf(fp, "\n"); // space between variables - - - } - - // Allocate buffers - fprintf(fp, " IF ( Re_BufSz .GT. 0 ) THEN \n"); - fprintf(fp, " ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 )\n"); - fprintf(fp, " IF (ErrStat2 /= 0) THEN \n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); - fprintf(fp, " END IF\n"); - - fprintf(fp, " IF ( Db_BufSz .GT. 0 ) THEN \n"); - fprintf(fp, " ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 )\n"); - fprintf(fp, " IF (ErrStat2 /= 0) THEN \n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); - fprintf(fp, " END IF\n"); - - fprintf(fp, " IF ( Int_BufSz .GT. 0 ) THEN \n"); - fprintf(fp, " ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 )\n"); - fprintf(fp, " IF (ErrStat2 /= 0) THEN \n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); - fprintf(fp, " END IF\n"); - fprintf(fp, " IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them)\n\n"); - - if (sw_ccode) { - fprintf(fp, " IF (C_ASSOCIATED(InData%%C_obj%%object)) "); - fprintf(fp, "CALL SetErrStat(ErrID_Severe,'C_obj%%object cannot be packed.',ErrStat,ErrMsg,RoutineName)\n\n"); - } - - - fprintf(fp, " Re_Xferred = 1\n"); - fprintf(fp, " Db_Xferred = 1\n"); - fprintf(fp, " Int_Xferred = 1\n\n"); - - - // Pack data - for ( r = q->fields ; r ; r = r->next ) - { - - if (has_deferred_dim(r, 0)) { - // store whether the data type is allocated and the bounds of each dimension - fprintf(fp, " IF ( .NOT. %s(InData%%%s) ) THEN\n", assoc_or_allocated(r), r->name); - fprintf(fp, " IntKiBuf( Int_Xferred ) = 0\n"); // not allocated - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - //fprintf(fp, " IntKiBuf( Int_Xferred:Int_Xferred+2*%d-1 ) = 0\n", r->ndims, r->name); - //fprintf(fp, " Int_Xferred = Int_Xferred + 2*%d\n", r->ndims); - fprintf(fp, " ELSE\n"); - fprintf(fp, " IntKiBuf( Int_Xferred ) = 1\n"); // allocated - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - for (d = 1; d <= r->ndims; d++) { - fprintf(fp, " IntKiBuf( Int_Xferred ) = LBOUND(InData%%%s,%d)\n", r->name, d); - fprintf(fp, " IntKiBuf( Int_Xferred + 1) = UBOUND(InData%%%s,%d)\n", r->name, d); - fprintf(fp, " Int_Xferred = Int_Xferred + 2\n"); - } - fprintf(fp, "\n"); - strcpy(mainIndent, " "); - } - else { - strcpy(mainIndent, ""); - } - - - if (!strcmp(r->type->name, "meshtype") || - !strcmp(r->type->name, "dll_type") || - (r->type->type_type == DERIVED)) { // call individual routines to pack data from subtypes: - - if (frst == 1) { - fprintf(fp, " ! Allocate buffers for subtypes, if any (we'll get sizes from these) \n"); frst = 0; - } - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " DO i%d = LBOUND(InData%%%s,%d), UBOUND(InData%%%s,%d)\n", d, r->name, d, r->name, d); - } - - if (!strcmp(r->type->name, "meshtype")) { - fprintf(fp, " CALL MeshPack( InData%%%s%s, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! %s \n", - r->name, dimstr(r->ndims), r->name); - } - else if (!strcmp(r->type->name, "dll_type")) { - fprintf(fp, " CALL DLLTypePack( InData%%%s%s, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! %s \n", - r->name, dimstr(r->ndims), r->name); - } - else if (r->type->type_type == DERIVED) { // && ! r->type->usefrom ) { - remove_nickname(r->type->module->nickname, r->type->name, nonick2); - fprintf(fp, " CALL %s_Pack%s( Re_Buf, Db_Buf, Int_Buf, InData%%%s%s, ErrStat2, ErrMsg2, OnlySize ) ! %s \n", - r->type->module->nickname, fast_interface_type_shortname(nonick2), r->name, - dimstr(r->ndims),r->name); - } - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"); - fprintf(fp, " IF (ErrStat >= AbortErrLev) RETURN\n\n"); - - fprintf(fp, " IF(ALLOCATED(Re_Buf)) THEN\n"); - fprintf(fp, " IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf\n"); - fprintf(fp, " Re_Xferred = Re_Xferred + SIZE(Re_Buf)\n"); - fprintf(fp, " DEALLOCATE(Re_Buf)\n"); - fprintf(fp, " ELSE\n"); - fprintf(fp, " IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " ENDIF\n"); - - fprintf(fp, " IF(ALLOCATED(Db_Buf)) THEN\n"); - fprintf(fp, " IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf\n"); - fprintf(fp, " Db_Xferred = Db_Xferred + SIZE(Db_Buf)\n"); - fprintf(fp, " DEALLOCATE(Db_Buf)\n"); - fprintf(fp, " ELSE\n"); - fprintf(fp, " IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " ENDIF\n"); - - fprintf(fp, " IF(ALLOCATED(Int_Buf)) THEN\n"); - fprintf(fp, " IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf\n"); - fprintf(fp, " Int_Xferred = Int_Xferred + SIZE(Int_Buf)\n"); - fprintf(fp, " DEALLOCATE(Int_Buf)\n"); - fprintf(fp, " ELSE\n"); - fprintf(fp, " IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " ENDIF\n"); - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " END DO\n"); - } - - } - else { - // intrinsic data types - // do all dimensions of arrays (no need for loop over i%d) - - strcpy(indent, " "); - strcat(indent, mainIndent); - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, "%s DO i%d = LBOUND(InData%%%s,%d), UBOUND(InData%%%s,%d)\n", indent, d, r->name, d, r->name, d); - strcat(indent, " "); //create an indent - } - - - if (!strcmp(r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)")) { - fprintf(fp, "%s ReKiBuf(Re_Xferred) = InData%%%s%s\n", indent, r->name, dimstr(r->ndims)); - fprintf(fp, "%s Re_Xferred = Re_Xferred + 1\n", indent); - } - else if (!strcmp(r->type->mapsto, "REAL(DbKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)")) { - fprintf(fp, "%s DbKiBuf(Db_Xferred) = InData%%%s%s\n", indent, r->name, dimstr(r->ndims)); - fprintf(fp, "%s Db_Xferred = Db_Xferred + 1\n", indent); - } - else if (!strcmp(r->type->mapsto, "INTEGER(IntKi)") ) { - fprintf(fp, "%s IntKiBuf(Int_Xferred) = InData%%%s%s\n", indent, r->name, dimstr(r->ndims)); - fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); - } - else if (!strcmp(r->type->mapsto, "LOGICAL") ) { - fprintf(fp, "%s IntKiBuf(Int_Xferred) = TRANSFER(InData%%%s%s, IntKiBuf(1))\n", indent, r->name, dimstr(r->ndims)); - fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); - } - - else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */{ - - fprintf(fp, "%s DO I = 1, LEN(InData%%%s)\n", indent, r->name); - fprintf(fp, "%s IntKiBuf(Int_Xferred) = ICHAR(InData%%%s%s(I:I), IntKi)\n", indent, r->name, dimstr(r->ndims)); - fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); - fprintf(fp, "%s END DO ! I\n", indent); - - } - - for (d = r->ndims; d >= 1; d--) { - strcpy(indent, " "); - strcat(indent, mainIndent); - for (i = 1; i < d; i++) { - strcat(indent, " "); - } - fprintf(fp, "%s END DO\n", indent); - } - - } - - if (has_deferred_dim(r, 0)){ - fprintf(fp, " END IF\n"); - } - } - - fprintf(fp," END SUBROUTINE %s_Pack%s\n\n", ModName->nickname,nonick ) ; - return;//(0) ; -} - -void -gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) -{ - char tmp[NAMELEN], tmp2[NAMELEN], indent[NAMELEN], addnick[NAMELEN], nonick[NAMELEN], nonick2[NAMELEN], mainIndent[6]; - node_t *q, * r ; - int d, i ; - - remove_nickname(ModName->nickname,inout,nonick) ; - append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; -// sprintf(tmp,"%s_%s",ModName->nickname,inoutlong) ; -// sprintf(tmp,"%s",inoutlong) ; - sprintf(tmp,"%s",addnick) ; - if (( q = get_entry( make_lower_temp(tmp),ModName->module_ddt_list ) ) == NULL ) - { - fprintf(stderr,"Registry warning: generating %s_UnPack%s: cannot find definition for %s\n",ModName->nickname,nonick,tmp) ; - return;//(1) ; - } - - fprintf(fp," SUBROUTINE %s_UnPack%s( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg )\n", ModName->nickname,nonick ) ; - fprintf(fp," REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:)\n") ; - fprintf(fp," REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:)\n") ; - fprintf(fp," INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:)\n") ; - fprintf(fp," TYPE(%s), INTENT(INOUT) :: OutData\n",addnick ) ; - fprintf(fp," INTEGER(IntKi), INTENT( OUT) :: ErrStat\n") ; - fprintf(fp," CHARACTER(*), INTENT( OUT) :: ErrMsg\n") ; - fprintf(fp," ! Local variables\n") ; - fprintf(fp," INTEGER(IntKi) :: Buf_size\n") ; - fprintf(fp," INTEGER(IntKi) :: Re_Xferred\n") ; - fprintf(fp," INTEGER(IntKi) :: Db_Xferred\n") ; - fprintf(fp," INTEGER(IntKi) :: Int_Xferred\n") ; - fprintf(fp," INTEGER(IntKi) :: i\n") ; - for (d = 1; d <= q->max_ndims; d++){ - fprintf(fp," INTEGER(IntKi) :: i%d, i%d_l, i%d_u ! bounds (upper/lower) for an array dimension %d\n", d, d, d, d); - } - fprintf(fp, " INTEGER(IntKi) :: ErrStat2\n"); - fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2\n"); - fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_UnPack%s'\n", ModName->nickname, nonick); - - fprintf(fp," ! buffers to store meshes, if any\n") ; - fprintf(fp," REAL(ReKi), ALLOCATABLE :: Re_Buf(:)\n") ; - fprintf(fp," REAL(DbKi), ALLOCATABLE :: Db_Buf(:)\n") ; - fprintf(fp," INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:)\n") ; - fprintf(fp," !\n") ; - fprintf(fp," ErrStat = ErrID_None\n") ; - fprintf(fp," ErrMsg = \"\"\n") ; - fprintf(fp," Re_Xferred = 1\n") ; - fprintf(fp," Db_Xferred = 1\n") ; - fprintf(fp," Int_Xferred = 1\n") ; - - -// BJJ: TODO: if there are C types, we're going to have to associate with C data structures.... - - // Unpack data - for (r = q->fields; r; r = r->next) - { - - strcpy(tmp, ""); - if (has_deferred_dim(r, 0)){ - // determine if the array was allocated when packed: - fprintf(fp, " IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! %s not allocated\n", r->name); // not allocated - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - //fprintf(fp, " Int_Xferred = Int_Xferred + 2*%d\n", r->ndims); - fprintf(fp, " ELSE\n"); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - - for (d = 1; d <= r->ndims; d++) { - fprintf(fp, " i%d_l = IntKiBuf( Int_Xferred )\n", d); //fprintf(fp, " IntKiBuf( Int_Xferred ) = LBOUND(OutData%%%s,%d)\n", r->name, d); - fprintf(fp, " i%d_u = IntKiBuf( Int_Xferred + 1)\n", d); //fprintf(fp, " IntKiBuf( Int_Xferred + 1) = UBOUND(OutData%%%s,%d)\n", r->name, d); - fprintf(fp, " Int_Xferred = Int_Xferred + 2\n"); - sprintf(tmp2, ",i%d_l:i%d_u", d, d); - strcat(tmp, tmp2); - } - - fprintf(fp, " IF (%s(OutData%%%s)) DEALLOCATE(OutData%%%s)\n", assoc_or_allocated(r), r->name, r->name); // BJJ: need NULLIFY(), too? - fprintf(fp, " ALLOCATE(OutData%%%s(%s),STAT=ErrStat2)\n", r->name, (char*)&(tmp[1])); - fprintf(fp, " IF (ErrStat2 /= 0) THEN \n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%%%s.', ErrStat, ErrMsg,RoutineName)\n", r->name); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); - - if (sw_ccode && is_pointer(r)) { // bjj: this needs to be updated if we've got multiple dimension arrays - fprintf(fp, " OutData%%c_obj%%%s_Len = SIZE(OutData%%%s)\n", r->name, r->name); - fprintf(fp, " IF (OutData%%c_obj%%%s_Len > 0) &\n", r->name); - fprintf(fp, " OutData%%c_obj%%%s = C_LOC( OutData%%%s(i1_l) ) \n", r->name, r->name); - } - strcpy(mainIndent, " "); - } - else{ - for (d = 1; d <= r->ndims; d++) { - fprintf(fp, " i%d_l = LBOUND(OutData%%%s,%d)\n", d, r->name, d); - fprintf(fp, " i%d_u = UBOUND(OutData%%%s,%d)\n", d, r->name, d); - sprintf(tmp2, ",i%d_l:i%d_u", d, d); - strcat(tmp, tmp2); - } - strcpy(mainIndent, ""); - } - - if (!strcmp(r->type->name, "meshtype") || - !strcmp(r->type->name, "dll_type") || - (r->type->type_type == DERIVED)) { // call individual routines to pack data from subtypes: - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " DO i%d = LBOUND(OutData%%%s,%d), UBOUND(OutData%%%s,%d)\n", d, r->name, d, r->name, d); - } - - // initialize buffers to send to subtype-unpack routines: - // reals: - fprintf(fp, " Buf_size=IntKiBuf( Int_Xferred )\n"); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " IF(Buf_size > 0) THEN\n"); - fprintf(fp, " ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2)\n"); - fprintf(fp, " IF (ErrStat2 /= 0) THEN \n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); - - fprintf(fp, " Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 )\n"); - fprintf(fp, " Re_Xferred = Re_Xferred + Buf_size\n"); - fprintf(fp, " END IF\n"); - - // doubles: - fprintf(fp, " Buf_size=IntKiBuf( Int_Xferred )\n"); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " IF(Buf_size > 0) THEN\n"); - fprintf(fp, " ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2)\n"); - fprintf(fp, " IF (ErrStat2 /= 0) THEN \n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); - - fprintf(fp, " Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 )\n"); - fprintf(fp, " Db_Xferred = Db_Xferred + Buf_size\n"); - fprintf(fp, " END IF\n"); - - // integers: - fprintf(fp, " Buf_size=IntKiBuf( Int_Xferred )\n"); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " IF(Buf_size > 0) THEN\n"); - fprintf(fp, " ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2)\n"); - fprintf(fp, " IF (ErrStat2 /= 0) THEN \n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); - - fprintf(fp, " Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 )\n"); - fprintf(fp, " Int_Xferred = Int_Xferred + Buf_size\n"); - fprintf(fp, " END IF\n"); - - - if (!strcmp(r->type->name, "meshtype")) { - fprintf(fp, " CALL MeshUnpack( OutData%%%s%s, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! %s \n", - r->name, dimstr(r->ndims), r->name); - } - else if (!strcmp(r->type->name, "dll_type")) { - fprintf(fp, " CALL DLLTypeUnpack( OutData%%%s%s, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! %s \n", - r->name, dimstr(r->ndims), r->name); - } - else if (r->type->type_type == DERIVED) { // && ! r->type->usefrom ) { - remove_nickname(r->type->module->nickname, r->type->name, nonick2); - fprintf(fp, " CALL %s_Unpack%s( Re_Buf, Db_Buf, Int_Buf, OutData%%%s%s, ErrStat2, ErrMsg2 ) ! %s \n", - r->type->module->nickname, fast_interface_type_shortname(nonick2), r->name, - dimstr(r->ndims), r->name); - } - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"); - fprintf(fp, " IF (ErrStat >= AbortErrLev) RETURN\n\n"); - - fprintf(fp, " IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf )\n"); - fprintf(fp, " IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf )\n"); - fprintf(fp, " IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf)\n"); - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " END DO\n"); - } - - } - else - { - strcpy(indent, " "); - strcat(indent, mainIndent); - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, "%s DO i%d = LBOUND(OutData%%%s,%d), UBOUND(OutData%%%s,%d)\n", indent, d, r->name, d, r->name, d); - strcat(indent, " "); //create an indent - } - - - if (!strcmp(r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)")) { - if (sw_ccode && is_pointer(r)) { - fprintf(fp, "%s OutData%%%s%s = REAL(ReKiBuf(Re_Xferred), C_FLOAT)\n", indent, r->name, dimstr(r->ndims)); - } - else if (!strcmp(r->type->mapsto, "REAL(SiKi)")) { - fprintf(fp, "%s OutData%%%s%s = REAL(ReKiBuf(Re_Xferred), SiKi)\n", indent, r->name, dimstr(r->ndims)); - } - else { - fprintf(fp, "%s OutData%%%s%s = ReKiBuf(Re_Xferred)\n", indent, r->name, dimstr(r->ndims)); - } - fprintf(fp, "%s Re_Xferred = Re_Xferred + 1\n", indent); - } - else if (!strcmp(r->type->mapsto, "REAL(DbKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)")) { - if (sw_ccode && is_pointer(r)) { - fprintf(fp, "%s OutData%%%s%s = REAL(DbKiBuf(Db_Xferred), C_DOUBLE)\n", indent, r->name, dimstr(r->ndims)); - } - else if (!strcmp(r->type->mapsto, "REAL(R8Ki)")) { - fprintf(fp, "%s OutData%%%s%s = REAL(DbKiBuf(Db_Xferred), R8Ki)\n", indent, r->name, dimstr(r->ndims)); - } - else { - fprintf(fp, "%s OutData%%%s%s = DbKiBuf(Db_Xferred)\n", indent, r->name, dimstr(r->ndims)); - } - fprintf(fp, "%s Db_Xferred = Db_Xferred + 1\n", indent); - } - else if (!strcmp(r->type->mapsto, "INTEGER(IntKi)")) { - fprintf(fp, "%s OutData%%%s%s = IntKiBuf(Int_Xferred)\n", indent, r->name, dimstr(r->ndims)); - fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); - } - else if (!strcmp(r->type->mapsto, "LOGICAL")) { - fprintf(fp, "%s OutData%%%s%s = TRANSFER(IntKiBuf(Int_Xferred), OutData%%%s%s)\n", indent, r->name, dimstr(r->ndims), r->name, dimstr(r->ndims)); - fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); - } - - else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */ { - - fprintf(fp, "%s DO I = 1, LEN(OutData%%%s)\n", indent, r->name); - fprintf(fp, "%s OutData%%%s%s(I:I) = CHAR(IntKiBuf(Int_Xferred))\n", indent, r->name, dimstr(r->ndims)); - fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); - fprintf(fp, "%s END DO ! I\n", indent); - - } - - for (d = r->ndims; d >= 1; d--) { - strcpy(indent, " "); - strcat(indent, mainIndent); - for (i = 1; i < d; i++) { - strcat(indent, " "); - } - fprintf(fp, "%s END DO\n", indent); - } - -// need to move scalars and strings to the %c_obj% type, too! -// compare with copy routine - - if (sw_ccode && !is_pointer(r) && r->ndims == 0) { - if (!strcmp(r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)") || - !strcmp(r->type->mapsto, "REAL(DbKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)") || - !strcmp(r->type->mapsto, "INTEGER(IntKi)") || - !strcmp(r->type->mapsto, "LOGICAL")) - { - fprintf(fp, " OutData%%C_obj%%%s = OutData%%%s\n", r->name, r->name); - } - else { // characters need to be copied differently - fprintf(fp, " OutData%%C_obj%%%s = TRANSFER(OutData%%%s, OutData%%C_obj%%%s )\n", r->name, r->name, r->name); - } - } - - } - - if (has_deferred_dim(r, 0)){ - fprintf(fp, " END IF\n"); - } - } - - fprintf(fp," END SUBROUTINE %s_UnPack%s\n\n", ModName->nickname,nonick ) ; - return;//(0) ; -} - -void -gen_mask_alloc( FILE *fp, int ndims, char *tmp ) -{ - if ( ndims == 1 ) { - fprintf(fp," ALLOCATE(mask%d(SIZE(%s,1)))\n mask%d = .TRUE.\n",ndims,tmp,ndims) ; - } else if ( ndims == 2 ) { - fprintf(fp," ALLOCATE(mask%d(SIZE(%s,1),SIZE(%s,2)))\n mask%d = .TRUE.\n",ndims,tmp,tmp,ndims) ; - } else if ( ndims == 3 ) { - fprintf(fp," ALLOCATE(mask%d(SIZE(%s,1),SIZE(%s,2),SIZE(%s,3)))\n mask%d = .TRUE.\n",ndims,tmp,tmp,tmp,ndims) ; - } else if ( ndims == 4 ) { - fprintf(fp," ALLOCATE(mask%d(SIZE(%s,1),SIZE(%s,2),SIZE(%s,3),SIZE(%s,4)))\n mask%d = .TRUE.\n",ndims,tmp,tmp,tmp,tmp,ndims) ; - } else if ( ndims == 5 ) { - fprintf(fp," ALLOCATE(mask%d(SIZE(%s,1),SIZE(%s,2),SIZE(%s,3),SIZE(%s,4),SIZE(%s,5)))\n mask%d = .TRUE.\n",ndims,tmp,tmp,tmp,tmp,tmp,ndims) ; - } -} - - - -int -gen_destroy( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) -{ - char tmp[NAMELEN], addnick[NAMELEN], nonick[NAMELEN] ; - node_t *q, * r ; - int d ; - - remove_nickname(ModName->nickname,inout,nonick) ; - append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; - fprintf(fp, " SUBROUTINE %s_Destroy%s( %sData, ErrStat, ErrMsg )\n",ModName->nickname,nonick,nonick ); - fprintf(fp, " TYPE(%s), INTENT(INOUT) :: %sData\n",addnick,nonick) ; - fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n") ; - fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg\n"); - fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_Destroy%s'\n", ModName->nickname, nonick); - fprintf(fp, " INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 \n"); - fprintf(fp,"! \n") ; - fprintf(fp," ErrStat = ErrID_None\n") ; - fprintf(fp, " ErrMsg = \"\"\n"); - -// sprintf(tmp,"%s_%s",ModName->nickname,inoutlong) ; -// sprintf(tmp,"%s",inoutlong) ; - sprintf(tmp,"%s",addnick) ; - if (( q = get_entry( make_lower_temp(tmp),ModName->module_ddt_list ) ) == NULL ) - { - fprintf(stderr,"Registry warning: generating %s_Destroy%s: cannot find definition for %s\n",ModName->nickname,nonick,tmp) ; - } else { - for ( r = q->fields ; r ; r = r->next ) - { - if ( r->type == NULL ) { - fprintf(stderr,"Registry warning generating %s_Destroy%s: %s has no type.\n",ModName->nickname,nonick,r->name) ; - } else { - - if ( r->ndims > 0 && has_deferred_dim(r,0) ) { - fprintf(fp,"IF (%s(%sData%%%s)) THEN\n",assoc_or_allocated(r),nonick,r->name) ; - } - - if (r->type->type_type == DERIVED){ - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, "DO i%d = LBOUND(%sData%%%s,%d), UBOUND(%sData%%%s,%d)\n", d, nonick, r->name, d, nonick, r->name, d); - } - - if (!strcmp(r->type->name, "meshtype")) { - fprintf(fp, " CALL MeshDestroy( %sData%%%s%s, ErrStat, ErrMsg )\n", nonick, r->name, dimstr(r->ndims)); - } - else if (!strcmp(r->type->name, "dll_type")) { - fprintf(fp, " CALL FreeDynamicLib( %sData%%%s%s, ErrStat, ErrMsg )\n", nonick, r->name, dimstr(r->ndims)); - } - else { //if (r->type->type_type == DERIVED) { // && ! r->type->usefrom ) { - char nonick2[NAMELEN]; - remove_nickname(r->type->module->nickname, r->type->name, nonick2); - fprintf(fp, " CALL %s_Destroy%s( %sData%%%s%s, ErrStat, ErrMsg )\n", - r->type->module->nickname, fast_interface_type_shortname(nonick2), nonick, r->name, dimstr(r->ndims)); - } - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, "ENDDO\n"); - } - } - if ( r->ndims > 0 && has_deferred_dim(r,0) ) { - fprintf(fp," DEALLOCATE(%sData%%%s)\n",nonick,r->name) ; - if ( is_pointer(r) ) { - fprintf(fp, " %sData%%%s => NULL()\n",nonick,r->name) ; - if (sw_ccode){ - fprintf(fp, " %sData%%C_obj%%%s = C_NULL_PTR\n", nonick, r->name); - fprintf(fp, " %sData%%C_obj%%%s_Len = 0\n", nonick, r->name); - } - } - fprintf(fp,"ENDIF\n") ; - } - - - } - } - } - - fprintf(fp," END SUBROUTINE %s_Destroy%s\n\n", ModName->nickname,nonick ) ; - return(0) ; -} - - -#define MAXRECURSE 9 -// HERE -#if 0 -void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, const int order, node_t *r, char * deref, int recurselevel) { - node_t *q, *r1 ; - int j ; - int mesh = 0 ; - char derefrecurse[NAMELEN],tmp[NAMELEN] ; - if ( recurselevel > MAXRECURSE ) { - fprintf(stderr,"REGISTRY ERROR: too many levels of array subtypes\n") ; - exit(9) ; - } - if ( r->type != NULL ) { - -// check if this is an allocatable array: - if ( r->ndims > 0 && has_deferred_dim(r,0) ) { - fprintf(fp,"IF (%s(%s_out%s%%%s) .AND. %s(%s(1)%s%%%s)) THEN\n",assoc_or_allocated(r),uy,deref,r->name, - assoc_or_allocated(r), uy, deref, r->name); - } - if ( r->type->type_type == DERIVED ) { - if (( q = get_entry( make_lower_temp(r->type->name),ModName->module_ddt_list ) ) != NULL ) { - for ( r1 = q->fields ; r1 ; r1 = r1->next ) - { - sprintf(derefrecurse,"%s%%%s",deref,r->name) ; - for ( j = r->ndims ; j > 0 ; j-- ) { - - fprintf(fp, " DO i%d%d = LBOUND(%s_out%s,%d),UBOUND(%s_out%s,%d)\n", recurselevel, j, uy, derefrecurse, j, uy, derefrecurse, j); - sprintf(derefrecurse,"%s%%%s(i%d%d)",deref,r->name,recurselevel,j) ; - } - gen_extint_order( fp, ModName, typnm, uy, order, r1, derefrecurse, recurselevel+1 ) ; - for ( j = r->ndims ; j > 0 ; j-- ) { - fprintf(fp," ENDDO\n") ; - } - } - } else if ( !strcmp( r->type->mapsto, "MeshType" ) ) { - for ( j = r->ndims ; j > 0 ; j-- ) { - fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", 0, j, uy, deref, r->name, j, uy, deref, r->name, j); - } - - if ( order == 0 ) { - fprintf(fp, " CALL MeshCopy(%s(1)%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", uy, deref, r->name, dimstr(r->ndims) - , uy, deref, r->name, dimstr(r->ndims)); - } else if ( order == 1 ) { - fprintf(fp," CALL MeshExtrapInterp1(%s(1)%s%%%s%s, %s(2)%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - } else if ( order == 2 ) { - fprintf(fp," CALL MeshExtrapInterp2(%s(1)%s%%%s%s, %s(2)%s%%%s%s, %s(3)%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - } - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " IF (ErrStat>=AbortErrLev) RETURN\n"); - - for ( j = r->ndims ; j > 0 ; j-- ) { - fprintf(fp," ENDDO\n") ; - } - } else { - - - char nonick2[NAMELEN] ; - remove_nickname(r->type->module->nickname,r->type->name,nonick2) ; - strcpy(dimstr(r->ndims),"") ; - for ( j = r->ndims ; j >= 1 ; j-- ) { - fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d), UBOUND(%s_out%s%%%s,%d)\n", 0, j, uy, deref, r->name, j, uy, deref, r->name, j); - if ( j == r->ndims ) strcat(dimstr(r->ndims),"(") ; - sprintf(tmp,"i%d%d",0,j) ; - if ( j == 1 ) strcat(tmp,")") ; else strcat(tmp,",") ; - strcat(dimstr(r->ndims),tmp) ; - } - - - fprintf(fp," CALL %s_%s_ExtrapInterp( %s%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n", - r->type->module->nickname,fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - fprintf(fp," CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp," IF (ErrStat>=AbortErrLev) RETURN\n"); - - - for ( j = r->ndims ; j >= 1 ; j-- ) { - fprintf(fp," ENDDO\n") ; - } - - } - } else if ( !strcmp( r->type->mapsto, "REAL(ReKi)") || - !strcmp( r->type->mapsto, "REAL(SiKi)") || - !strcmp( r->type->mapsto, "REAL(DbKi)") ) { - if ( r->ndims==0 ) { - } else if ( r->ndims==1 && order > 0 ) { - fprintf(fp, " ALLOCATE(b1(SIZE(%s_out%s%%%s,1)))\n", uy, deref, r->name); - fprintf(fp, " ALLOCATE(c1(SIZE(%s_out%s%%%s,1)))\n", uy, deref, r->name); - } else if ( r->ndims==2 && order > 0 ) { - fprintf(fp, " ALLOCATE(b2(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2) ))\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " ALLOCATE(c2(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2) ))\n", uy, deref, r->name, uy, deref, r->name); - } else if ( r->ndims==3 && order > 0 ) { - fprintf(fp, " ALLOCATE(b3(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3) ))\n", uy, deref, r->name); - fprintf(fp, " ALLOCATE(c3(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3) ))\n", uy, deref, r->name); - } else if ( r->ndims==4 && order > 0 ) { - fprintf(fp, " ALLOCATE(b4(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4) ))\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " ALLOCATE(c4(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4) ))\n", uy, deref, r->name, uy, deref, r->name); - } else if ( r->ndims==5 && order > 0 ) { - fprintf(fp, " ALLOCATE(b5(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,5) ))\n", uy, deref, r->name); - fprintf(fp, " ALLOCATE(c5(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,5) ))\n", uy, deref, r->name); - } else { - if (order > 0) fprintf(stderr, "Registry WARNING: too many dimensions for %s%%%s\n", deref, r->name); - } - - if ( order == 0 ) { - fprintf(fp, " %s_out%s%%%s = %s(1)%s%%%s\n", uy, deref, r->name, uy, deref, r->name); - } else if ( order == 1 ) { - fprintf(fp, " b%d = -(%s(1)%s%%%s - %s(2)%s%%%s)/t(2)\n", r->ndims, uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " %s_out%s%%%s = %s(1)%s%%%s + b%d * t_out\n", uy, deref, r->name, uy, deref, r->name, r->ndims); - } else if ( order == 2 ) { - fprintf(fp," b%d = (t(3)**2*(%s(1)%s%%%s - %s(2)%s%%%s) + t(2)**2*(-%s(1)%s%%%s + %s(3)%s%%%s))/(t(2)*t(3)*(t(2) - t(3)))\n", - r->ndims, uy, deref, r->name, uy, deref, r->name, uy, deref, r->name, uy, deref, r->name); - fprintf(fp," c%d = ( (t(2)-t(3))*%s(1)%s%%%s + t(3)*%s(2)%s%%%s - t(2)*%s(3)%s%%%s ) / (t(2)*t(3)*(t(2) - t(3)))\n", - r->ndims, uy, deref, r->name, uy, deref, r->name, uy, deref, r->name); - fprintf(fp," %s_out%s%%%s = %s(1)%s%%%s + b%d * t_out + c%d * t_out**2\n" - , uy, deref, r->name, uy, deref, r->name, r->ndims, r->ndims); - } - if ( r->ndims>=1 && order > 0 ) { - fprintf(fp," DEALLOCATE(b%d)\n",r->ndims) ; - fprintf(fp," DEALLOCATE(c%d)\n",r->ndims) ; - } - } -// check if this is an allocatable array: - if ( r->ndims > 0 && has_deferred_dim(r,0) ) { - fprintf(fp,"END IF ! check if allocated\n") ; - } - - } -} -#endif -void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, const int order, node_t *r, char * deref, int recurselevel) { - node_t *q, *r1; - int i, j; - int mesh = 0; - char derefrecurse[NAMELEN], indent[NAMELEN], tmp[NAMELEN]; - if (recurselevel > MAXRECURSE) { - fprintf(stderr, "REGISTRY ERROR: too many levels of array subtypes\n"); - exit(9); - } - if (r->type != NULL) { - - // check if this is an allocatable array: - if (r->ndims > 0 && has_deferred_dim(r, 0)) { - fprintf(fp, "IF (%s(%s_out%s%%%s) .AND. %s(%s1%s%%%s)) THEN\n", assoc_or_allocated(r), uy, deref, r->name, - assoc_or_allocated(r), uy, deref, r->name); - } - if (r->type->type_type == DERIVED) { - - if ((q = get_entry(make_lower_temp(r->type->name), ModName->module_ddt_list)) != NULL) { - for (r1 = q->fields; r1; r1 = r1->next) - { - sprintf(derefrecurse, "%s%%%s", deref, r->name); - - for (j = r->ndims; j > 0; j--) { - fprintf(fp, " DO i%d%d = LBOUND(%s_out%s,%d),UBOUND(%s_out%s,%d)\n", recurselevel, j, uy, derefrecurse, j, uy, derefrecurse, j); - } - - - if (r->ndims > 0) { - strcat(derefrecurse, "("); - for (j = 1; j <= r->ndims; j++) { - sprintf(tmp, "i%d%d", recurselevel, j); - strcat(derefrecurse, tmp); - if (j < r->ndims) { - strcat(derefrecurse, ","); - } - } - strcat(derefrecurse, ")"); - } - - gen_extint_order(fp, ModName, typnm, uy, order, r1, derefrecurse, recurselevel + 1); - for (j = r->ndims; j > 0; j--) { - fprintf(fp, " ENDDO\n"); - } - } - } - - else { - - for (j = r->ndims; j > 0; j--) { - fprintf(fp, " DO i%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", j, uy, deref, r->name, j, uy, deref, r->name, j); - } - - if (!strcmp(r->type->mapsto, "MeshType")) { - if (order == 0) { - fprintf(fp, " CALL MeshCopy(%s1%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", uy, deref, r->name, dimstr(r->ndims) - , uy, deref, r->name, dimstr(r->ndims)); - } - else if (order == 1) { - fprintf(fp, " CALL MeshExtrapInterp1(%s1%s%%%s%s, %s2%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - } - else if (order == 2) { - fprintf(fp, " CALL MeshExtrapInterp2(%s1%s%%%s%s, %s2%s%%%s%s, %s3%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - } - } - else { - char nonick2[NAMELEN]; - remove_nickname(r->type->module->nickname, r->type->name, nonick2); - - if (order == 0) { - fprintf(fp, " CALL %s_Copy%s(%s1%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", r->type->module->nickname, fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - } - else if (order == 1) { - fprintf(fp, " CALL %s_%s_ExtrapInterp1( %s1%s%%%s%s, %s2%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n", - r->type->module->nickname, fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - } - else if (order == 2) { - fprintf(fp, " CALL %s_%s_ExtrapInterp2( %s1%s%%%s%s, %s2%s%%%s%s, %s3%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n", - r->type->module->nickname, fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - } - } - - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); - //fprintf(fp, " IF (ErrStat>=AbortErrLev) RETURN\n"); - for (j = r->ndims; j >= 1; j--) { - fprintf(fp, " ENDDO\n"); - } - - } - } - else if (!strcmp(r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)") || - !strcmp(r->type->mapsto, "REAL(DbKi)")) { - - - if (order == 0) { - //bjj: this should probably have some "IF ALLOCATED" statements around it, but we're just calling - // the copy routine - fprintf(fp, " %s_out%s%%%s = %s1%s%%%s\n", uy, deref, r->name, uy, deref, r->name); - } - else - strcpy(indent, ""); - for (j = r->ndims; j > 0; j--) { - fprintf(fp, "%s DO i%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", indent, j, uy, deref, r->name, j, uy, deref, r->name, j); - strcat(indent, " "); //create an indent - } - - if (order == 1) { - if (r->gen_periodic) { - fprintf(fp, "%s CALL Angles_ExtrapInterp( %s1%s%%%s%s, %s2%s%%%s%s, tin, %s_out%s%%%s%s, tin_out )\n", - indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - } - else { - fprintf(fp, "%s b = -(%s1%s%%%s%s - %s2%s%%%s%s)\n", indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - fprintf(fp, "%s %s_out%s%%%s%s = %s1%s%%%s%s + b * ScaleFactor\n", indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - }; - } - if (order == 2) { - if (r->gen_periodic) { - fprintf(fp, "%s CALL Angles_ExtrapInterp( %s1%s%%%s%s, %s2%s%%%s%s, %s3%s%%%s%s, tin, %s_out%s%%%s%s, tin_out )\n", - indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - } - else { - fprintf(fp, "%s b = (t(3)**2*(%s1%s%%%s%s - %s2%s%%%s%s) + t(2)**2*(-%s1%s%%%s%s + %s3%s%%%s%s))* scaleFactor\n", - indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - fprintf(fp, "%s c = ( (t(2)-t(3))*%s1%s%%%s%s + t(3)*%s2%s%%%s%s - t(2)*%s3%s%%%s%s ) * scaleFactor\n", - indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - fprintf(fp, "%s %s_out%s%%%s%s = %s1%s%%%s%s + b + c * t_out\n", - indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - } - } - for (j = r->ndims; j >= 1; j--) { - strcpy(indent, ""); - for (i = 1; i < j; i++) { - strcat(indent, " "); - } - fprintf(fp, "%s END DO\n", indent); - } - } - // check if this is an allocatable array: - if (r->ndims > 0 && has_deferred_dim(r, 0)) { - fprintf(fp, "END IF ! check if allocated\n"); - } - } - -} // gen_extint_order - -void calc_extint_order(FILE *fp, const node_t *ModName, node_t *r, int recurselevel, int *max_ndims, int *max_nrecurs, int *max_alloc_ndims) { - node_t *q, *r1 ; -// bjj: make sure this is consistent with logic of gen_extint_order - - if ( r->type != NULL ) { - // if(r->ndims > *max_ndims )* max_ndims = r->ndims; - - if (r->type->type_type == DERIVED) { - if ((q = get_entry(make_lower_temp(r->type->name), ModName->module_ddt_list)) != NULL) { - for (r1 = q->fields; r1; r1 = r1->next) - { - if (r->ndims > 0) { - if (recurselevel > *max_nrecurs) *max_nrecurs = recurselevel; - if (r->ndims > *max_ndims ) *max_ndims = r->ndims; - } - calc_extint_order(fp, ModName, r1, recurselevel + 1, max_ndims, max_nrecurs, max_alloc_ndims); - } - } - else if (!strcmp(r->type->mapsto, "MeshType")) { - if (r->ndims > 0) { - if (r->ndims > *max_ndims)* max_ndims = r->ndims; - } - } - else { - if (r->ndims >= 1) { - if (r->ndims > *max_ndims)* max_ndims = r->ndims; - } - } - - } - else if (!strcmp(r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)") || - !strcmp(r->type->mapsto, "REAL(DbKi)")) { - if (/*order > 0 &&*/ r->ndims > *max_alloc_ndims) *max_alloc_ndims = r->ndims; - if (r->ndims > *max_ndims)* max_ndims = r->ndims; - } - - - } - - if ( recurselevel > MAXRECURSE ) { - fprintf(stderr,"REGISTRY ERROR: too many levels of array subtypes\n") ; - exit(9) ; - } - -} - -#if 0 -void -gen_ExtrapInterp( FILE *fp , const node_t * ModName, char * typnm, char * typnmlong ) -{ - char nonick[NAMELEN] ; - char *ddtname; char uy[2]; - node_t *q, * r ; - int i, j, max_ndims, max_nrecurs, max_alloc_ndims; - - if (!strcmp(make_lower_temp(typnm), "output")){ - strcpy(uy,"y"); - } - else{ - strcpy(uy, "u"); - } - - fprintf(fp,"\n") ; - fprintf(fp," SUBROUTINE %s_%s_ExtrapInterp(%s, tin, %s_out, tin_out, ErrStat, ErrMsg )\n",ModName->nickname,typnm,uy,uy) ; - fprintf(fp,"!\n") ; - fprintf(fp, "! This subroutine calculates a extrapolated (or interpolated) %s %s_out at time t_out, from previous/future time\n", typnm, uy); - fprintf(fp, "! values of %s (which has values associated with times in t). Order of the interpolation is given by the size of %s\n", uy, uy); - fprintf(fp,"!\n") ; - fprintf(fp,"! expressions below based on either\n") ; - fprintf(fp,"!\n") ; - fprintf(fp,"! f(t) = a\n") ; - fprintf(fp,"! f(t) = a + b * t, or\n") ; - fprintf(fp,"! f(t) = a + b * t + c * t**2\n") ; - fprintf(fp,"!\n") ; - fprintf(fp,"! where a, b and c are determined as the solution to\n") ; - fprintf(fp, "! f(t1) = %s1, f(t2) = %s2, f(t3) = %s3 (as appropriate)\n", uy, uy, uy); - fprintf(fp,"!\n") ; - fprintf(fp,"!..................................................................................................................................\n") ; - fprintf(fp,"\n") ; - - - fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s(:) ! %s at t1 > t2 > t3\n", ModName->nickname, typnmlong, uy, typnm); - fprintf(fp, " REAL(DbKi), INTENT(IN ) :: tin(:) ! Times associated with the %ss\n", typnm); -//jm Modified from INTENT( OUT) to INTENT(INOUT) to prevent ALLOCATABLE array arguments in the DDT -//jm from being maliciously deallocated through the call.See Sec. 5.1.2.7 of bonehead Fortran 2003 standard - fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s_out ! %s at tin_out\n", ModName->nickname, typnmlong, uy, typnm); - fprintf(fp," REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to\n") ; - fprintf(fp," INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n") ; - fprintf(fp," CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n") ; - fprintf(fp," ! local variables\n") ; - fprintf(fp, " REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the %ss\n", typnm); - fprintf(fp," REAL(DbKi) :: t_out ! Time to which to be extrap/interpd\n") ; - fprintf(fp," INTEGER(IntKi) :: order ! order of polynomial fit (max 2)\n") ; - fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_%s_ExtrapInterp'\n", ModName->nickname, typnm); - - max_ndims = 0; // ModName->module_ddt_list->max_ndims; //bjj: this is max for module, not for typnmlong - max_nrecurs = 0; // MAXRECURSE; - max_alloc_ndims = 0; - - for (q = ModName->module_ddt_list; q; q = q->next) - { - if (q->usefrom == 0) { - ddtname = q->name; - remove_nickname(ModName->nickname, ddtname, nonick); - if (!strcmp(nonick, make_lower_temp(typnmlong))) { - for (r = q->fields; r; r = r->next) - { - // recursive - calc_extint_order(fp, ModName, r, 0, &max_ndims, &max_nrecurs, &max_alloc_ndims); - } - } - } - } - //fprintf(stderr, "ndims=%d nrecurs=%d %d\n\n", max_ndims, max_nrecurs, max_alloc_ndims); - - if (max_alloc_ndims >= 0){ - fprintf(fp," REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation\n") ; - fprintf(fp," REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation\n") ; - if (max_alloc_ndims >= 1){ - fprintf(fp," REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation\n") ; - fprintf(fp," REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation\n") ; - if (max_alloc_ndims >= 2){ - fprintf(fp," REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation\n") ; - fprintf(fp," REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation\n") ; - if (max_alloc_ndims >= 3){ - fprintf(fp," REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation\n") ; - fprintf(fp," REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation\n") ; - if (max_alloc_ndims >= 4){ - fprintf(fp," REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: b4 ! temporary for extrapolation/interpolation\n") ; - fprintf(fp," REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: c4 ! temporary for extrapolation/interpolation\n") ; - if (max_alloc_ndims >= 5){ - fprintf(fp," REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:,:):: b5 ! temporary for extrapolation/interpolation\n") ; - fprintf(fp," REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:,:):: c5 ! temporary for extrapolation/interpolation\n") ; - } // 5 - } // 4 - } // 3 - } // 2 - } // 1 - } // 0 - fprintf(fp," INTEGER(IntKi) :: ErrStat2 ! local errors\n"); - fprintf(fp," CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"); - for ( j = 1 ; j <= max_ndims ; j++ ) { - for ( i = 0 ; i <= max_nrecurs ; i++ ) { - fprintf(fp," INTEGER :: i%d%d ! dim%d level %d counter variable for arrays of ddts\n",i,j,j,i) ; - } - } - fprintf(fp," ! Initialize ErrStat\n") ; - fprintf(fp," ErrStat = ErrID_None\n") ; - fprintf(fp," ErrMsg = \"\"\n") ; - fprintf(fp," ! we'll subtract a constant from the times to resolve some \n") ; - fprintf(fp," ! numerical issues when t gets large (and to simplify the equations)\n") ; - fprintf(fp," t = tin - tin(1)\n") ; - fprintf(fp," t_out = tin_out - tin(1)\n") ; - fprintf(fp,"\n") ; - fprintf(fp, " if ( size(t) .ne. size(%s)) then\n", uy); - fprintf(fp," ErrStat = ErrID_Fatal\n") ; - fprintf(fp, " ErrMsg = ' Error in %s_%s_ExtrapInterp: size(t) must equal size(%s) '\n", ModName->nickname, typnm, uy); - fprintf(fp," RETURN\n") ; - fprintf(fp," endif\n") ; - fprintf(fp, " if (size(%s) .gt. 3) then\n", uy); - fprintf(fp," ErrStat = ErrID_Fatal\n") ; - fprintf(fp, " ErrMsg = ' Error in %s_%s_ExtrapInterp: size(%s) must be less than 4 '\n", ModName->nickname, typnm, uy); - fprintf(fp," RETURN\n") ; - fprintf(fp," endif\n") ; - - fprintf(fp, " order = SIZE(%s) - 1\n", uy); - - fprintf(fp," IF ( order .eq. 0 ) THEN\n") ; - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - if ( q->usefrom == 0 ) { - ddtname = q->name ; - remove_nickname(ModName->nickname,ddtname,nonick) ; - if ( !strcmp( nonick, make_lower_temp(typnmlong) )) { - for ( r = q->fields ; r ; r = r->next ) - { - // recursive - gen_extint_order( fp, ModName, typnm, uy, 0, r, "", 0 ) ; - } - } - } - } - - fprintf(fp," ELSE IF ( order .eq. 1 ) THEN\n") ; -fprintf(fp," IF ( EqualRealNos( t(1), t(2) ) ) THEN\n") ; -fprintf(fp," ErrStat = ErrID_Fatal\n") ; -fprintf(fp," ErrMsg = ' Error in %s_%s_ExtrapInterp: t(1) must not equal t(2) to avoid a division-by-zero error.'\n",ModName->nickname,typnm) ; -fprintf(fp," RETURN\n") ; -fprintf(fp," END IF\n") ; - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - - if ( q->usefrom == 0 ) { - ddtname = q->name ; - remove_nickname(ModName->nickname,ddtname,nonick) ; - if ( !strcmp( nonick, make_lower_temp(typnmlong) )) { - for ( r = q->fields ; r ; r = r->next ) - { - // recursive - gen_extint_order( fp, ModName, typnm, uy, 1, r, "", 0 ) ; - } - } - } - } - fprintf(fp," ELSE IF ( order .eq. 2 ) THEN\n") ; -fprintf(fp," IF ( EqualRealNos( t(1), t(2) ) ) THEN\n") ; -fprintf(fp," ErrStat = ErrID_Fatal\n") ; -fprintf(fp," ErrMsg = ' Error in %s_%s_ExtrapInterp: t(1) must not equal t(2) to avoid a division-by-zero error.'\n",ModName->nickname,typnm) ; -fprintf(fp," RETURN\n") ; -fprintf(fp," END IF\n") ; -fprintf(fp," IF ( EqualRealNos( t(2), t(3) ) ) THEN\n") ; -fprintf(fp," ErrStat = ErrID_Fatal\n") ; -fprintf(fp," ErrMsg = ' Error in %s_%s_ExtrapInterp: t(2) must not equal t(3) to avoid a division-by-zero error.'\n",ModName->nickname,typnm) ; -fprintf(fp," RETURN\n") ; -fprintf(fp," END IF\n") ; -fprintf(fp," IF ( EqualRealNos( t(1), t(3) ) ) THEN\n") ; -fprintf(fp," ErrStat = ErrID_Fatal\n") ; -fprintf(fp," ErrMsg = ' Error in %s_%s_ExtrapInterp: t(1) must not equal t(3) to avoid a division-by-zero error.'\n",ModName->nickname,typnm) ; -fprintf(fp," RETURN\n") ; -fprintf(fp," END IF\n") ; - - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - if ( q->usefrom == 0 ) { - ddtname = q->name ; - remove_nickname(ModName->nickname,ddtname,nonick) ; - if ( !strcmp( nonick, make_lower_temp(typnmlong) )) { - for ( r = q->fields ; r ; r = r->next ) - { - // recursive - gen_extint_order( fp, ModName, typnm, uy, 2, r, "", 0 ) ; - } - } - } - } - fprintf(fp," ELSE \n") ; - fprintf(fp," ErrStat = ErrID_Fatal\n") ; - fprintf(fp," ErrMsg = ' order must be less than 3 in %s_%s_ExtrapInterp '\n",ModName->nickname,typnm) ; - fprintf(fp," RETURN\n") ; - fprintf(fp," ENDIF \n") ; - - - fprintf(fp," END SUBROUTINE %s_%s_ExtrapInterp\n",ModName->nickname,typnm) ; - fprintf(fp,"\n") ; -} -#endif - -void -gen_ExtrapInterp1(FILE *fp, const node_t * ModName, char * typnm, char * typnmlong, char * xtypnm, char * uy, const int max_ndims, const int max_nrecurs, const int max_alloc_ndims, const node_t *q) -{ - node_t *r; - int i, j; - - fprintf(fp, "\n"); - fprintf(fp, " SUBROUTINE %s_%s_ExtrapInterp1(%s1, %s2, tin, %s_out, tin_out, ErrStat, ErrMsg )\n", ModName->nickname, typnm, uy, uy, uy); - fprintf(fp, "!\n"); - fprintf(fp, "! This subroutine calculates a extrapolated (or interpolated) %s %s_out at time t_out, from previous/future time\n", typnm, uy); - fprintf(fp, "! values of %s (which has values associated with times in t). Order of the interpolation is 1.\n", uy); - fprintf(fp, "!\n"); - fprintf(fp, "! f(t) = a + b * t, or\n"); - fprintf(fp, "!\n"); - fprintf(fp, "! where a and b are determined as the solution to\n"); - fprintf(fp, "! f(t1) = %s1, f(t2) = %s2\n", uy, uy); - fprintf(fp, "!\n"); - fprintf(fp, "!..................................................................................................................................\n"); - fprintf(fp, "\n"); - - - fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s1 ! %s at t1 > t2\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); - fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s2 ! %s at t2 \n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); - fprintf(fp, " REAL(%s), INTENT(IN ) :: tin(2) ! Times associated with the %ss\n", xtypnm, typnm); - fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s_out ! %s at tin_out\n", ModName->nickname, typnmlong, uy, typnm); - fprintf(fp, " REAL(%s), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to\n", xtypnm); - fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n"); - fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n"); - fprintf(fp, " ! local variables\n"); - fprintf(fp, " REAL(%s) :: t(2) ! Times associated with the %ss\n", xtypnm, typnm); - fprintf(fp, " REAL(%s) :: t_out ! Time to which to be extrap/interpd\n", xtypnm); - fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_%s_ExtrapInterp1'\n", ModName->nickname, typnm); - - - fprintf(fp, " REAL(DbKi) :: b ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " INTEGER(IntKi) :: ErrStat2 ! local errors\n"); - fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"); - for (j = 1; j <= max_ndims; j++) { - for (i = 0; i <= max_nrecurs; i++) { - fprintf(fp, " INTEGER :: i%d%d ! dim%d level %d counter variable for arrays of ddts\n", i, j, j, i); - } - } - for (j = 1; j <= max_ndims; j++) { - fprintf(fp, " INTEGER :: i%d ! dim%d counter variable for arrays\n", j, j); - } - - fprintf(fp, " ! Initialize ErrStat\n"); - fprintf(fp, " ErrStat = ErrID_None\n"); - fprintf(fp, " ErrMsg = \"\"\n"); - fprintf(fp, " ! we'll subtract a constant from the times to resolve some \n"); - fprintf(fp, " ! numerical issues when t gets large (and to simplify the equations)\n"); - fprintf(fp, " t = tin - tin(1)\n"); - fprintf(fp, " t_out = tin_out - tin(1)\n"); - fprintf(fp, "\n"); - - fprintf(fp, " IF ( EqualRealNos( t(1), t(2) ) ) THEN\n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n\n"); - - fprintf(fp, " ScaleFactor = t_out / t(2)\n"); - - for (r = q->fields; r; r = r->next) - { - // recursive - gen_extint_order(fp, ModName, typnm, uy, 1, r, "", 0); - } - - - fprintf(fp, " END SUBROUTINE %s_%s_ExtrapInterp1\n", ModName->nickname, typnm); - fprintf(fp, "\n"); -} - -void -gen_ExtrapInterp2(FILE *fp, const node_t * ModName, char * typnm, char * typnmlong, char * xtypnm, char * uy, const int max_ndims, const int max_nrecurs, const int max_alloc_ndims, const node_t *q) -{ - node_t *r; - int i, j; - - fprintf(fp, "\n"); - fprintf(fp, " SUBROUTINE %s_%s_ExtrapInterp2(%s1, %s2, %s3, tin, %s_out, tin_out, ErrStat, ErrMsg )\n", ModName->nickname, typnm, uy, uy, uy, uy); - fprintf(fp, "!\n"); - fprintf(fp, "! This subroutine calculates a extrapolated (or interpolated) %s %s_out at time t_out, from previous/future time\n", typnm, uy); - fprintf(fp, "! values of %s (which has values associated with times in t). Order of the interpolation is 2.\n", uy); - fprintf(fp, "!\n"); - fprintf(fp, "! expressions below based on either\n"); - fprintf(fp, "!\n"); - fprintf(fp, "! f(t) = a + b * t + c * t**2\n"); - fprintf(fp, "!\n"); - fprintf(fp, "! where a, b and c are determined as the solution to\n"); - fprintf(fp, "! f(t1) = %s1, f(t2) = %s2, f(t3) = %s3\n", uy, uy, uy); - fprintf(fp, "!\n"); - fprintf(fp, "!..................................................................................................................................\n"); - fprintf(fp, "\n"); - - fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s1 ! %s at t1 > t2 > t3\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); - fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s2 ! %s at t2 > t3\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); - fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s3 ! %s at t3\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); - fprintf(fp, " REAL(%s), INTENT(IN ) :: tin(3) ! Times associated with the %ss\n", xtypnm, typnm); - fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s_out ! %s at tin_out\n", ModName->nickname, typnmlong, uy, typnm); - fprintf(fp, " REAL(%s), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to\n", xtypnm); - - fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n" ); - fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n"); - fprintf(fp, " ! local variables\n"); - fprintf(fp, " REAL(%s) :: t(3) ! Times associated with the %ss\n", xtypnm, typnm); - fprintf(fp, " REAL(%s) :: t_out ! Time to which to be extrap/interpd\n", xtypnm); - fprintf(fp, " INTEGER(IntKi) :: order ! order of polynomial fit (max 2)\n"); - - fprintf(fp, " REAL(DbKi) :: b ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi) :: c ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " INTEGER(IntKi) :: ErrStat2 ! local errors\n"); - fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"); - fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_%s_ExtrapInterp2'\n", ModName->nickname, typnm); - for (j = 1; j <= max_ndims; j++) { - for (i = 0; i <= max_nrecurs; i++) { - fprintf(fp, " INTEGER :: i%d%d ! dim%d level %d counter variable for arrays of ddts\n", i, j, j, i); - } - } - for (j = 1; j <= max_ndims; j++) { - fprintf(fp, " INTEGER :: i%d ! dim%d counter variable for arrays\n", j, j); - } - fprintf(fp, " ! Initialize ErrStat\n"); - fprintf(fp, " ErrStat = ErrID_None\n"); - fprintf(fp, " ErrMsg = \"\"\n"); - fprintf(fp, " ! we'll subtract a constant from the times to resolve some \n"); - fprintf(fp, " ! numerical issues when t gets large (and to simplify the equations)\n"); - fprintf(fp, " t = tin - tin(1)\n"); - fprintf(fp, " t_out = tin_out - tin(1)\n"); - fprintf(fp, "\n"); - - - fprintf(fp, " IF ( EqualRealNos( t(1), t(2) ) ) THEN\n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " RETURN\n"); - fprintf(fp, " ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN\n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " RETURN\n"); - fprintf(fp, " ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN\n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n\n"); - - fprintf(fp, " ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3)))\n"); - - - - for (r = q->fields; r; r = r->next) - { - // recursive - gen_extint_order(fp, ModName, typnm, uy, 2, r, "", 0); - } - - - fprintf(fp, " END SUBROUTINE %s_%s_ExtrapInterp2\n", ModName->nickname, typnm); - fprintf(fp, "\n"); -} - - -void -gen_ExtrapInterp(FILE *fp, const node_t * ModName, char * typnm, char * typnmlong, char * xtypnm) -{ - char nonick[NAMELEN]; - char *ddtname; char uy[2]; - node_t *q, *r; - int max_ndims, max_nrecurs, max_alloc_ndims; - - if (!strcmp(make_lower_temp(typnm), "output")){ - strcpy(uy, "y"); - } - else{ - strcpy(uy, "u"); - } - - for (q = ModName->module_ddt_list; q; q = q->next) - { - if (q->usefrom == 0) { - ddtname = q->name; - remove_nickname(ModName->nickname, ddtname, nonick); - if (!strcmp(nonick, make_lower_temp(typnmlong))) { - - fprintf(fp, "\n"); - fprintf(fp, " SUBROUTINE %s_%s_ExtrapInterp(%s, t, %s_out, t_out, ErrStat, ErrMsg )\n", ModName->nickname, typnm, uy, uy); - fprintf(fp, "!\n"); - fprintf(fp, "! This subroutine calculates a extrapolated (or interpolated) %s %s_out at time t_out, from previous/future time\n", typnm, uy); - fprintf(fp, "! values of %s (which has values associated with times in t). Order of the interpolation is given by the size of %s\n", uy, uy); - fprintf(fp, "!\n"); - fprintf(fp, "! expressions below based on either\n"); - fprintf(fp, "!\n"); - fprintf(fp, "! f(t) = a\n"); - fprintf(fp, "! f(t) = a + b * t, or\n"); - fprintf(fp, "! f(t) = a + b * t + c * t**2\n"); - fprintf(fp, "!\n"); - fprintf(fp, "! where a, b and c are determined as the solution to\n"); - fprintf(fp, "! f(t1) = %s1, f(t2) = %s2, f(t3) = %s3 (as appropriate)\n", uy, uy, uy); - fprintf(fp, "!\n"); - fprintf(fp, "!..................................................................................................................................\n"); - fprintf(fp, "\n"); - - - fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s(:) ! %s at t1 > t2 > t3\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); - fprintf(fp, " REAL(%s), INTENT(IN ) :: t(:) ! Times associated with the %ss\n", xtypnm, typnm); - //jm Modified from INTENT( OUT) to INTENT(INOUT) to prevent ALLOCATABLE array arguments in the DDT - //jm from being maliciously deallocated through the call.See Sec. 5.1.2.7 of bonehead Fortran 2003 standard - fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s_out ! %s at tin_out\n", ModName->nickname, typnmlong, uy, typnm); - fprintf(fp, " REAL(%s), INTENT(IN ) :: t_out ! time to be extrap/interp'd to\n", xtypnm); - fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n"); - fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n"); - fprintf(fp, " ! local variables\n"); - fprintf(fp, " INTEGER(IntKi) :: order ! order of polynomial fit (max 2)\n"); - fprintf(fp, " INTEGER(IntKi) :: ErrStat2 ! local errors\n"); - fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"); - fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_%s_ExtrapInterp'\n", ModName->nickname, typnm); - fprintf(fp, " ! Initialize ErrStat\n"); - fprintf(fp, " ErrStat = ErrID_None\n"); - fprintf(fp, " ErrMsg = \"\"\n"); - fprintf(fp, " if ( size(t) .ne. size(%s)) then\n", uy); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(%s)',ErrStat,ErrMsg,RoutineName)\n",uy); - fprintf(fp, " RETURN\n"); - fprintf(fp, " endif\n"); - - fprintf(fp, " order = SIZE(%s) - 1\n", uy); - - fprintf(fp, " IF ( order .eq. 0 ) THEN\n"); - fprintf(fp, " CALL %s_Copy%s(%s(1), %s_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", ModName->nickname, typnm, uy, uy); - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " ELSE IF ( order .eq. 1 ) THEN\n"); - fprintf(fp, " CALL %s_%s_ExtrapInterp1(%s(1), %s(2), t, %s_out, t_out, ErrStat2, ErrMsg2 )\n", ModName->nickname, typnm, uy, uy, uy); - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " ELSE IF ( order .eq. 2 ) THEN\n"); - fprintf(fp, " CALL %s_%s_ExtrapInterp2(%s(1), %s(2), %s(3), t, %s_out, t_out, ErrStat2, ErrMsg2 )\n", ModName->nickname, typnm, uy, uy, uy, uy); - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " ELSE \n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal,'size(%s) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName)\n", uy); - fprintf(fp, " RETURN\n"); - fprintf(fp, " ENDIF \n"); - - fprintf(fp, " END SUBROUTINE %s_%s_ExtrapInterp\n", ModName->nickname, typnm); - fprintf(fp, "\n"); - - - max_ndims = 0; // ModName->module_ddt_list->max_ndims; //bjj: this is max for module, not for typnmlong - max_nrecurs = 0; // MAXRECURSE; - max_alloc_ndims = 0; - - for (r = q->fields; r; r = r->next) - { - // recursive - calc_extint_order(fp, ModName, r, 0, &max_ndims, &max_nrecurs, &max_alloc_ndims); - } - - gen_ExtrapInterp1(fp, ModName, typnm, typnmlong, xtypnm, uy, max_ndims, max_nrecurs, max_alloc_ndims, q); - gen_ExtrapInterp2(fp, ModName, typnm, typnmlong, xtypnm, uy, max_ndims, max_nrecurs, max_alloc_ndims, q); - - } - } - } - - - -} - - - - - - - -void -gen_rk4( FILE *fp , const node_t * ModName ) -{ - char nonick[NAMELEN] ; - char *ddtname ; - node_t *q, * r ; - int founddt, k ; - -// make sure the user has dt in their parameter types - founddt = 0 ; - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - if ( q->usefrom == 0 ) { - ddtname = q->name ; - remove_nickname(ModName->nickname,ddtname,nonick) ; - if ( !strcmp( nonick, "parametertype")) { - for ( r = q->fields ; r ; r = r->next ) - { - if ( !strcmp( r->type->mapsto, "REAL(ReKi)") || - !strcmp( r->type->mapsto, "REAL(SiKi)") || - !strcmp( r->type->mapsto, "REAL(R8Ki)") || - !strcmp( r->type->mapsto, "REAL(DbKi)")) - { - if ( !strcmp(make_lower_temp(r->name),"dt") ) { - founddt = 1 ; - } - } - } - } - } - } - if ( !founddt ) { - fprintf(stderr,"Registry warning: cannot generate %s_RK4. Add dt to ParameterType for this module\n", ModName->nickname) ; - return ; - } - - - fprintf(fp," SUBROUTINE %s_RK4(t, u, u_next, p, x, xd, z, OtherState, m, xdot, ErrStat, ErrMsg )\n", - ModName->nickname) ; - fprintf(fp," REAL(DbKi), INTENT(IN ) :: t ! Current simulation time in seconds\n") ; - fprintf(fp," TYPE(%s_InputType), INTENT(IN ) :: u ! Inputs at t\n", ModName->nickname) ; - fprintf(fp," TYPE(%s_InputType), INTENT(IN ) :: u_next ! Inputs at t\n", ModName->nickname) ; - fprintf(fp," TYPE(%s_ParameterType), INTENT(IN ) :: p ! Parameters\n", ModName->nickname) ; - fprintf(fp," TYPE(%s_ContinuousStateType), INTENT(INOUT) :: x ! Continuous states at t on input at t + dt on output\n", - ModName->nickname) ; - fprintf(fp," TYPE(%s_DiscreteStateType), INTENT(INOUT) :: xd ! Discrete states at t\n", ModName->nickname) ; - fprintf(fp," TYPE(%s_ConstraintStateType), INTENT(IN ) :: z ! Constraint states at t (possibly a guess)\n", - ModName->nickname) ; - fprintf(fp," TYPE(%s_OtherStateType), INTENT(INOUT) :: OtherState ! Other states\n", ModName->nickname) ; - fprintf(fp, " TYPE(%s_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables\n", ModName->nickname); - fprintf(fp, " TYPE(%s_ContinuousStateType), INTENT(IN ) :: xdot ! Continuous states at t on input at t + dt on output\n", - ModName->nickname) ; - fprintf(fp," INTEGER(IntKi), INTENT( OUT) :: ErrStat\n") ; - fprintf(fp," CHARACTER(*), INTENT( OUT) :: ErrMsg\n") ; - fprintf(fp," ! Local variables\n" ) ; - fprintf(fp," TYPE(%s_ContinuousStateType) :: xdot_local ! t derivatives of continuous states\n", - ModName->nickname) ; - fprintf(fp," TYPE(%s_ContinuousStateType) :: k1\n", - ModName->nickname) ; - fprintf(fp," TYPE(%s_ContinuousStateType) :: k2\n", - ModName->nickname) ; - fprintf(fp," TYPE(%s_ContinuousStateType) :: k3\n", - ModName->nickname) ; - fprintf(fp," TYPE(%s_ContinuousStateType) :: k4\n", - ModName->nickname) ; - fprintf(fp," TYPE(%s_ContinuousStateType) :: x_tmp ! Holds temporary modification to x\n", - ModName->nickname) ; - fprintf(fp," TYPE(%s_InputType) :: u_interp\n", - ModName->nickname) ; - fprintf(fp," REAL(ReKi) :: alpha\n") ; - - fprintf(fp," ! Initialize ErrStat\n") ; - - fprintf(fp," ErrStat = ErrID_None\n") ; - fprintf(fp," ErrMsg = \"\"\n") ; - fprintf(fp," !CALL %s_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, xdot_local, ErrStat, ErrMsg )\n", - ModName->nickname) ; - fprintf(fp," alpha = 0.5\n") ; - for ( k = 1 ; k <= 4 ; k++ ) - { -// generate statements for k1 - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - if ( q->usefrom == 0 ) { - ddtname = q->name ; - remove_nickname(ModName->nickname,ddtname,nonick) ; - if ( !strcmp( nonick, "continuousstatetype")) { - for ( r = q->fields ; r ; r = r->next ) - { - if ( !strcmp( r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)") || - !strcmp(r->type->mapsto, "REAL(DbKi)")) - { - fprintf(fp," k%d%%%s = p%%dt * xdot%s%%%s\n",k,r->name,(k<2)?"":"_local",r->name) ; - } - } - } - } - } -// generate statements for x_tmp - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - if ( q->usefrom == 0 ) { - ddtname = q->name ; - remove_nickname(ModName->nickname,ddtname,nonick) ; - if ( !strcmp( nonick, "continuousstatetype")) { - for ( r = q->fields ; r ; r = r->next ) - { - if ( !strcmp( r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)") || - !strcmp(r->type->mapsto, "REAL(DbKi)")) - { - if ( k < 4 ) { - fprintf(fp," x_tmp%%%s = x%%%s + %s k%d%%%s\n",r->name,r->name,(k<3)?"0.5*":"",k,r->name) ; - } else { - fprintf(fp," x%%%s = x%%%s + ( k1%%%s + 2. * k2%%%s + 2. * k3%%%s + k4%%%s ) / 6.\n",r->name,r->name,r->name,r->name,r->name,r->name) ; - } - } - } - } - } - } - - if (k == 1) fprintf(fp," CALL %s_LinearInterpInput(u, u_next, u_interp, alpha, ErrStat, ErrMsg)\n", - ModName->nickname) ; - if (k < 4 )fprintf(fp," CALL %s_CalcContStateDeriv( t+%sp%%dt, u_%s, p, x_tmp, xd, z, OtherState, m, xdot_local, ErrStat, ErrMsg )\n", - ModName->nickname, - (k<3)?"0.5*":"", - (k<3)?"interp":"next") ; - fprintf(fp,"\n") ; - } - fprintf(fp," END SUBROUTINE %s_RK4\n",ModName->nickname) ; - - -} - - -void -gen_module( FILE * fp , node_t * ModName, char * prog_ver ) -{ - node_t * p, * q, * r ; - int i ; - int ipass ; - char nonick[NAMELEN] ; - char tmp[NAMELEN] ; - char ** p1; - - if ( strlen(ModName->nickname) > 0 ) { -// gen preamble - { - fprintf( fp, "! %s\n", prog_ver ); - - for ( p1 = FAST_preamble ; *p1 ; p1++ ) { fprintf( fp, *p1, ModName->name ) ; } - } - for ( p = ModNames ; p ; p = p->next ) - { - // Add use declarations for Modules that are included as "usefrom" - if ( p->usefrom ) { - if ( strcmp(make_lower_temp(p->name),"nwtc_library") ) { - fprintf(fp,"USE %s_Types\n",p->name) ; - } - } - } - if ( sw_ccode ) { -// Generate a container object for the Fortran code to carry around a pointer to the CPP object(s) - //fprintf(fp,"USE %s_C_Types\n",ModName->nickname) ; - fprintf(fp,"!USE, INTRINSIC :: ISO_C_Binding\n") ; // this is inherited from NWTC_Library.f90, and older versions of gfortran complain about ambiguous data when we use this (it thinks it's declared twice; see http://gcc.gnu.org/ml/fortran/2013-04/msg00166.html ) - } - -// if this is the NWTC Library, we're not going to print "USE NWTC_Library" - if ( strcmp(make_lower_temp(ModName->name),"nwtc_library") == 0 ) { - fprintf(fp,"USE SysSubs\n"); - } else { - fprintf(fp,"USE NWTC_Library\n"); - } - - fprintf(fp,"IMPLICIT NONE\n") ; - -#if 0 - if ( sw_ccode ) { - fprintf(fp," TYPE MAP_In_C \n") ; - fprintf(fp," ! This allows us to create an instance of a C++ \n") ; - fprintf(fp," ! object in Fortran. From the perspective of \n") ; - fprintf(fp," ! Fortran, this is seen as an address in memory\n") ; - fprintf(fp," PRIVATE\n") ; - fprintf(fp," TYPE(C_ptr) :: %s_UserData = C_NULL_ptr\n",ModName->nickname) ; - fprintf(fp," END TYPE MAP_In_C \n") ; - } -#endif - -// generate parameters - for ( q = ModName->params ; q ; q = q->next ) - { - fprintf(fp," %s, PUBLIC, PARAMETER ",q->type->mapsto ) ; - if ( q->ndims > 0 ) - { - if ( q->dims[0]->deferred ) - { - fprintf(stderr,"Registry warning: parameter %s can not have deferred type\n",q->name) ; - fprintf(fp,"), ALLOCATABLE ") ; - } else { - fprintf(fp,", DIMENSION(") ; - for ( i = 0 ; i < q->ndims ; i++ ) - { - fprintf(fp,"%d:%d",q->dims[i]->coord_start,q->dims[i]->coord_end) ; - if ( i < q->ndims-1 ) fprintf(fp,",") ; - } - fprintf(fp,") ") ; - } - } - if ( strlen(q->inival) > 0 ) { - if ( q->ndims > 0 ) { - fprintf(fp," :: %s = (/%s/)", q->name, q->inival ) ; - } else { - fprintf(fp," :: %s = %s ", q->name, q->inival ) ; - } - } else { - fprintf(fp," :: %s",q->name) ; - } - if ( strcmp( q->descrip, "-" ) || strcmp( q->units, "-" ) ) /* that is, if not equal "-" */ { - fprintf(fp," ! %s [%s]", q->descrip, q->units) ; - } - fprintf(fp,"\n") ; - } - -// generate each derived data type - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - if (*q->mapsto) remove_nickname( ModName->nickname, make_lower_temp(q->mapsto) , nonick ) ; - fprintf(fp, "! ========= %s%s =======\n", q->mapsto, (sw_ccode) ? "_C" : ""); - for ( ipass = (sw_ccode)?0:1 ; ipass < 2 ; ipass++ ) { // 2 passes for C code, 1st pass generates bound ddt - if ( q->usefrom == 0 ) { - fprintf(fp," TYPE, %s :: %s%s\n",(ipass==0)?"BIND(C)":"PUBLIC",q->mapsto,(ipass==0)?"_C":"") ; - if ( sw_ccode ) { - if ( ipass == 0 ) { -// q->containsPtr = 1; - //if (!strcmp(make_lower_temp(nonick), "otherstatetype") || !strcmp(make_lower_temp(nonick), "initinputtype")){ - fprintf(fp, " TYPE(C_PTR) :: object = C_NULL_PTR\n"); - //} - } else { - fprintf(fp," TYPE( %s_C ) :: C_obj\n",q->mapsto) ; - } - } - for ( r = q->fields ; r ; r = r->next ) - { - if ( r->type != NULL ) { - // check max number of dimmensions - // check if this type contains any pointers/meshes or types that have pointers/meshes - if (r->ndims > q->max_ndims) q->max_ndims = r->ndims; - if (r->ndims > ModName->module_ddt_list->max_ndims) ModName->module_ddt_list->max_ndims = r->ndims; - if ( ipass == 0 ) { - //r->containsPtr = 1; - //q->containsPtr = 1; - if ( r->ndims == 0 && r->type->type_type != DERIVED ) { - fprintf(fp," %s :: %s \n",c_types_binding( r->type->mapsto), r->name) ; - } else if ( r->ndims > 0 && r->type->type_type != DERIVED ) { - if (r->dims[0]->deferred ) { - fprintf(fp," TYPE(C_ptr) :: %s = C_NULL_PTR \n", r->name) ; - fprintf(fp," INTEGER(C_int) :: %s_Len = 0 \n", r->name) ; - } - else { - if (strcmp(C_type(r->type->mapsto), "char")){ - fprintf(fp," TYPE(C_PTR) :: %s(", r->name) ; - for ( i = 0 ; i < r->ndims ; i++ ) - { - fprintf(fp,"%d",r->dims[i]->coord_end) ; - if ( i < r->ndims-1 ) fprintf(fp,",") ; - } - fprintf(fp,")\n") ; - } - - } - } - } else { // ipass /= 0 - if ( r->type->type_type == DERIVED ) { - fprintf(fp," TYPE(%s) ",r->type->mapsto ) ; - - checkContainsMesh(r); - if (r->containsPtr) q->containsPtr = 1; - - // bjj: we need to make sure these types map to reals, too - tmp[0] = '\0' ; - if (*q->mapsto ) remove_nickname( ModName->nickname, make_lower_temp(q->mapsto) , tmp ) ; - if ( must_have_real_or_double(tmp) ) checkOnlyReals( q->mapsto, r ); - - - } else { - tmp[0] = '\0' ; - if (*q->mapsto ) remove_nickname( ModName->nickname, make_lower_temp(q->mapsto) , tmp ) ; - if ( must_have_real_or_double(tmp) ) { - if ( strncmp(r->type->mapsto,"REAL",4) ) { - fprintf(stderr,"Registry warning: %s contains a field (%s) whose type is not real or double: %s\n", - q->mapsto, r->name , r->type->mapsto ) ; - } - - } - if ( is_pointer(r) ) { - fprintf(fp," %s ",c_types_binding(r->type->mapsto) ) ; - } else { - fprintf(fp," %s ",r->type->mapsto ) ; - } - } - - if ( r->ndims > 0 ) - { - if ( r->dims[0]->deferred ) // if one dim is deferred they all have to be; see check in type.c - { - fprintf(fp,", DIMENSION(") ; - for ( i = 0 ; i < r->ndims ; i++ ) - { - fprintf(fp,":") ; - if ( i < r->ndims-1 ) fprintf(fp,",") ; - } - if ( is_pointer(r) ) { - fprintf(fp,"), POINTER ") ; - } else { - fprintf(fp,"), ALLOCATABLE ") ; - } - - } else { - fprintf(fp,", DIMENSION(") ; - for ( i = 0 ; i < r->ndims ; i++ ) - { - if (r->dims[i]->dim_param == 0){ - fprintf(fp, "%d:%d", r->dims[i]->coord_start, r->dims[i]->coord_end) ; - } - else { - //fprintf(stderr, "start, %s, %s, %s\n", dimspec, dim_entry->name, dim_entry->module); - // if (r->module != NULL) { node_t *param_dim = get_entry(r->dims[i]->dim_param_name, r->module->params); } - - fprintf(fp, "%s", r->dims[i]->dim_param_name); - } - if ( i < r->ndims-1 ) fprintf(fp,",") ; - } - fprintf(fp,") ") ; - } - } - - - if ( is_pointer( r ) ) { - fprintf(fp," :: %s => NULL() ",r->name) ; - } else if ( r->ndims == 0 && strlen(r->inival) > 0 ) { - fprintf(fp," :: %s = %s ", r->name, r->inival ) ; - } else { - fprintf(fp," :: %s ",r->name) ; - } - - if ( strcmp( r->descrip, "-" ) || strcmp( r->units, "-" ) ) /* that is, if not equal "-" */ { - fprintf(fp," !< %s [%s]", r->descrip, r->units) ; - } - fprintf(fp,"\n") ; - } // ipass /= 0 - } - } - fprintf(fp," END TYPE %s%s\n",q->mapsto,(ipass==0)?"_C":"") ; - //fprintf(stderr, "module %d type %d\n", ModName->module_ddt_list->max_ndims, q->max_ndims); - - } - } - fprintf(fp,"! =======================\n") ; - } - - if ( sw_ccode ) { - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - - if ( q->usefrom == 0 ) { - - char * ddtname, * ddtnamelong, nonick[NAMELEN] ; - ddtname = q->name ; - - remove_nickname(ModName->nickname,ddtname,nonick) ; - - if ( is_a_fast_interface_type( nonick ) ) { - ddtnamelong = nonick ; - ddtname = fast_interface_type_shortname( nonick ) ; - } else { - ddtnamelong = ddtname ; - } - - } - } - } // sw_ccode - - - fprintf(fp,"CONTAINS\n") ; - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - if ( q->usefrom == 0 ) { - - char * ddtname, * ddtnamelong, nonick[NAMELEN] ; - //ddtname = q->name ; - ddtname = q->mapsto; - - remove_nickname(ModName->nickname,ddtname,nonick) ; - -//fprintf(stderr,">> %s %s %s \n",ModName->name, ddtname, nonick) ; - - if ( is_a_fast_interface_type( nonick ) ) { - ddtnamelong = nonick ; - ddtname = fast_interface_type_shortname( nonick ) ; - } else { - ddtnamelong = ddtname ; - } - - gen_copy( fp, ModName, ddtname, ddtnamelong , q) ; - gen_destroy( fp, ModName, ddtname, ddtnamelong ) ; - gen_pack( fp, ModName, ddtname, ddtnamelong ) ; - gen_unpack( fp, ModName, ddtname, ddtnamelong ) ; - if ( sw_ccode ) { - gen_copy_c2f( fp, ModName, ddtname, ddtnamelong ) ; - gen_copy_f2c(fp, ModName, ddtname, ddtnamelong); - } - - } - } -// bjj: removed gen_modname_pack and gen_modname_unpack because i don't see them being used any differently than the other pack/unpack routines 02/22/2014 -// gen_modname_pack( fp, ModName ) ; -// gen_modname_unpack( fp, ModName ) ; -// gen_rk4( fp, ModName ) ; - - if (strcmp(make_lower_temp(ModName->name), "airfoilinfo") == 0) { // make interpolation routines for AirfoilInfo module - gen_ExtrapInterp(fp, ModName, "Output", "OutputType","ReKi"); - gen_ExtrapInterp(fp, ModName, "UA_BL_Type", "UA_BL_Type", "ReKi"); - } else if (!sw_noextrap) { - if (strcmp(make_lower_temp(ModName->name), "dbemt") == 0) { // make interpolation routines for element-level DBEMT module - - gen_ExtrapInterp(fp, ModName, "ElementInputType", "ElementInputType", "DbKi"); - } - - gen_ExtrapInterp(fp, ModName, "Input", "InputType", "DbKi"); - gen_ExtrapInterp(fp, ModName, "Output", "OutputType", "DbKi"); - } - - fprintf(fp,"END MODULE %s_Types\n",ModName->name ) ; - } - -} - - -int -gen_module_files ( char * dirname, char * prog_ver ) -{ - FILE * fp, *fph ; - char fname[NAMELEN], fname2[NAMELEN] ; - - node_t * p ; - - for ( p = ModNames ; p ; p = p->next ) - { - if ( strlen( p->nickname ) > 0 && ! p->usefrom ) { - fp = NULL ; - - if ( strlen(dirname) > 0 ) - { sprintf(fname,"%s/%s_Types.f90",dirname,p->name) ; } - else - { sprintf(fname,"%s_Types.f90",p->name) ; } - sprintf(fname2, "%s_Types.f90", p->name); - - fprintf(stderr,"generating %s\n",fname) ; - - if ((fp = fopen( fname , "w" )) == NULL ) return(1) ; - print_warning(fp,fname2, ""); - - if ( sw_ccode == 1 ) { - - - if ( strlen(dirname) > 0 ) - { sprintf(fname,"%s/%s_Types.h",dirname,p->name) ; } - else - { sprintf(fname, "%s_Types.h",p->name) ;} - sprintf(fname2,"%s_Types.h",p->name) ; - if ((fph = fopen( fname , "w" )) == NULL ) return(1) ; - - - print_warning(fph,fname2, "//") ; - - fprintf(fph,"\n#ifndef _%s_TYPES_H\n",p->name); - fprintf(fph,"#define _%s_TYPES_H\n\n",p->name); - fprintf(fph,"\n#ifdef _WIN32 //define something for Windows (32-bit)\n"); - fprintf(fph,"# include \"stdbool.h\"\n"); - fprintf(fph,"# define CALL __declspec( dllexport )\n"); - fprintf(fph,"#elif _WIN64 //define something for Windows (64-bit)\n"); - fprintf(fph,"# include \"stdbool.h\"\n"); - fprintf(fph,"# define CALL __declspec( dllexport ) \n"); - fprintf(fph,"#else\n"); - fprintf(fph,"# include \n"); - fprintf(fph,"# define CALL \n"); - fprintf(fph,"#endif\n\n\n"); - } - gen_module ( fp , p, prog_ver ) ; - close_the_file( fp, "" ) ; - if ( sw_ccode ) { - gen_c_module ( fph , p ) ; - - fprintf(fph,"\n#endif // _%s_TYPES_H\n\n\n",p->name); - close_the_file( fph,"//") ; - - } - } - } - return(0) ; -} - -void -remove_nickname( const char *nickname, char *src, char *dst ) -{ - char tmp[NAMELEN]; - char srclo[NAMELEN]; - int n; - strcpy(tmp,make_lower_temp(nickname)) ; - strcpy(srclo, make_lower_temp(src)); - strcat(tmp,"_") ; - n = strlen(tmp) ; - if (!strncmp(tmp, srclo, n)) { - strcpy(dst,&(src[n])) ; - } else { - strcpy(dst,src) ; - } -} - -void -append_nickname( const char *nickname, char *src, char *dst ) -{ - int n ; - n = strlen(nickname) ; - if ( n > 0 ) { - sprintf(dst,"%s_%s",nickname,src) ; - } else { - strcpy(dst,src) ; - } -} - -char * dimstr( int d ) -{ - char * retval ; - if ( d == 0 ) { - retval = "" ; - } else if ( d == 1 ) { - retval = "(i1)" ; - } else if ( d == 2 ) { - retval = "(i1,i2)" ; - } else if ( d == 3 ) { - retval = "(i1,i2,i3)" ; - } else if ( d == 4 ) { - retval = "(i1,i2,i3,i4)" ; - } else if ( d == 5 ) { - retval = "(i1,i2,i3,i4,i5)" ; - } else { - retval = " REGISTRY ERROR TOO MANY DIMS " ; - } - return(retval) ; - - //strcpy(dex, ""); - //strcat(dex, "("); - //for (j = 1; j <= d; j++) { - // sprintf(tmp, "i%d%d", 0, j); - // strcat(dex, tmp); - // if (j == d) strcat(dex, ")"); else strcat(dex, ","); - //} - -} - -char * dimstr_c( int d ) -{ - char * retval ; - if ( d == 0 ) { - retval = "" ; - } else if ( d == 1 ) { - retval = "[i1]" ; - } else if ( d == 2 ) { - retval = "[i2][i1]" ; - } else if ( d == 3 ) { - retval = "[i3][i2][i1]" ; - } else if ( d == 4 ) { - retval = "[i4][i3][i2][i1]" ; - } else if ( d == 5 ) { - retval = "[i5][i4][i3][i2][i1]" ; - } else { - retval = " REGISTRY ERROR TOO MANY DIMS " ; - } - return(retval) ; -} - -void -checkOnlyReals( const char *q_mapsto, node_t * q) //, int recurselevel) -{ - node_t * r ; - - if ( q->type->type_type == DERIVED ) - { - if ( strcmp( q->type->name, "meshtype" ) ) // skip meshes - { - for ( r = q->type->fields ; r ; r = r->next ) - { - checkOnlyReals( q_mapsto, r); - } - } - - } else { // SIMPLE - - if ( strncmp(q->type->mapsto,"REAL",4) ) - { - fprintf(stderr,"Registry warning: %s contains a field (%s) in a derived type whose type is not real or double: %s\n", - q_mapsto, q->name , q->type->mapsto ) ; - } - - } - return; -} - -void -checkContainsMesh( node_t * q) //, int recurselevel) -{ - node_t * r; - - if (q->type->type_type == DERIVED) - { - if (!strcmp(q->type->name, "meshtype") || !strcmp(q->type->name, "meshmaptype")){ // is a mesh or (a bad workaround for meshmaptype which contains meshtype in "usefrom" instead of "typedef") - q->containsPtr = 1; - } - - else { - for (r = q->type->fields; r; r = r->next) - { - checkContainsMesh(r); - if (r->containsPtr) q->containsPtr = 1; - } - } - - } - - return; -} diff --git a/OpenFAST/modules/openfast-registry/src/misc.c b/OpenFAST/modules/openfast-registry/src/misc.c deleted file mode 100644 index 628aa05bc..000000000 --- a/OpenFAST/modules/openfast-registry/src/misc.c +++ /dev/null @@ -1,710 +0,0 @@ -#include -#include -#include -#include -#ifdef _WIN32 -# define rindex(X,Y) strrchr(X,Y) -# define index(X,Y) strchr(X,Y) -# include -# define getpid _getpid -#else -# include -# include -# include -#endif - -#include "protos.h" -#include "registry.h" -#include "data.h" - -char * -dimension_with_colons( char * pre , char * tmp , node_t * p , char * post ) -{ - int i ; - if ( p == NULL ) return("") ; - if ( p->ndims <= 0 && ! p->boundary_array ) return("") ; - strcpy(tmp,"") ; - if ( pre != NULL ) strcat(tmp,pre) ; - if ( p->boundary_array ) - { - if ( ! sw_new_bdys ) { strcat( tmp,":,") ; } - if ( !strcmp( p->use , "_4d_bdy_array_" ) ) { - strcat( tmp, ":,:,:,:" ) ; /* boundary array for 4d tracer array */ - } else { - strcat( tmp, ":,:,:" ) ; /* most always have four dimensions */ - } - } - else - { - for ( i = 0 ; i < p->ndims ; i++ ) strcat(tmp,":,") ; - if ( p->node_kind & FOURD ) strcat(tmp,":,") ; /* add an extra for 4d arrays */ - tmp[strlen(tmp)-1] = '\0' ; - } - if ( post != NULL ) strcat(tmp,post) ; - return(tmp) ; -} - -char * -dimension_with_ones( char * pre , char * tmp , node_t * p , char * post ) -{ - int i ; - char r[NAMELEN],s[NAMELEN],four_d[NAMELEN] ; - char *pp ; - if ( p == NULL ) return("") ; - if ( p->ndims <= 0 && ! p->boundary_array ) return("") ; - strcpy(tmp,"") ; - if ( pre != NULL ) strcat(tmp,pre) ; - - if ( p->boundary_array ) - { - if ( ! sw_new_bdys ) { strcpy( tmp,"(1,") ; } - if ( !strcmp( p->use , "_4d_bdy_array_" ) ) { /* if a boundary array for a 4d tracer */ - strcpy(s, p->name ) ; /* copy the name and then remove everything after last underscore */ - if ((pp=rindex( s, '_' )) != NULL ) *pp = '\0' ; - sprintf( four_d, "num_%s,", s ) ; - } else { - strcpy( four_d, "" ) ; - } - - if ( !strcmp( p->use , "_4d_bdy_array_" ) ) { - sprintf( r, "1,1,1,%s", four_d ) ; /* boundary array for 4d tracer array */ - strcat( tmp, r ) ; - } else { - strcat( tmp, "1,1,1," ) ; - } - tmp[strlen(tmp)-1] = '\0' ; - } - else - { - for ( i = 0 ; i < p->ndims ; i++ ) strcat(tmp,"1,") ; - if ( p->node_kind & FOURD ) strcat(tmp,"1,") ; /* add an extra for 4d arrays */ - tmp[strlen(tmp)-1] = '\0' ; - } - if ( post != NULL ) strcat(tmp,post) ; - return(tmp) ; -} - -char * -dimension_with_ranges( char * refarg , char * pre , - int bdy , /* as defined in data.h */ - char * tmp , node_t * p , char * post , - char * nlstructname ) /* added 20020130; - provides name (with %) of structure in - which a namelist supplied dimension - should be dereference from, or "" */ -{ - int i ; - char tx[NAMELEN] ; - char r[NAMELEN],s[NAMELEN],four_d[NAMELEN] ; - int bdex, xdex, ydex, zdex ; - node_t *xdim, *ydim, *zdim ; - char *pp ; - if ( p == NULL ) return("") ; - if ( p->ndims <= 0 && !p->boundary_array ) return("") ; - strcpy(tmp,"") ; - if ( pre != NULL ) strcat(tmp,pre) ; - strcpy(r,"") ; - if ( refarg != NULL ) strcat(r,refarg) ; - - if ( p->boundary_array ) - { - if ( p->ndims > 0 ) - { - xdim = get_dimnode_for_coord( p , COORD_X ) ; - ydim = get_dimnode_for_coord( p , COORD_Y ) ; - zdim = get_dimnode_for_coord( p , COORD_Z ) ; - if ( ydim == NULL ) - { fprintf(stderr,"dimension_with_ranges: y dimension not specified for %s\n",p->name) ; return("") ; } - if ( xdim == NULL ) - { fprintf(stderr,"dimension_with_ranges: x dimension not specified for %s\n",p->name) ; return("") ; } - - xdex = xdim->dim_order ; - ydex = ydim->dim_order ; - - if ( !strcmp( p->use , "_4d_bdy_array_" ) ) { /* if a boundary array for a 4d tracer */ - strcpy(s, p->name ) ; /* copy the name and then remove everything after last underscore */ - if ((pp=rindex( s, '_' )) != NULL ) *pp = '\0' ; - sprintf( four_d, "num_%s,", s ) ; - } else { - strcpy( four_d, "" ) ; - } - if ( sw_new_bdys ) { - if ( bdy == P_XSB || bdy == P_XEB ) { bdex = ydex ; } - else if ( bdy == P_YSB || bdy == P_YEB ) { bdex = xdex ; } - else { fprintf(stderr,"REGISTRY WARNING: internal error %s %d, bdy=%d,%s,%d \n",__FILE__,__LINE__,bdy,p->name,p->boundary) ; } - if ( zdim != NULL ) { - zdex = zdim->dim_order ; - sprintf(tx,"%ssm3%d:%sem3%d,%ssm3%d:%sem3%d,%sspec_bdy_width,%s", r,bdex,r,bdex,r,zdex,r,zdex,r,four_d ) ; - } else { - sprintf(tx,"%ssm3%d:%sem3%d,1,%sspec_bdy_width,%s", r,bdex,r,bdex,r,four_d ) ; - } - } else { - if ( zdim != NULL ) { - zdex = zdim->dim_order ; - sprintf(tx,"max(%sed3%d,%sed3%d),%ssd3%d:%sed3%d,%sspec_bdy_width,4,%s", r,xdex,r,ydex,r,zdex,r,zdex,r,four_d ) ; - } else { - sprintf(tx,"max(%sed3%d,%sed3%d),1,%sspec_bdy_width,4,%s", r,xdex,r,ydex,r,four_d ) ; - } - } - } - else - { - sprintf(tx,"%sspec_bdy_width,",r ) ; - } - strcat(tmp,tx) ; - } - else - { - for ( i = 0 ; i < p->ndims ; i++ ) - { - range_of_dimension( r, tx , i , p , nlstructname ) ; - strcat(tmp,tx) ; - strcat(tmp,",") ; - } - } - tmp[strlen(tmp)-1] = '\0' ; - if ( post != NULL ) strcat(tmp,post) ; - - return(tmp) ; -} - -void -range_of_dimension ( char * r , char * tx , int i , node_t * p , char * nlstructname ) -{ - char s[NAMELEN], e[NAMELEN] ; - - get_elem( r , nlstructname , s , i , p , 0 ) ; - get_elem( r , nlstructname , e , i , p , 1 ) ; - sprintf(tx,"%s:%s", s , e ) ; - -} - -char * -index_with_firstelem( char * pre , char * dref , int bdy , /* as defined in data.h */ - char * tmp , node_t * p , char * post ) -{ - int i ; - char tx[NAMELEN] ; - int bdex, xdex, ydex, zdex = 0 ; - node_t *xdim, *ydim, *zdim ; - char r[NAMELEN] ; - - if ( p == NULL ) return("") ; - if ( p->ndims <= 0 ) return("") ; - strcpy(tmp,"") ; - if ( pre != NULL ) strcat(tmp,pre) ; - - strcpy(r,"") ; - if ( dref != NULL ) strcat(r,dref) ; - - if ( p->boundary_array ) - { - if ( sw_new_bdys ) { - - xdim = get_dimnode_for_coord( p , COORD_X ) ; - ydim = get_dimnode_for_coord( p , COORD_Y ) ; - zdim = get_dimnode_for_coord( p , COORD_Z ) ; - if ( ydim == NULL ) - { fprintf(stderr,"dimension_with_ranges: y dimension not specified for %s\n",p->name) ; return("") ; } - if ( xdim == NULL ) - { fprintf(stderr,"dimension_with_ranges: x dimension not specified for %s\n",p->name) ; return("") ; } - - xdex = xdim->dim_order ; - ydex = ydim->dim_order ; - - if ( bdy == P_XSB || bdy == P_XEB ) { bdex = ydex ; } - else if ( bdy == P_YSB || bdy == P_YEB ) { bdex = xdex ; } - else { fprintf(stderr,"REGISTRY WARNING: internal error %s %d \n",__FILE__,__LINE__) ; } - if ( p->ndims > 0 ) - { - if ( !strcmp( p->use , "_4d_bdy_array_" ) ) { - sprintf(tmp,"%ssm3%d,%ssm3%d,1,1", r,bdex,r,zdex ) ; - } else { - sprintf(tmp,"%ssm3%d,%ssm3%d,1", r,bdex,r,zdex ) ; - } - } - else - { - sprintf(tx,"1," ) ; - strcat(tmp,tx) ; - } - - } else { - if ( p->ndims > 0 ) - { - if ( !strcmp( p->use , "_4d_bdy_array_" ) ) { - strcat(tmp,"1,1,1,1,1,") ; - } else { - strcat(tmp,"1,1,1,1,") ; - } - } - else - { - sprintf(tx,"1," ) ; - strcat(tmp,tx) ; - } - } - } - else - { - for ( i = 0 ; i < p->ndims ; i++ ) - { - get_elem( dref, "", tx, i, p , 0 ) ; - strcat( tmp, tx ) ; - strcat(tmp,",") ; - } - } - tmp[strlen(tmp)-1] = '\0' ; /* remove trailing comma */ - if ( post != NULL ) strcat(tmp,post) ; - return(tmp) ; -} - -void -get_elem ( char * structname , char * nlstructname , char * tx , int i , node_t * p , int first_last ) -{ - char dref[NAMELEN], nlstruct[NAMELEN] ; - char d, d1 ; - - if ( structname == NULL ) { strcpy( dref, "" ) ;} - else { strcpy( dref, structname ) ; } - if ( nlstructname == NULL ) { strcpy( nlstruct, "" ) ;} - else { strcpy( nlstruct, nlstructname ) ; } - if ( p->dims[i] != NULL ) - { - switch ( p->dims[i]->len_defined_how ) - { - case (DOMAIN_STANDARD) : - { - char *ornt ; - if ( p->proc_orient == ALL_X_ON_PROC ) ornt = "x" ; - else if ( p->proc_orient == ALL_Y_ON_PROC ) ornt = "y" ; - else ornt = "" ; - - switch( p->dims[i]->coord_axis ) - { - case(COORD_X) : d = 'i' ; d1 = 'x' ; break ; - case(COORD_Y) : d = 'j' ; d1 = 'y' ; break ; - case(COORD_Z) : d = 'k' ; d1 = 'z' ; break ; - default : break ; - } - - if ( p->dims[i]->subgrid ) - { - if ( first_last == 0 ) { /*first*/ - sprintf(tx,"(%ssm3%d%s-1)*%ssr_%c+1",dref,p->dims[i]->dim_order,ornt,dref,d1) ; - }else{ /*last*/ - sprintf(tx,"%sem3%d%s*%ssr_%c" ,dref,p->dims[i]->dim_order,ornt,dref,d1) ; - } - } - else - { - sprintf(tx,"%s%cm3%d%s",dref,first_last==0?'s':'e',p->dims[i]->dim_order,ornt) ; - } - } - break ; - case (NAMELIST) : - if ( first_last == 0 ) { if ( !strcmp( p->dims[i]->assoc_nl_var_s , "1" ) ) { - sprintf(tx,"%s",p->dims[i]->assoc_nl_var_s) ; - } else { - sprintf(tx,"%s%s%s",nlstructname,structname,p->dims[i]->assoc_nl_var_s) ; - } - } - else { sprintf(tx,"%s%s%s",nlstructname,structname,p->dims[i]->assoc_nl_var_e) ; } - break ; - case (CONSTANT) : - if ( first_last == 0 ) { sprintf(tx,"%d",p->dims[i]->coord_start) ; } - else { sprintf(tx,"%d",p->dims[i]->coord_end) ; } - break ; - default : break ; - } - } - else - { - fprintf(stderr,"WARNING: %s %d: something wrong with internal representation for dim %d\n",__FILE__,__LINE__,i) ; - } -} - -char * -declare_array_as_pointer( char * tmp , node_t * p ) -{ - strcpy( tmp , "" ) ; - if ( p != NULL ) { -#ifdef USE_ALLOCATABLES - if ( p->ndims > 0 || p->boundary_array ) strcpy ( tmp, ",ALLOCATABLE" ) ; -#else - if ( p->ndims > 0 || p->boundary_array ) strcpy ( tmp, ",POINTER" ) ; -#endif - } - return(tmp); -} - -char * -field_type( char * tmp , node_t * p ) -{ - if ( p == NULL ) { - strcpy( tmp , "" ) ; - } else if ( p->type == NULL ) { - strcpy( tmp , "" ) ; - } else if ( p->type->type_type == SIMPLE ) { - strcpy( tmp , p->type->name ) ; - } else { - sprintf( tmp , "TYPE(%s)", p->type->name ) ; - } - return( tmp ) ; -} - -char * -field_name( char * tmp , node_t * p , int tag ) -{ - if ( p == NULL ) return("") ; - return( tmp ) ; -} - -char * -field_name_bdy( char * tmp , node_t * p , int tag, int bdy ) -{ - if ( p == NULL ) return("") ; - if ( tag < 1 ) - { - strcpy(tmp,p->name) ; - } - else - { - sprintf(tmp,"%s_%d",p->name,tag) ; - } - return( tmp ) ; -} - -static char *emp_str = "" ; -static char *xs_str = "xs" ; -static char *xe_str = "xe" ; -static char *ys_str = "ys" ; -static char *ye_str = "ye" ; - -char * -bdy_indicator( int bdy ) -{ - char * res ; - res = emp_str ; - if ( bdy == P_XSB ) { res = xs_str ; } - else if ( bdy == P_XEB ) { res = xe_str ; } - else if ( bdy == P_YSB ) { res = ys_str ; } - else if ( bdy == P_YEB ) { res = ye_str ; } - return(res) ; -} - -int -print_warning( FILE * fp , char * fname, char comment[] ) -{ -fprintf(fp,"%s!STARTOFREGISTRYGENERATEDFILE '%s'\n", comment, fname) ; -fprintf(fp,"%s!\n", comment) ; -fprintf(fp,"%s! WARNING This file is generated automatically by the FAST registry.\n", comment) ; -fprintf(fp,"%s! Do not edit. Your changes to this file will be lost.\n", comment) ; -fprintf(fp,"%s!\n", comment) ; -return(0) ; -} - -void -close_the_file( FILE * fp, char comment[] ) -{ -fprintf(fp,"%s!ENDOFREGISTRYGENERATEDFILE\n",comment) ; -fclose(fp) ; -} - -int -make_entries_uniq ( char * fname ) -{ - char tempfile[NAMELEN] ; - /* Had to increase size for SOA from 4096 to 7000 */ - char commline[7000] ; - sprintf(tempfile,"regtmp1%d",getpid()) ; - sprintf(commline,"%s < %s > %s ; %s %s %s ", - UNIQSORT,fname,tempfile, - MVCOMM,tempfile,fname ) ; - return(system(commline)) ; -} - -int -add_warning ( char * fname ) -{ - FILE * fp ; - char tempfile[NAMELEN] ; - char tempfile1[NAMELEN] ; - /* Had to increase size for SOA from 4096 to 7000 */ - char commline[7000] ; - sprintf(tempfile,"regtmp1%d",getpid()) ; - sprintf(tempfile1,"regtmp2%d",getpid()) ; - if (( fp = fopen( tempfile, "w" )) == NULL ) return(1) ; - print_warning(fp,tempfile, "") ; - close_the_file(fp, "") ; - sprintf(commline,"%s %s %s > %s ; %s %s %s ; %s %s ", - CATCOMM,tempfile,fname,tempfile1, - MVCOMM,tempfile1,fname, - RMCOMM,tempfile) ; - return(system(commline)) ; -} - -/* DESTRUCTIVE */ -char * -make_upper_case ( char * str ) -{ - char * p ; - if ( str == NULL ) return (NULL) ; - for ( p = str ; *p ; p++ ) *p = toupper(*p) ; - return(str) ; -} - -/* DESTRUCTIVE */ -char * -make_lower_case ( char * str ) -{ - char * p ; - if ( str == NULL ) return (NULL) ; - for ( p = str ; *p ; p++ ) *p = tolower(*p) ; - return(str) ; -} - -/* Routines for keeping typedef history -ajb */ - -static int NumTypeDefs ; -static char typedefs[MAX_TYPEDEFS][NAMELEN] ; - -int -init_typedef_history() -{ - NumTypeDefs = 0 ; - return(0) ; -} - -int -get_num_typedefs() -{ - return( NumTypeDefs ) ; -} - -char * -get_typename_i(int i) -{ - if ( i >= 0 && i < NumTypeDefs ) return( typedefs[i] ) ; - return(NULL) ; -} - -int -add_typedef_name ( char * name ) -{ - if ( name == NULL ) return(1) ; - if ( get_typedef_name ( name ) == NULL ) - { - if ( NumTypeDefs >= MAX_TYPEDEFS ) return(1) ; - strcpy( typedefs[NumTypeDefs++] , name ) ; - } - return(0) ; -} - -char * -get_typedef_name ( char * name ) -{ - int i ; - if ( name == NULL ) return(NULL) ; - for ( i = 0 ; i < NumTypeDefs ; i++ ) - { - if ( !strcmp(name,typedefs[i]) ) return( typedefs[i] ) ; - } - return(NULL) ; -} - -int -associated_with_4d_array( node_t * p ) -{ - int res = 0 ; - node_t * possble ; - char * last_underscore ; - char name_copy[128] ; - if ( p != NULL ) - { - /* check this variable and see if it is a boundary variable that is associated with a 4d array */ - strcpy( name_copy, p->name ) ; - if (( last_underscore = rindex( name_copy , '_' )) != NULL ) { - if ( !strcmp( last_underscore , "_b" ) || !strcmp( last_underscore , "_bt" ) ) { - *last_underscore = '\0' ; - if (( possble = get_entry( name_copy , Domain.fields )) != NULL ) { - res = possble->node_kind & FOURD ; - } - } - } - } - return(res) ; -} - -char * -array_size_expression ( char * refarg , char * pre , - int bdy , /* as defined in data.h */ - char * tmp , node_t * p , char * post , - char * nlstructname ) /* provides name (with %) of structure in - which a namelist supplied dimension - should be dereference from, or "" */ -{ - int i ; - char tx[NAMELEN] ; - char r[NAMELEN],s[NAMELEN],four_d[NAMELEN] ; - int bdex, xdex, ydex, zdex ; - node_t *xdim, *ydim, *zdim ; - char *pp ; - if ( p == NULL ) return("") ; - if ( p->ndims <= 0 && !p->boundary_array ) return("") ; - strcpy(tmp,"") ; - if ( pre != NULL ) strcat(tmp,pre) ; - strcpy(r,"") ; - if ( refarg != NULL ) strcat(r,refarg) ; - - if ( p->boundary_array ) - { - if ( p->ndims > 0 ) - { - xdim = get_dimnode_for_coord( p , COORD_X ) ; - ydim = get_dimnode_for_coord( p , COORD_Y ) ; - zdim = get_dimnode_for_coord( p , COORD_Z ) ; - if ( ydim == NULL ) - { fprintf(stderr,"dimension_with_ranges: y dimension not specified for %s\n",p->name) ; return("") ; } - if ( xdim == NULL ) - { fprintf(stderr,"dimension_with_ranges: x dimension not specified for %s\n",p->name) ; return("") ; } - - xdex = xdim->dim_order ; - ydex = ydim->dim_order ; - - if ( !strcmp( p->use , "_4d_bdy_array_" ) ) { /* if a boundary array for a 4d tracer */ - strcpy(s, p->name ) ; /* copy the name and then remove everything after last underscore */ - if ((pp=rindex( s, '_' )) != NULL ) *pp = '\0' ; - sprintf( four_d, "*num_%s,", s ) ; - } else { - strcpy( four_d, "" ) ; - } - if ( sw_new_bdys ) { - if ( bdy == P_XSB || bdy == P_XEB ) { bdex = ydex ; } - else if ( bdy == P_YSB || bdy == P_YEB ) { bdex = xdex ; } - else { fprintf(stderr,"REGISTRY WARNING: internal error %s %d, bdy=%d,%s,%d \n",__FILE__,__LINE__,bdy,p->name,p->boundary) ; } - if ( zdim != NULL ) { - zdex = zdim->dim_order ; - sprintf(tx,"(%sem3%d-%ssm3%d+1)*(%sem3%d-%ssm3%d+1)*(%sspec_bdy_width)%s", r,bdex,r,bdex,r,zdex,r,zdex,r,four_d ) ; - } else { - sprintf(tx,"(%sem3%d-%ssm3%d+1)*(%sspec_bdy_width)%s", r,bdex,r,bdex,r,four_d ) ; - } - } else { - if ( zdim != NULL ) { - zdex = zdim->dim_order ; - sprintf(tx,"max(%sed3%d,%sed3%d)*(%sed3%d-%ssd3%d+1)*%sspec_bdy_width*4*%s", r,xdex,r,ydex,r,zdex,r,zdex,r,four_d ) ; - } else { - sprintf(tx,"max(%sed3%d,%sed3%d)*%sspec_bdy_width*4*%s", r,xdex,r,ydex,r,four_d ) ; - } - if ( tx[strlen(tx)-1] == '*' ) tx[strlen(tx)-1] = '\0' ; /* chop trailing * if four_d is "" */ - } - } - else - { - sprintf(tx,"%sspec_bdy_width,",r ) ; - } - strcat(tmp,tx) ; - } - else - { - for ( i = 0 ; i < p->ndims ; i++ ) - { - dimension_size_expression( r, tx , i , p , nlstructname ) ; - strcat(tmp,tx) ; - strcat(tmp,")*(") ; - } - } - if ( tmp[strlen(tmp)-1] == '(' ) { - tmp[strlen(tmp)-3] = '\0' ; /* get rid of trailing )*( */ - } else if ( tmp[strlen(tmp)-1] == ',' ) { - tmp[strlen(tmp)-1] = '\0' ; - } - if ( post != NULL ) strcat(tmp,post) ; - - return(tmp) ; -} - -void -dimension_size_expression ( char * r , char * tx , int i , node_t * p , char * nlstructname ) -{ - char s[NAMELEN], e[NAMELEN] ; - - get_elem( r , nlstructname , s , i , p , 0 ) ; - get_elem( r , nlstructname , e , i , p , 1 ) ; - sprintf(tx,"((%s)-(%s)+1)", e , s ) ; - -} - -#ifdef FUTURE -void -reset_mask ( unsigned int * mask , int e ) -{ - int w ; - unsigned int m, n ; - - w = e / (8*sizeof(int)-1) ; - n = 1 ; - m = ~( n << e % (8*sizeof(int)-1) ) ; - if ( w >= 0 && w < IO_MASK_SIZE ) { - mask[w] &= m ; - } -} - -void -set_mask ( unsigned int * mask , int e ) -{ - int w ; - unsigned int m, n ; - - w = e / (8*sizeof(int)-1) ; - n = 1 ; - m = ( n << e % (8*sizeof(int)-1) ) ; - if ( w >= 0 && w < IO_MASK_SIZE ) { - mask[w] |= m ; - } -} - -int -get_mask ( unsigned int * mask , int e ) -{ - int w ; - unsigned int m, n ; - - w = e / (8*sizeof(int)-1) ; /* 8 is number of bits per byte */ - if ( w >= 0 && w < IO_MASK_SIZE ) { - m = mask[w] ; - n = ( 1 << e % (8*sizeof(int)-1) ) ;; - return ( (m & n) != 0 ) ; - } else { - return(0) ; - } -} -#endif - -#if 0 -main() -{ - unsigned int m[5] ; - int i, ii ; - - for ( i = 0 ; i < 5*32 ; i++ ) { - for ( ii = 0 ; ii < 5 ; ii++ ) { m[ii] = 0xffffffff ; } - reset_mask( m, i ) ; - for ( ii = 4 ; ii >= 0 ; ii-- ) { printf(" %08x ", m[ii]) ; } - printf("\n") ; - } - - for ( i = 0 ; i < 5*32 ; i++ ) { - for ( ii = 0 ; ii < 5 ; ii++ ) { m[ii] = 0x0 ; } - set_mask( m, i ) ; - for ( ii = 4 ; ii >= 0 ; ii-- ) { printf(" %08x ", m[ii]) ; } - printf("\n") ; - } - - for ( ii = 0 ; ii < 5 ; ii++ ) { m[ii] = 0x0 ; } - set_mask( m, 82 ) ; - for ( i = 0 ; i < 5*32 ; i++ ) { - printf("%d %0d\n",i,get_mask(m,i) ) ; - } -} -#endif diff --git a/OpenFAST/modules/openfast-registry/src/my_strtok.c b/OpenFAST/modules/openfast-registry/src/my_strtok.c deleted file mode 100644 index ec7f479a9..000000000 --- a/OpenFAST/modules/openfast-registry/src/my_strtok.c +++ /dev/null @@ -1,139 +0,0 @@ -#include -#include -#include "registry.h" -#include "protos.h" -#include "ctype.h" - - -/* work sort of like strtok but mind quote chars */ -static char * tokpos = NULL ; -char * -my_strtok( char * s1 ) -{ - char *p, *retval ; - int state ; - state = 0 ; - retval = NULL ; - if ( s1 == NULL && tokpos == NULL ) return( NULL ) ; - if ( s1 != NULL ) tokpos = s1 ; - for ( p = tokpos ; *p ; p++ ) - { -/* check for non-printable characters in input. this can happen cutting and pasting from a - MS office document or PDF */ - - if ( !( (' ' <= *p && *p <= '~') || *p == '\t' ) ) { - fprintf(stderr,"Registry error: FATAL: Invalid character '%c' (maybe invisible: can happen if you cut-and-paste from a Office doc or PDF)\n",*p) ; - exit(2) ; - } - if ( state == 0 && (*p == ' ' || *p == '\t') ) continue ; - if ( state == 0 && !(*p == ' ' || *p == '\t') ) { state = 1 ; retval = p ; } ; - if ( state == 1 && (*p == '"') ) { state = 2 ; } - else if ( state == 2 && (*p == '"') ) { state = 1 ; } - if ( state == 1 && (*p == ' ' || *p == '\t') ) { *p = '\0' ; p++ ; break ; } - } - tokpos = p ; - return( retval ) ; -} - - -/* posix like rentrant strtok; not quote safe, and not quite strtok -- new version; skips multi delims */ -char * -strtok_rentr( char * s1 , char * s2, char ** tokpos ) -{ - char *p, *q, *retval ; - int match ; - retval = NULL ; - if ( s1 == NULL && s2 == NULL ) return( NULL ) ; - if ( s1 != NULL ) { *tokpos = s1 ; } - if ( **tokpos ) retval = *tokpos ; - for ( p = *tokpos ; *p ; p++ ) - { - for ( q = s2 ; *q ; q++ ) - { - if ( *p == *q ) { *p = '\0' ; p++ ; goto foundit ; } - } - } -foundit: -/* skip over multi-delims */ - for ( ; *p ; p++ ) - { - match = 0 ; - for ( q = s2 ; *q ; q++ ) - { - if ( *p == *q ) { *p = '\0' ; match++ ; } - } - if ( match == 0 ) { break ; } - } - *tokpos = p ; - return( retval ) ; -} - -#if 0 -/* posix like rentrant strtok; not quote safe, and not quite strtok -- won't skip over multiple delims */ -char * -strtok_rentr( char * s1 , char * s2, char ** tokpos ) -{ - char *p, *q, *retval ; - retval = NULL ; - if ( s1 == NULL && s2 == NULL ) return( NULL ) ; - if ( s1 != NULL ) { *tokpos = s1 ; } - if ( **tokpos ) retval = *tokpos ; - for ( p = *tokpos ; *p ; p++ ) - { - for ( q = s2 ; *q ; q++ ) - { - if ( *p == *q ) { *p = '\0' ; p++ ; goto foundit ; } - } - } -foundit: - *tokpos = p ; - return( retval ) ; -} -#endif - -char * -make_lower( char * s1 ) -{ - char * p ; - int state ; - state = 0 ; - for ( p = s1 ; *p ; p++ ) - { - if ( state == 0 && *p == '"' ) state = 1 ; - else if ( state == 1 && *p == '"' ) state = 0 ; - if ( state == 0 ) - { - *p = tolower(*p) ; - } - } - return(s1) ; -} - -/* do not store the result of this routine */ -#define LENRING 500 -static char t[LENRING][NAMELEN] ; -static int tcurs = 0 ; -char * -make_lower_temp( const char * s1 ) -{ - const char * p; - char *q ; - int state ; - state = 0 ; - for ( p = s1, q = t[tcurs] ; *p ; p++, q++ ) - { - if ( state == 0 && *p == '"' ) state = 1 ; - else if ( state == 1 && *p == '"' ) state = 0 ; - *q = *p ; - if ( state == 0 ) - { - *q = tolower(*p) ; - } - } - *q = '\0' ; - q = t[tcurs] ; - tcurs = (tcurs+1)%LENRING ; - return(q) ; -} - - diff --git a/OpenFAST/modules/openfast-registry/src/protos.h b/OpenFAST/modules/openfast-registry/src/protos.h deleted file mode 100644 index 1c8e06c00..000000000 --- a/OpenFAST/modules/openfast-registry/src/protos.h +++ /dev/null @@ -1,189 +0,0 @@ -#ifndef PROTOS_H -#include "registry.h" -#include "data.h" - -void substitute( char * str , char * match , char * replace, char * result ); - -int init_dim_table() ; -char * make_lower( char * s1 ) ; -char * make_lower_temp( const char * s1 ) ; -int check_dimspecs(); -int init_parser(); -int is_a_fast_interface_type( char *str ); -int pre_parse( char * dir, FILE * infile, FILE * outfile, int usefrom_sw ); -int reg_parse( FILE * infile ) ; -int must_have_real_or_double( char *str ); -int set_dim_len ( char * dimspec , node_t * dim_entry ) ; -int set_dim_order ( char * dimorder , node_t * dim_entry ) ; -int set_dim_orient ( char * dimorient , node_t * dim_entry ) ; -int add_node_to_end ( node_t * node , node_t ** list ) ; -int add_node_to_beg ( node_t * node , node_t ** list ) ; -int add_node_to_end_4d ( node_t * node , node_t ** list ) ; -int init_type_table() ; -int set_state_type ( char * , node_t *, node_t *, node_t * ) ; -int set_state_dims ( char * dims , node_t * node ) ; -int set_ctrl ( char * ctrl , node_t * node ) ; -int gen_state_struct ( char * fname ) ; - -#if 1 -int show_node( node_t * p ) ; -int show_node1( node_t * p, int indent ) ; -void show_nodelist( node_t * p ) ; -void show_nodelist1( node_t * p , int indent ) ; -#endif - -void gen_c_module( FILE * fph, node_t * ModName ); - -int gen_state_struct ( char * fname ) ; -int gen_decls ( FILE * fp , node_t * node , int sw_ranges, int sw_point , int mask , int layer ) ; -int gen_state_subtypes ( char * fname ) ; -int gen_state_subtypes1 ( FILE * fp , node_t * node , int sw_ranges, int sw_point , int mask ) ; -int print_warning( FILE * fp , char * fname, char * comment ) ; -void close_the_file( FILE * fp, char * comment ) ; -int make_entries_uniq ( char * fname ) ; -int add_warning ( char * fname ) ; - -int init_modname_table(); -node_t * get_type_entry ( char * typename ) ; -node_t * get_modname_entry ( char * modname ) ; -node_t * get_rconfig_entry( char * name ) ; -node_t * get_entry ( char * name , node_t * node ) ; -node_t * get_entry_r ( char * name , char * use , node_t * node ) ; -node_t * get_dim_entry( char *s, int ) ; -node_t * new_node ( int kind ) ; - -node_t * get_4d_entry ( char * name ) ; -node_t * get_dimnode_for_coord ( node_t * node , int coord_axis ) ; -int get_index_for_coord ( node_t * node , int coord_axis ) ; - -char * my_strtok( char * s1 ) ; -char * strtok_rentr( char * s1 , char * s2, char ** tokpos ) ; - -char * bdy_indicator( int bdy ) ; -char * make_upper_case ( char * str ); -char * make_lower_case ( char * str ); - -char * field_name( char * tmp, node_t * p , int tag ) ; -char * field_name_bdy( char * tmp, node_t * p , int tag, int bdy ) ; -char * dimension_with_colons( char * pre, char * tmp, node_t * p, char * post) ; -char * dimension_with_ones( char * pre, char * tmp, node_t * p, char * post) ; -char * dimension_with_ranges( char * ref , char * pre, int bdy , char * tmp, node_t * p, char * post, char * nlstructname ) ; -char * arrray_size_expression( char * refarg , char * pre , int bdy , char * tmp , node_t * p , char * post , char * nlstructname ) ; -char * index_with_firstelem( char * pre , char * dref , int bdy , char * tmp , node_t * p , char * post ) ; - -char * declare_array_as_pointer( char * tmp, node_t * p ) ; -char * field_type( char * tmp , node_t * p ) ; - -/* For typedef history -ajb */ -int init_typedef_history() ; -int add_typedef_name ( char * name ) ; -int get_num_typedefs() ; -char * get_typedef_name ( char * name ) ; -char * get_typename_i(int i) ; - -int gen_alloc ( char * dirname ) ; -int gen_alloc1 ( char * dirname ) ; -int gen_alloc2 ( FILE * fp , char * structname , node_t * node, int *j, int *iguy, int *fraction, int numguys, int frac, int sw ); - -int gen_module_files ( char * dirname, char * prog_ver ); -int gen_module_state_description ( char * dirname ) ; -int gen_module_state_description1 ( FILE * fp , node_t * node ) ; - -void remove_nickname( const char *nickname, char *src, char *dst ); -void append_nickname( const char *nickname, char *src, char *dst ); -char * dimstr_c( int d ); -void checkOnlyReals( const char *q_mapsto, node_t * q); -void checkContainsMesh(node_t * q); - -int gen_scalar_indices ( char * dirname ) ; -int gen_scalar_indices1 ( FILE * fp, FILE ** fp2 ) ; - -int gen_actual_args ( char * dirname ) ; -int gen_dummy_args ( char * dirname ) ; -int gen_dummy_decls ( char * dn ) ; -int gen_args ( char * dirname , int sw ) ; -int gen_args1 ( FILE * fp , char * outstr, char * structname , node_t * node , int *linelen , int sw , int deep ) ; - -int gen_scalar_derefs ( char * dirname ) ; -int scalar_derefs ( char * dirname ) ; -int scalar_derefs1 ( FILE * fp , node_t * node, int direction ) ; - -int set_mark ( int val , node_t * lst ) ; -int set_mark_4d ( int val , node_t * lst ) ; - -int gen_i1_decls ( char * dn ) ; -int gen_get_nl_config ( char * dirname ) ; - -int gen_config_assigns ( char * dirname ) ; -int gen_config_reads ( char * dirname ) ; - -char * set_mem_order( node_t * node , char * str , int n ) ; - -int gen_wrf_io ( char * dirname ) ; -int set_dim_strs ( node_t *node , char ddim[3][2][NAMELEN], char mdim[3][2][NAMELEN], char pdim[3][2][NAMELEN] , char * prepend, int sw_allow_stagger ) ; -int set_dim_strs2 ( node_t *node , char ddim[3][2][NAMELEN], char mdim[3][2][NAMELEN], char pdim[3][2][NAMELEN] , char * prepend, int sw_disregard_stag ) ; -int set_dim_strs3 ( node_t *node , char ddim[3][2][NAMELEN], char mdim[3][2][NAMELEN], char pdim[3][2][NAMELEN] , char * prepend, int sw_disregard_stag ) ; -int gen_wrf_io2 ( FILE * fp , char * fname , char * structname , char * fourdname , node_t * node , int sw_io ) ; - -int gen_namelist_defines ( char * dirname , int sw_dimension ) ; -int gen_namelist_defaults ( char * dirname ) ; -int gen_namelist_script ( char * dirname ) ; - -int gen_model_data_ord ( char * dirname ) ; - -void get_elem ( char * structname , char * nlstructname , char * tx , int i , node_t * p , int first_last ) ; - -int associated_with_4d_array( node_t * p ) ; - - -/* PGI Addition to resolve non-prototype function warnings */ -char * array_size_expression ( char *, char *, int, char *, node_t *, char * ,char * ); -void range_of_dimension ( char *, char * , int, node_t *, char * ); -void dimension_size_expression ( char *, char *, int, node_t *, char *); -int gen_alloc_count ( char *); -int gen_alloc_count1 ( char *); -int gen_ddt_write ( char * ); -int gen_ddt_write1 ( FILE *, char *, node_t *); -int gen_dealloc ( char * ); -int gen_dealloc1 ( char * ); -int gen_dealloc2 ( FILE *, char *, node_t *); -int gen_scalar_tables ( FILE *); -int gen_scalar_tables_init ( FILE *); -int gen_scalar_indices_init ( FILE *); -int hash(char *); -int create_ht( char *** p ); -int gen_nest_interp1 ( FILE *, node_t *, char *, int, int ); -int gen_packs_halo ( FILE *fp , node_t *p, char *shw, int xy /* 0=y,1=x */ , int pu /* 0=pack,1=unpack */, char * packname, char * commname ); -int gen_packs ( FILE *fp , node_t *p, int shw, int xy /* 0=y,1=x */ , int pu /* 0=pack,1=unpack */, char * packname, char * commname ); -int gen_periods ( char * dirname , node_t * periods ); -int gen_swaps ( char * dirname , node_t * swaps ); -int gen_cycles ( char * dirname , node_t * cycles ); -int gen_xposes ( char * dirname ); -int gen_comm_descrips ( char * dirname ); -int gen_shift ( char * dirname ); -int gen_datacalls ( char * dirname ); -int gen_nest_packing ( char * dirname ); -int gen_nest_pack ( char * dirname ); -int gen_nest_unpack ( char * dirname ); -int gen_nest_packunpack ( FILE *fp , node_t * node , int dir, int down_path ); -int count_fields ( node_t * node , int * d2 , int * d3 , char * fourd_names, int down_path ); -int gen_debug ( char * dirname ); - -void reset_mask ( unsigned int * mask , int e ) ; -void set_mask ( unsigned int * mask , int e ) ; -int get_mask ( unsigned int * mask , int e ) ; - -char * fast_interface_type_shortname ( char * ) ; -char * std_case( char * ) ; - -char * dimstr( int ) ; - -char * C_type ( char * ) ; -char * c_types_binding( char *s ); -char * assoc_or_allocated( node_t * r ); -int is_pointer( node_t * r ); -int has_deferred_dim( node_t * node, int noisy ); - -#define PROTOS_H -#endif - diff --git a/OpenFAST/modules/openfast-registry/src/reg_parse.c b/OpenFAST/modules/openfast-registry/src/reg_parse.c deleted file mode 100644 index 37d457abc..000000000 --- a/OpenFAST/modules/openfast-registry/src/reg_parse.c +++ /dev/null @@ -1,756 +0,0 @@ -#include -#include -#include -#include -#ifdef _WIN32 -# define rindex(X,Y) strrchr(X,Y) -# define index(X,Y) strchr(X,Y) -#else -# include -#endif - -#include "registry.h" -#include "protos.h" -#include "data.h" -#include "sym.h" - -/* fields for state entries (note, these get converted to field entries in the - reg_parse routine; therefore, only TABLE needs to be looked at */ -#define TABLE 0 - -/* fields for field entries (TABLE="typedef" and, with some munging, TABLE="state") */ -#define FIELD_MODNAME 1 -#define FIELD_OF 2 -#define FIELD_TYPE 3 -#define FIELD_SYM 4 -#define FIELD_DIMS 5 -#define FIELD_INIVAL 6 -#define FIELD_CTRL 7 -#define FIELD_DESCRIP 8 -#define FIELD_UNITS 9 - -#define F_MODNAME 0 -#define F_OF 1 -#define F_TYPE 2 -#define F_SYM 3 -#define F_DIMS 4 -#define F_INIVAL 5 -#define F_CTRL 6 -#define F_DESCRIP 7 -#define F_UNITS 8 - -/* fields for dimension entries (TABLE="dimspec") */ -#define DIM_NAME 1 -//#define DIM_ORDER 2 -#define DIM_SPEC 2 - -#define INLN_SIZE 8000 -#define PARSELINE_SIZE 8000 - -int isNum( char c ) -{ - if ( c < '0' || c > '9' ) return 0; - return 1 ; -} - -int -pre_parse( char * dir, FILE * infile, FILE * outfile, int usefrom_sw ) -{ - /* Decreased size for SOA from 8192 to 8000--double check if necessary, Manish Shrivastava 2010 */ - char inln[INLN_SIZE], parseline[PARSELINE_SIZE], parseline_save[PARSELINE_SIZE] ; - char *p, *q, *p1, *p2 ; - char *tokens[MAXTOKENS] ; - int i, ifile ; - int ifdef_stack_ptr = 0 ; - int ifdef_stack[100] ; - int inquote, retval ; - int foundit ; - - ifdef_stack[0] = 1 ; - retval = 0 ; - - parseline[0] = '\0' ; - while ( fgets ( inln , INLN_SIZE , infile ) != NULL ) - { -/*** preprocessing directives ****/ - /* look for an include statement */ - if (( p = index( inln , '\n' )) != NULL ) *p = '\0' ; /* discard newlines */ - if (( p = index( inln , '\r' )) != NULL ) *p = '\0' ; /* discard carriage returns (happens on Windows)*/ - for ( p = inln ; ( *p == ' ' || *p == '\t' ) && *p != '\0' ; p++ ) ; - p1 = make_lower_temp(p) ; - if ( (!strncmp( p1 , "include", 7 ) || !strncmp( p1, "usefrom", 7 )) && ! ( ifdef_stack_ptr >= 0 && ! ifdef_stack[ifdef_stack_ptr] ) ) - { - FILE *include_fp ; - char include_file_name[NAMELEN] ; - char include_file_name_tmp[NAMELEN] ; - int checking_for_usefrom = !strncmp( p1, "usefrom", 7 ) ; -//fprintf(stderr,"checking_for_usefrom %d |%s|\n",checking_for_usefrom,p1) ; - - p += 7 ; for ( ; ( *p == ' ' || *p == '\t' ) && *p != '\0' ; p++ ) ; - if ( strlen( p ) > 127 ) { fprintf(stderr,"Registry warning: invalid include file name: %s\n", p ) ; } - else { -/* look in a few places for valid include files */ - foundit = 0 ; - - // See if it might be in the current directory - sprintf( include_file_name , "%s", p ) ; // first name in line from registry file, without the include or usefrom - for ( p2 = include_file_name ; !( *p2 == ' ' || *p2 == '\t' || *p2 == '\n' ) && *p2 != '\0' ; p2++ ) {} - *p2 = '\0' ; // drop tailing white space - if ( (q=index(include_file_name,'\n')) != NULL ) *q = '\0' ; - if (( include_fp = fopen( include_file_name , "r" )) != NULL ) { foundit = 1 ; goto gotit ; } - - // See if it might be in the directory specified (or whatever dir is). Don't remove spaces from the dir name though. - sprintf( include_file_name , "%s", p ) ; // first name in line from registry file, without the include or usefrom - for ( p2 = include_file_name ; !( *p2 == ' ' || *p2 == '\t' || *p2 == '\n' ) && *p2 != '\0' ; p2++ ) {} - *p2 = '\0' ; // drop tailing white space - sprintf( include_file_name , "%s/%s", dir, p ); // set the dir + file - if ( (q=index(include_file_name,'\n')) != NULL ) *q = '\0' ; - if (( include_fp = fopen( include_file_name , "r" )) != NULL ) { foundit = 1 ; goto gotit ; } - - // Check in the list of include dirs - for ( ifile = 0 ; ifile < nincldirs ; ifile++ ) { - sprintf( include_file_name_tmp , "%s", p ) ; // first name in line from registry file, without the include or usefrom - for ( p2 = include_file_name_tmp ; !( *p2 == ' ' || *p2 == '\t' || *p2 == '\n' ) && *p2 != '\0' ; p2++ ) {} - *p2 = '\0' ; // drop tailing white space - sprintf( include_file_name, "%s/%s", IncludeDirs[ifile] , include_file_name_tmp ) ; // dir specified with -I - if ( (q=index(include_file_name,'\n')) != NULL ) *q = '\0' ; - if (( include_fp = fopen( include_file_name , "r" )) != NULL ) { foundit = 1 ; goto gotit ; } - } - - // Cygwin specific -- assuming spaces in dir are ok. - for ( ifile = 0 ; ifile < nincldirs ; ifile++ ) { - int drive_specified = 0 ; - sprintf( include_file_name_tmp , "%s", p ) ; // first name in line from registry file, without the include or usefrom - for ( p2 = include_file_name_tmp ; !( *p2 == ' ' || *p2 == '\t' || *p2 == '\n' ) && *p2 != '\0' ; p2++ ) {} - *p2 = '\0' ; - sprintf( include_file_name , "%s/%s", IncludeDirs[ifile] , include_file_name_tmp ) ; // dir munged for cigwin - if ( include_file_name[0] == '/' ) { - char tmp[NAMELEN], tmp2[NAMELEN], *dr ; - strcpy( tmp2, include_file_name ) ; - if ( !strncmp( tmp2, "/cygdrive/", 10 )) { - strcpy(tmp,tmp2+11) ; // skip past /cygdrive/c - strcpy(tmp2,tmp) ; - drive_specified = 1 ; - } - for ( dr = "abcdefmy" ; *dr ; dr++ ) { - sprintf(tmp,"%c:%s%s",*dr,(drive_specified)?"":"/cygwin",tmp2) ; - strcpy( include_file_name, tmp ) ; - for ( p2 = include_file_name ; !( *p2 == ' ' || *p2 == '\t' || *p2 == '\n' ) && *p2 != '\0' ; p2++ ) {} - *p2 = '\0' ; - if ( (q=index(include_file_name,'\n')) != NULL ) *q = '\0' ; - if (( include_fp = fopen( include_file_name , "r" )) != NULL ) { foundit = 1 ; goto gotit ; } - } - } - } - -gotit: - if ( foundit ) { - fprintf(stderr,"opening %s %s\n",include_file_name, - (checking_for_usefrom || usefrom_sw)?"in usefrom mode":"" ) ; - parseline[0] = '\0' ; - pre_parse( dir , include_fp , outfile, ( checking_for_usefrom || usefrom_sw ) ) ; - parseline[0] = '\0' ; -// fprintf(stderr,"closing %s %s\n",include_file_name, -// (checking_for_usefrom || usefrom_sw)?"in usefrom mode":"" ) ; - fclose( include_fp ) ; - continue ; - } else { - if ( ! checking_for_usefrom ) { - fprintf(stderr,"Registry warning: cannot open %s . Ignoring.\n", include_file_name ) ; - } - } - } - } - else if ( !strncmp( make_lower_temp(p) , "ifdef", 5 ) ) { - char value[32] ; - p += 5 ; for ( ; ( *p == ' ' || *p == '\t' ) && *p != '\0' ; p++ ) ; - strncpy(value, p, 31 ) ; value[31] = '\0' ; - if ( (p=index(value,'\n')) != NULL ) *p = '\0' ; - if ( (p=index(value,' ')) != NULL ) *p = '\0' ; - if ( (p=index(value,'\t')) != NULL ) *p = '\0' ; - ifdef_stack_ptr++ ; - ifdef_stack[ifdef_stack_ptr] = ( sym_get(value) != NULL && ifdef_stack[ifdef_stack_ptr-1] ) ; - if ( ifdef_stack_ptr >= 100 ) { fprintf(stderr,"Registry fatal: too many nested ifdefs\n") ; exit(1) ; } - continue ; - } - else if ( !strncmp( make_lower_temp(p) , "ifndef", 6 ) ) { - char value[32] ; - p += 6 ; for ( ; ( *p == ' ' || *p == '\t') && *p != '\0' ; p++ ) ; - strncpy(value, p, 31 ) ; value[31] = '\0' ; - if ( (p=index(value,'\n')) != NULL ) *p = '\0' ; - if ( (p=index(value,' ')) != NULL ) *p = '\0' ; - if ( (p=index(value,'\t')) != NULL ) *p = '\0' ; - ifdef_stack_ptr++ ; - ifdef_stack[ifdef_stack_ptr] = ( sym_get(value) == NULL && ifdef_stack[ifdef_stack_ptr-1] ) ; - if ( ifdef_stack_ptr >= 100 ) { fprintf(stderr,"Registry fatal: too many nested ifdefs\n") ; exit(1) ; } - continue ; - } - else if ( !strncmp( make_lower_temp(p) , "endif", 5 ) ) { - ifdef_stack_ptr-- ; - if ( ifdef_stack_ptr < 0 ) { fprintf(stderr,"Registry fatal: unmatched endif\n") ; exit(1) ; } - continue ; - } - else if ( !strncmp( make_lower_temp(p) , "define", 6 ) ) { - char value[32] ; - p += 6 ; for ( ; ( *p == ' ' || *p == '\t') && *p != '\0' ; p++ ) ; - strncpy(value, p, 31 ) ; value[31] = '\0' ; - if ( (p=index(value,'\n')) != NULL ) *p = '\0' ; - if ( (p=index(value,' ')) != NULL ) *p = '\0' ; - if ( (p=index(value,'\t')) != NULL ) *p = '\0' ; - sym_add( value ) ; - continue ; - } - if ( ifdef_stack_ptr >= 0 && ! ifdef_stack[ifdef_stack_ptr] ) continue ; -/*** end of preprocessing directives ****/ -//fprintf(stderr,"parseline |%s|\n",parseline) ; -//fprintf(stderr,"inln |%s|\n",inln) ; - - strcat( parseline , inln ) ; - - /* allow \ to continue the end of a line */ - if (( p = index( parseline, '\\' )) != NULL ) - { - if ( *(p+1) == '\n' || *(p+1) == '\0' ) - { - *p = '\0' ; - continue ; /* go get another line */ - } - } -// make_lower( parseline ) ; - - if (( p = index( parseline , '\n' )) != NULL ) *p = '\0' ; /* discard newlines */ - - /* check line and zap any # characters that are in double quotes */ - - for ( p = parseline, inquote = 0 ; *p ; p++ ) { - if ( *p == '"' && inquote ) inquote = 0 ; - else if ( *p == '"' && !inquote ) inquote = 1 ; - else if ( *p == '#' && inquote ) *p = ' ' ; - else if ( *p == '#' && !inquote ) { *p = '\0' ; break ; } - } - if ( inquote ) { retval=1 ; fprintf(stderr,"Registry error: unbalanced quotes in line:\n%s\n",parseline) ;} - - for ( i = 0 ; i < MAXTOKENS ; i++ ) tokens[i] = NULL ; - i = 0 ; - - // get parsline_save, the value written to the output file... - //fprintf(stderr,"parseline_save |%s|\n",parseline_save) ; - //strcpy(parseline_save, parseline); - for (p = parseline; (*p == ' ' || *p == '\t') && *p != '\0'; p++); - strcpy(parseline_save, p); // get rid of leading spaces - - if (!strncmp(parseline_save, "typedef", 7)) - { - char tmp[PARSELINE_SIZE], *x; - strcpy(tmp, parseline_save); - x = strpbrk(tmp, " \t"); // find the first space or tab - if (usefrom_sw && x) { - sprintf(parseline_save, "usefrom %s", x); - } - } - - // parse tokens from parseline - if ((tokens[i] = my_strtok(parseline)) != NULL ) i++ ; - while (( tokens[i] = my_strtok(NULL) ) != NULL && i < MAXTOKENS ) i++ ; - if ( i <= 0 ) continue ; - - for ( i = 0 ; i < MAXTOKENS ; i++ ) - { - if ( tokens[i] == NULL ) tokens[i] = "-" ; - } - -/* remove quotes from quoted entries */ - for ( i = 0 ; i < MAXTOKENS ; i++ ) - { - char * pp ; - if ( tokens[i][0] == '"' ) tokens[i]++ ; - if ((pp=rindex( tokens[i], '"' )) != NULL ) *pp = '\0' ; - } - - - -//normal: - /* otherwise output the line as is */ - fprintf(outfile,"%s\n",parseline_save) ; - parseline[0] = '\0' ; /* reset parseline */ - parseline_save[0] = '\0' ; /* reset parseline_save */ - } - return(retval) ; -} - -int -reg_parse( FILE * infile ) -{ - /* Had to increase size for SOA from 4096 to 7000, Manish Shrivastava 2010 */ - char inln[INLN_SIZE], parseline[PARSELINE_SIZE] ; - char *p ; - char *tokens[MAXTOKENS],*ditto[MAXTOKENS] ; - int i ; - int defining_state_field, defining_rconfig_field, defining_i1_field ; - - parseline[0] = '\0' ; - - max_time_level = 1 ; - - for ( i = 0 ; i < MAXTOKENS ; i++ ) { ditto[i] = (char *)malloc(NAMELEN) ; strcpy(ditto[i],"-") ; } - -/* main parse loop over registry lines */ - while ( fgets ( inln , INLN_SIZE , infile ) != NULL ) - { - strcat( parseline , inln ) ; - /* allow \ to continue the end of a line */ - if (( p = index( parseline, '\\' )) != NULL ) - { - if ( *(p+1) == '\n' || *(p+1) == '\0' ) - { - *p = '\0' ; - continue ; /* go get another line */ - } - } - - //make_lower( parseline ) ; - if (( p = index( parseline , '#' )) != NULL ) *p = '\0' ; /* discard comments (dont worry about quotes for now) */ - if (( p = index( parseline , '\n' )) != NULL ) *p = '\0' ; /* discard newlines */ - if (( p = index( parseline , '\r' )) != NULL ) *p = '\0' ; /* discard carriage returns (happens on Windows)*/ - for ( i = 0 ; i < MAXTOKENS ; i++ ) tokens[i] = NULL ; - i = 0 ; - - if ((tokens[i] = my_strtok(parseline)) != NULL ) i++ ; - while (( tokens[i] = my_strtok(NULL) ) != NULL && i < MAXTOKENS ) i++ ; - if ( i <= 0 ) continue ; - - - for ( i = 0 ; i < MAXTOKENS ; i++ ) - { - if ( tokens[i] == NULL ) tokens[i] = "-" ; - if ( strcmp(tokens[i],"^") ) { // that is, if *not* ^ - strcpy(ditto[i],tokens[i]) ; - } else { // if is ^ - tokens[i] = ditto[i] ; - } - } - -/* remove quotes from quoted entries */ - for ( i = 0 ; i < MAXTOKENS ; i++ ) - { - char * pp ; - if ( tokens[i][0] == '"' ) tokens[i]++ ; - if ((pp=rindex( tokens[i], '"' )) != NULL ) *pp = '\0' ; - } - - defining_state_field = 0 ; - defining_rconfig_field = 0 ; - defining_i1_field = 0 ; - -/* typedef, usefrom, and param entries */ - if ( !strcmp( tokens[ TABLE ] , "typedef" ) - || !strcmp( tokens[ TABLE ] , "usefrom" ) - || !strcmp( tokens[ TABLE ] , "param" ) ) - { - node_t * param_struct ; - node_t * field_struct ; - node_t * type_struct ; - node_t * modname_struct ; - char tmpstr[NAMELEN], ddtname[NAMELEN] ; - -// FAST registry, construct a list of module nodes - strcpy(tmpstr, make_lower_temp(tokens[ FIELD_MODNAME ])) ; - if ( (p = index(tmpstr,'/')) != NULL ) *p = '\0' ; - modname_struct = get_modname_entry( tmpstr ) ; - if ( modname_struct == NULL ) - { - char *p ; - modname_struct = new_node( MODNAME ) ; - strcpy( modname_struct->name, tokens[FIELD_MODNAME] ) ; - // if a shortname is indicated after a slash, record that, otherwise use full name for both - if ( (p = index(modname_struct->name,'/')) != NULL ) { - *p = '\0' ; - strcpy( modname_struct->nickname, p+1 ) ; - } else { - strcpy( modname_struct->nickname, modname_struct->name ) ; - } - - modname_struct->module_ddt_list = NULL ; - modname_struct->next = NULL ; - add_node_to_end( modname_struct , &ModNames ) ; - } - if ( !strcmp( tokens[ TABLE ] , "usefrom" ) ) - { - modname_struct->usefrom = 1 ; - } - - if ( !strcmp( tokens[ TABLE ] , "param" ) ) { -// FAST registry, construct list of params specified for the Module - param_struct = new_node( PARAM ) ; - sprintf(param_struct->name,"%s",tokens[ FIELD_SYM ]) ; // name of parameter - if ( set_state_type( tokens[FIELD_TYPE], param_struct, Type, NULL ) ) // Only search type list, not ddts for module - { fprintf(stderr,"Registry warning: type %s used before defined for %s\n",tokens[FIELD_TYPE],tokens[FIELD_SYM] ) ; } - if ( set_state_dims( tokens[FIELD_DIMS], param_struct ) ) - { fprintf(stderr,"Registry warning: some problem with dimstring %s for %s\n", tokens[FIELD_DIMS],tokens[FIELD_SYM] ) ; } - param_struct->inival[0] = '\0' ; - if ( strcmp( tokens[FIELD_INIVAL], "-" ) ) /* that is, if not equal "-" */ - { strcpy( param_struct->inival , tokens[FIELD_INIVAL] ) ; } - strcpy(param_struct->descrip,"-") ; - if ( strcmp( tokens[FIELD_DESCRIP], "-" ) ) /* that is, if not equal "-" */ - { strcpy( param_struct->descrip , tokens[FIELD_DESCRIP] ) ; } - strcpy(param_struct->units,"-") ; - if ( strcmp( tokens[FIELD_UNITS], "-" ) ) /* that is, if not equal "-" */ - { strcpy( param_struct->units , tokens[FIELD_UNITS] ) ; } - - add_node_to_end( param_struct , &(modname_struct->params) ) ; - - } else { // not param - -// FAST registry, construct list of derived data types specified for the Module -// Only the FAST interface defined types should have the Module's nickname prepended - sprintf(ddtname,"%s",tokens[ FIELD_OF ]) ; - modname_struct->is_interface_type = 0 ; - if ( strcmp(modname_struct->nickname,"") ) { - if ( is_a_fast_interface_type(tokens[FIELD_OF] ) ) { - sprintf(ddtname,"%s_%s",modname_struct->nickname,tokens[ FIELD_OF ]) ; - modname_struct->is_interface_type = 1 ; - } - } - sprintf(tmpstr,"%s",make_lower_temp(ddtname)) ; - type_struct = get_entry( tmpstr, modname_struct->module_ddt_list ) ; - if ( type_struct == NULL && modname_struct->usefrom) - { - type_struct = get_entry( tmpstr, Type ) ; - } - - if ( type_struct == NULL ) - { - type_struct = new_node( TYPE ) ; - strcpy( type_struct->name, tmpstr ) ; - strcpy(type_struct->mapsto,ddtname) ; - type_struct->type_type = DERIVED ; - type_struct->next = NULL ; - type_struct->usefrom = modname_struct->usefrom ; - type_struct->module = modname_struct ; - add_node_to_end( type_struct,(type_struct->usefrom)? &Type : &(modname_struct->module_ddt_list ) ) ; - } - -// FAST registry, construct the list of fields in the derived types in the Module - field_struct = new_node( FIELD ) ; - strcpy( field_struct->name, tokens[FIELD_SYM] ) ; - if ( set_state_type( tokens[FIELD_TYPE], field_struct, Type, modname_struct->module_ddt_list ) ) - { fprintf(stderr,"Registry warning: type %s used before defined for %s\n",tokens[FIELD_TYPE],tokens[FIELD_SYM] ) ; } - if ( set_state_dims( tokens[FIELD_DIMS], field_struct ) ) - { fprintf(stderr,"Registry warning: some problem with dimstring %s for %s\n", tokens[FIELD_DIMS],tokens[FIELD_SYM] ) ; } - if ( set_ctrl( tokens[FIELD_CTRL], field_struct ) ) - { fprintf(stderr,"Registry warning: some problem with ctrl %s for %s\n", tokens[FIELD_CTRL],tokens[FIELD_SYM] ) ; } - - field_struct->inival[0] = '\0' ; - if ( strcmp( tokens[FIELD_INIVAL], "-" ) ) /* that is, if not equal "-" */ - { strcpy( field_struct->inival , tokens[FIELD_INIVAL] ) ; } - strcpy(field_struct->descrip,"-") ; - if ( strcmp( tokens[FIELD_DESCRIP], "-" ) ) /* that is, if not equal "-" */ - { strcpy( field_struct->descrip , tokens[FIELD_DESCRIP] ) ; } - strcpy(field_struct->units,"-") ; - if ( strcmp( tokens[FIELD_UNITS], "-" ) ) /* that is, if not equal "-" */ - { strcpy( field_struct->units , tokens[FIELD_UNITS] ) ; } -#ifdef OVERSTRICT - if ( field_struct->type != NULL ) - if ( field_struct->type->type_type == DERIVED && field_struct->ndims > 0 ) - { fprintf(stderr,"Registry warning: type item %s of type %s can not be multi-dimensional ", - tokens[FIELD_SYM], tokens[FIELD_TYPE] ) ; } -#endif - field_struct->usefrom = type_struct->usefrom ; - - add_node_to_end( field_struct , &(type_struct->fields) ) ; - } // not param - - } - -/* dimspec entry */ - else if ( !strcmp( tokens[ TABLE ] , "dimspec" ) ) - { - node_t * dim_struct ; - dim_struct = new_node( DIM ) ; - if ( get_dim_entry ( tokens[DIM_NAME], 0 ) != NULL ) - { fprintf(stderr,"Registry warning: dimspec (%s) already defined\n",tokens[DIM_NAME] ) ; } - strcpy(dim_struct->dim_name,tokens[DIM_NAME]) ; - if ( set_dim_len( tokens[DIM_SPEC], dim_struct ) ) - { fprintf(stderr,"Registry warning: problem with dimspec (%s)\n",tokens[DIM_SPEC] ) ; } - - add_node_to_end( dim_struct , &Dim ) ; - } - - parseline[0] = '\0' ; /* reset parseline */ - } - -/* Domain is a type node with fields that are not part of any type. WRF "state" entries - were these. They were simply fields of the data type for a domain (as opposed to - fields within derived data types that were fields in a domain). The FAST registry - does not have the concept of a Domain. Leave the following assignment here but - put a test around it so we do not segfault if there aren't any "state" entries. */ - if ( get_type_entry( "domain" ) ) { - Domain = *(get_type_entry( "domain" )) ; - } - - return(0) ; - -} - -node_t * -get_dim_entry( char *s, int sw ) // sw = 1 is used when checking an inline dimspec -{ - node_t * p ; - for ( p = Dim ; p != NULL ; p = p->next ) - { - if ( !strcmp(p->dim_name, s ) ) { - return( p ) ; - } - } - /* not found, check if dimension is specified in line */ - if ( 1 && sw ) { - node_t * dim_struct ; - dim_struct = new_node( DIM ) ; - strcpy(dim_struct->dim_name,s) ; -// strncpy(dim_struct->dim_name,s,1) ; - if ( set_dim_len( s, dim_struct ) ) - { - fprintf(stderr,"Registry warning: get_dim_entry: problem with dimspec (%s)\n",s ) ; - } - else - { - add_node_to_end( dim_struct , &Dim ) ; - return( dim_struct ) ; - } - } - return(NULL) ; -} - -int -set_state_type( char * typename, node_t * state_entry, node_t * typelist, node_t * ddtlist ) -{ - node_t *p ; - int retval ; - - if ( typename == NULL ) return(1) ; - retval = 0 ; - if ( ( state_entry->type = get_entry( make_lower_temp(typename), ddtlist )) == NULL ) { - if ( ( state_entry->type = get_entry( make_lower_temp(typename), typelist )) == NULL ) { - if ( !strncmp(make_lower_temp(typename),"character",9) ) - { - p = new_node( TYPE ) ; - strcpy( p->name, make_lower_temp(typename) ) ; - strcpy( p->mapsto, typename ) ; - add_node_to_end( p , &(state_entry->type) ) ; - } else { - retval = 1 ; - } - } - } - return(retval) ; -} - -int -set_dim_len ( char * dimspec , node_t * dim_entry ) -{ - dim_entry->deferred = 0 ; - if (!strcmp( dimspec , "standard_domain" )) - { dim_entry->len_defined_how = DOMAIN_STANDARD ; } - else if (!strncmp( dimspec, "constant=" , 9 ) || isNum(dimspec[0]) || dimspec[0] == ':' || dimspec[0] == '(' ) - { - char *p, *colon, *paren ; - p = (isNum(dimspec[0])||dimspec[0]==':'||dimspec[0]=='(')?dimspec:&(dimspec[9]) ; - /* check for colon */ - if (( colon = index(p,':')) != NULL ) - { - *colon = '\0' ; - if (( paren = index(p,'(')) !=NULL ) - { - dim_entry->coord_start = atoi(paren+1) ; - } - else if ( isNum(*p) ) { - dim_entry->coord_start = atoi(p) ; - } - else - { - dim_entry->deferred = 1 ; - } - dim_entry->coord_end = atoi(colon+1) ; - } - else - { - dim_entry->coord_start = 1 ; - dim_entry->coord_end = atoi(p) ; - } - dim_entry->len_defined_how = CONSTANT ; - } - else if (!strncmp( dimspec, "namelist=", 9 )) - { - char *p, *colon ; - - p = &(dimspec[9]) ; - /* check for colon */ - if (( colon = index(p,':')) != NULL ) - { - *colon = '\0' ; - strcpy( dim_entry->assoc_nl_var_s, p ) ; - strcpy( dim_entry->assoc_nl_var_e, colon+1 ) ; - } - else - { - strcpy( dim_entry->assoc_nl_var_s, "1" ) ; - strcpy( dim_entry->assoc_nl_var_e, p ) ; - } - dim_entry->len_defined_how = NAMELIST ; - } - else /* if (param_dim != NULL) */ { - dim_entry->coord_start = 1; - dim_entry->len_defined_how = CONSTANT; - strcpy(dim_entry->dim_param_name, dimspec); - dim_entry->dim_param = 1; - } -/* else - { - return(1) ; - } -*/ - return(0) ; -} - -int -set_ctrl( char *ctrl , node_t * field_struct ) -// process CTRL keys -- only '2pi' (interpolation of values with 2pi period). Default is no special interpolation. -{ - char tmp[NAMELEN] ; - char *p ; - strcpy(tmp,ctrl) ; - if (( p = index(tmp,'=') ) != NULL ) { *p = '\0' ; } - if (!strcmp(make_lower_temp(tmp), "2pi")) { - field_struct->gen_periodic = PERIOD_2PI; - } - else { - field_struct->gen_periodic = PERIOD_NONE; - } - - return(0) ; -} - - -/* integrity checking of dimension list */ -int -check_dimspecs() -{ - return(0) ; -} - -int -init_parser() -{ - return(0) ; -} - -int -is_a_fast_interface_type( char *str ) -{ - int retval ; - - retval = ( - !strcmp(make_lower_temp(str), "initinputtype") || - !strcmp(make_lower_temp(str), "initoutputtype") || - !strcmp(make_lower_temp(str), "inputtype") || - !strcmp(make_lower_temp(str), "outputtype") || - !strcmp(make_lower_temp(str), "continuousstatetype") || - !strcmp(make_lower_temp(str), "discretestatetype") || - !strcmp(make_lower_temp(str), "constraintstatetype") || - !strcmp(make_lower_temp(str), "otherstatetype") || - !strcmp(make_lower_temp(str), "parametertype") || - !strcmp(make_lower_temp(str), "miscvartype") || - !strcmp(make_lower_temp(str), "partialoutputpinputtype") || - !strcmp(make_lower_temp(str), "partialcontstatepinputtype") || - !strcmp(make_lower_temp(str), "partialdiscstatepinputtype") || - !strcmp(make_lower_temp(str), "partialconstrstatepinputtype") || - 0 ) ; - - return(retval) ; -} - -int -must_have_real_or_double( char *str ) -{ - int retval ; - - retval = ( - !strcmp(make_lower_temp(str), "inputtype") || - !strcmp(make_lower_temp(str), "outputtype") || - !strcmp(make_lower_temp(str), "continuousstatetype") || - !strcmp(make_lower_temp(str), "discretestatetype") || - !strcmp(make_lower_temp(str), "constraintstatetype") || - !strcmp(make_lower_temp(str), "partialoutputpinputtype") || - !strcmp(make_lower_temp(str), "partialcontstatepinputtype") || - !strcmp(make_lower_temp(str), "partialdiscstatepinputtype") || - !strcmp(make_lower_temp(str), "partialconstrstatepinputtype") || - 0 ) ; - - return(retval) ; -} - -char * -fast_interface_type_shortname( char *str ) -{ - char * retval, *str2; - str2 = make_lower_temp(str); - - if ( !strcmp(str2, "initinputtype") ) { - retval = "InitInput" ; - } else if ( !strcmp(str2, "initoutputtype") ) { - retval = "InitOutput" ; - } else if ( !strcmp(str2, "inputtype") ) { - retval = "Input" ; - } else if ( !strcmp(str2, "outputtype") ) { - retval = "Output" ; - } else if ( !strcmp(str2, "continuousstatetype") ) { - retval = "ContState" ; - } else if ( !strcmp(str2, "discretestatetype") ) { - retval = "DiscState" ; - } else if ( !strcmp(str2, "constraintstatetype") ) { - retval = "ConstrState" ; - } else if ( !strcmp(str2, "otherstatetype") ) { - retval = "OtherState" ; - } else if ( !strcmp(str2, "miscvartype") ) { - retval = "Misc"; - } else if ( !strcmp(str2, "parametertype") ) { - retval = "Param" ; - } else if ( !strcmp(str2, "partialoutputpinputtype") ) { - retval = "dYdu" ; - } else if ( !strcmp(str2, "partialcontstatepinputtype") ) { - retval = "dXdu" ; - } else if ( !strcmp(str2, "partialdiscstatepinputtype") ) { - retval = "dXddu" ; - } else if ( !strcmp(str2, "partialconstrstatepinputtype") ) { - retval = "dZdu" ; - } - else{ - retval = str; - } - - - return(retval) ; -} - -char * -std_case( char *str ) // returns the name in CamelBack case or just the name itself -{ - if ( !strcmp(make_lower_temp(str), "initinputtype")) {return("InitInputType");} - else if ( !strcmp(make_lower_temp(str), "initoutputtype")) {return("InitOutputType");} - else if ( !strcmp(make_lower_temp(str), "inputtype")) {return("InputType");} - else if ( !strcmp(make_lower_temp(str), "outputtype")) {return("OutputType");} - else if ( !strcmp(make_lower_temp(str), "continuousstatetype")) {return("ContinuousStateType");} - else if ( !strcmp(make_lower_temp(str), "discretestatetype")) {return("DiscreteStateType");} - else if ( !strcmp(make_lower_temp(str), "constraintstatetype")) {return("ConstraintStateType");} - else if ( !strcmp(make_lower_temp(str), "otherstatetype")) {return("OtherStateType");} - else if ( !strcmp(make_lower_temp(str), "miscvartype")) {return("MiscVarType"); } - else if ( !strcmp(make_lower_temp(str), "parametertype")) {return("ParameterType"); } - else if ( !strcmp(make_lower_temp(str), "partialoutputpinputtype")) {return("PartialOutputPInputType");} - else if ( !strcmp(make_lower_temp(str), "partialcontstatepinputtype")) {return("PartialConstStatePInputType");} - else if ( !strcmp(make_lower_temp(str), "partialdiscstatepinputtype")) {return("PartialDiscStatePInputType");} - else if ( !strcmp(make_lower_temp(str), "partialconstrstatepinputtype")) {return("PartialConstrStatePInputType");} - else {return(str);} - // shouldn't happen - return("") ; -} - diff --git a/OpenFAST/modules/openfast-registry/src/registry.c b/OpenFAST/modules/openfast-registry/src/registry.c deleted file mode 100644 index 2fe9dc566..000000000 --- a/OpenFAST/modules/openfast-registry/src/registry.c +++ /dev/null @@ -1,311 +0,0 @@ -#include -#include -#include -#ifdef _WIN32 -# include -# define rindex(X,Y) strrchr(X,Y) -# define index(X,Y) strchr(X,Y) -# include -# define getpid _getpid -#else -# include -# include -# include -# include -#endif - -#define DEFINE_GLOBALS -#include "protos.h" -#include "registry.h" -#include "data.h" -#include "sym.h" - -void output_template( char * sw_modname_subst, char * sw_modnickname_subst, int force, int sw ); -int matches( char * str , char * match ); - -int -main( int argc, char *argv[], char *env[] ) -{ - char fname_in[NAMELEN], dir[NAMELEN], fname_tmp[NAMELEN], command[NAMELEN] ; - FILE * fp_in, *fp_tmp ; - char * thisprog ; - char * thisprog_ver; - int mypid ; - int wrote_template ; - int sw_keep = 0 ; -#ifndef _WIN32 - struct rlimit rlim ; -#endif - - mypid = (int) getpid() ; - strcpy( thiscom, argv[0] ) ; - argv++ ; - - sw_output_template_force = 0 ; - sw_norealloc_lsh = 1 ; - sw_ccode = 0 ; - sw_noextrap = 0 ; - sw_shownodes = 0 ; - strcpy( fname_in , "" ) ; - -#ifndef _WIN32 - rlim.rlim_cur = RLIM_INFINITY ; - rlim.rlim_max = RLIM_INFINITY ; - setrlimit ( RLIMIT_STACK , &rlim ) ; -#endif - - thisprog_ver = "FAST Registry"; - - fprintf(stderr,"\n") ; - fprintf(stderr,"----- %s --------------\n", thisprog_ver) ; - fprintf(stderr,"----------------------------------------------------------\n") ; - - sym_forget() ; - //thisprog = *argv ; - // strcpy(thisprog, thiscom); - thisprog = "registry.exe"; - strcpy(fname_in, ""); - strcpy(OutDir, "."); // if no OutDir is listed, use current directory - wrote_template = 0; - - - while (*argv) { - - if (!strncmp(*argv,"-D",2)) { - char * p ; - p = *argv ; - sym_add(p+2) ; - } else if (!strncmp(*argv,"/D=",3)) { - char * p ; - p = *argv ; - sym_add(p+3) ; - } else if (!strcmp(*argv,"-force") || !strcmp(*argv,"/force") ) { - sw_output_template_force = 1 ; - } else if (!strcmp(*argv,"-O") || !strcmp(*argv,"/O") ) { - argv++ ; if ( *argv ) { strcpy( OutDir, *argv ) ; } - } else if (!strcmp(*argv,"-I") || !strcmp(*argv,"/I") ) { - argv++ ; if ( *argv ) { if( nincldirs < MAXINCLDIRS ) { strcpy( IncludeDirs[nincldirs++], *argv ) ; } } - } else if (!strcmp(*argv, "-ccode") || !strcmp(*argv, "/ccode")) { - sw_ccode = 1 ; - } else if (!strcmp(*argv, "-noextrap") || !strcmp(*argv, "/noextrap")) { - sw_noextrap = 1; - } else if (!strncmp(*argv, "-shownodes", 4) || !strncmp(*argv, "/shownodes", 4)) { - sw_shownodes = 1 ; - } else if (!strcmp(*argv,"-template") || !strcmp(*argv,"-registry") || - !strcmp(*argv,"/template") || !strcmp(*argv,"/registry") ) { - char * arg ; - arg = *argv ; - argv++ ; if ( *argv ) { strcpy( sw_modname_subst, *argv ) ; } else { goto usage ; } - argv++ ; if ( *argv ) { strcpy( sw_modnickname_subst, *argv ) ; } else { goto usage ; } - if (!strcmp(arg+1,"template")) output_template(sw_modname_subst,sw_modnickname_subst,sw_output_template_force,0) ; - if (!strcmp(arg+1,"registry")) output_template(sw_modname_subst,sw_modnickname_subst,sw_output_template_force,1) ; - wrote_template = 1 ; - } else if (!strcmp(*argv,"-h") || !strcmp(*argv,"/h")) { -usage: -// fprintf(stderr,"Usage: %s [options] registryfile -or- \n",thisprog) ; - fprintf(stderr, "Usage: %s registryfile [options] -or- \n",thiscom) ; - fprintf(stderr, " [-force] [-template|-registry] ModuleName ModName \n") ; - fprintf(stderr, "Options:\n"); - fprintf(stderr, " -h this summary\n"); - fprintf(stderr, " -I look for usefrom files in directory \"dir\"\n"); - fprintf(stderr, " -O generate types files in directory \"dir\"\n"); - fprintf(stderr, " -noextrap do not generate ModName_Input_ExtrapInterp or ModName_Output_ExtrapInterp routines\n"); - fprintf(stderr, " -D define symbol for conditional evaluation inside registry file\n"); - fprintf(stderr, " -ccode generate additional code for interfacing with C/C++\n") ; - fprintf(stderr, " -keep do not delete temporary files from registry program\n") ; - fprintf(stderr, " -shownodes output a listing of the nodes in registry's AST\n") ; - fprintf(stderr, " === alternate usage for generating templates ===\n") ; - fprintf(stderr, " -template ModuleName ModName\n") ; - fprintf(stderr, " Generate a template Module file none exists\n") ; - fprintf(stderr, " -registry ModuleName ModName\n") ; - fprintf(stderr, " Generate a template registry file if none exists\n") ; - fprintf(stderr, " -force Force generating of template or registry file\n") ; - fprintf(stderr, " (the / character can be used in place of - when specifying options)\n") ; - exit(1) ; - } else if (!strcmp(*argv,"-keep") || !strcmp(*argv,"/keep") ) { - sw_keep = 1 ; - } - else { /* consider it an input file */ - strcpy( fname_in , *argv ) ; - } - argv++ ; - } - if ( wrote_template ) exit(0) ; - - if ( !strcmp(fname_in,"") ) goto usage ; - -#ifdef FUTURE - gen_io_boilerplate() ; /* 20091213 jm. Generate the io_boilerplate_temporary.inc file */ -#endif - - fprintf(stderr,"input file: %s\n",fname_in); - - init_parser() ; - init_type_table() ; - init_dim_table() ; - init_modname_table() ; - - if ( !strcmp(fname_in,"") ) fp_in = stdin ; - else - if (( fp_in = fopen( fname_in , "r" )) == NULL ) - { - fprintf(stderr,"Registry program cannot open %s for reading. Ending.\n", fname_in ) ; - exit(2) ; - } - - sprintf( fname_tmp , "Registry_tmp.%d",mypid) ; - if (( fp_tmp = fopen( fname_tmp , "w" )) == NULL ) - { - fprintf(stderr,"Registry program cannot open temporary %s for writing. Ending.\n", fname_tmp ) ; - exit(2) ; - } - - { char *e ; - strcpy( dir , fname_in ) ; - if ( ( e = rindex ( dir , '/' ) ) != NULL ) { *e = '\0' ; } else { strcpy( dir, "." ) ; } - } - if ( pre_parse( dir, fp_in, fp_tmp, 0 ) ) { - fprintf(stderr,"Problem with Registry File %s\n", fname_in ) ; - goto cleanup ; - } - sym_forget() ; - - fclose(fp_in) ; - fclose(fp_tmp) ; - - if (( fp_tmp = fopen( fname_tmp , "r" )) == NULL ) - { - fprintf(stderr,"Registry program cannot open %s for reading. Ending.\n", fname_tmp ) ; - goto cleanup ; - } - - reg_parse(fp_tmp) ; - - fclose(fp_tmp) ; - - check_dimspecs() ; - - if (sw_shownodes) { - fprintf(stderr,"--- ModNames ---\n") ; - show_nodelist(ModNames) ; - fprintf(stderr,"--- Done ---\n") ; - } - - gen_module_files( OutDir, thisprog_ver); - -cleanup: - if ( ! sw_keep ) { -#ifdef _WIN32 - sprintf(command,"del /F /Q %s\n",fname_tmp ); -#else - sprintf(command,"/bin/rm -f %s\n",fname_tmp ); -#endif - system( command ) ; - } - - exit( 0 ) ; - -} -#include "Template_data.c" -#include "Template_registry.c" - -void -output_template( char * sw_modname_subst, char * sw_modnickname_subst, int force, int sw ) // sw = 0, template; 1 = registry -{ - char ** p ; - FILE *fp ; - char fname[NAMELEN] ; - char tmp1[2096], tmp2[2096], tmp3[2096] ; - if ( sw == 0 ) { sprintf(fname,"%s.f90",sw_modname_subst) ; } - else { sprintf(fname,"%s_Registry.txt",sw_modname_subst) ; } - - if ( ! force ) { // check if file exists by trying to open file for reading. If the read is successful, exit program: - if ( (fp = fopen( fname,"r" )) != NULL ) { - fprintf(stderr,"Registry exiting. Attempt to overwrite file (%s) . Move out of the way or specify -force before -template option. \n", fname) ; - exit(1) ; - } - } - - if ( (fp = fopen( fname,"w" )) == NULL ) { - fprintf(stderr,"Registry exiting. Failure opening %s.\n", fname ) ; - exit(1) ; - } - if ( sw == 0 ) { - for ( p = template_data ; *p ; p++ ) { - strcpy(tmp1,*p) ; - substitute(tmp1,"ModuleName",sw_modname_subst,tmp2) ; - substitute(tmp2,"ModName",sw_modnickname_subst,tmp3) ; - fprintf(fp,"%s\n",tmp3) ; - } - } else { - for ( p = template_registry ; *p ; p++ ) { - strcpy(tmp1,*p) ; - substitute(tmp1,"ModuleName",sw_modname_subst,tmp2) ; - substitute(tmp2,"ModName",sw_modnickname_subst,tmp3) ; - fprintf(fp,"%s\n",tmp3) ; - } - } - fclose(fp) ; -} - - - -// would use regex for this but it does not seem to be uniformly or universally supported - -void -substitute( char * str , char * match , char * replace, char * result ) -{ - char * p, *q ; - char allup[NAMELEN], alllo[NAMELEN] ; - size_t n, m ; - int nmatch = 0 ; - - n = strlen( replace ) ; - m = strlen( match ) ; - strcpy(allup,replace) ; make_upper_case(allup) ; - strcpy(alllo,replace) ; make_lower_case(alllo) ; -// watch for #defines, in which case first sub should be all upper, next all lower - if ( str[0] == '#' ) { - for ( p = str ; *p ; p++ ) { - if ( matches( p, "define" ) ) nmatch = 2 ; - } - } - - for ( p = str , q = result ; *p ; ) - { - if ( matches( p, match ) ) - { - if ( nmatch == 2 ) { - strncpy( q, replace, n ) ; - nmatch-- ; - } else if ( nmatch == 1 ) { - strncpy( q, alllo, n ) ; - nmatch-- ; - } else { - strncpy( q, replace, n ) ; - } - q += n ; - p += m ; - } else { - *q = *p ; - p++ ; - q++ ; - } - } - *q = '\0' ; - strcpy( str, result ) ; -} - -int -matches( char * str , char * match ) // both must be null terminated -{ - char * p, * q ; - int n ; - - for ( n = 0, p = str, q = match ; (*p && *q) ; p++, q++, n++ ) - { - if ( *p != *q ) return(0) ; - } - if ( n != strlen(match) ) return(0) ; - return(1) ; -} diff --git a/OpenFAST/modules/openfast-registry/src/registry.h b/OpenFAST/modules/openfast-registry/src/registry.h deleted file mode 100644 index 524bbe7e1..000000000 --- a/OpenFAST/modules/openfast-registry/src/registry.h +++ /dev/null @@ -1,63 +0,0 @@ -#ifndef REGISTRY_H -#define NAMELEN 512 -#define NAMELEN_LONG 12500 /*changed from 8192 to 12500 by PNNL on 12/22/2010*/ -#define MAXDIMS 21 -#define MAX_DYNCORES 50 /* ha ha, just kidding */ -/* #define MAX_ARGLINE 175 WRF uses 128 by default, but the nested chem version hit the continuation line limit for efc so it had to be increased, wig 14-Oct-2004 */ -#define MAX_ARGLINE 128 /* welp, 175 means lines longer than 130 chars, which is a Fortran no no */ -#define MAX_TYPEDEFS 50 /* typedef history -ajb */ -#define MAXTOKENS 100 - -/* defines of system commands */ -#define UNIQSORT "/bin/sort -u" -#define CATCOMM "/bin/cat" -#define RMCOMM "/bin/rm" -#define MVCOMM "/bin/mv" - -#define DRIVER_LAYER 100 -#define MEDIATION_LAYER 200 - -enum coord_axis { COORD_X , COORD_Y , COORD_Z , COORD_C } ; -enum len_defined_how { DOMAIN_STANDARD , NAMELIST , CONSTANT } ; -enum type_type { SIMPLE , DERIVED } ; -enum proc_orient { ALL_Z_ON_PROC , ALL_X_ON_PROC , ALL_Y_ON_PROC } ; - -/* wrapping options */ -#define PERIOD_2PI 2 -#define PERIOD_OTHER 1 -#define PERIOD_NONE 0 - - -/* node_kind mask settings */ -#define FIELD 1 -#define PARAM 2 -#define RCONFIG 4 -#define FOURD 8 -#define MEMBER 16 -#define TYPE 32 -#define DIM 64 -#define MODNAME 128 -#define HALO 256 -#define PERIOD 512 -#define SWAP 1024 -#define CYCLE 2048 -#define XPOSE 4096 -#define FOURD1 8192 -#define BDYONLY 16384 - -#define RESTART 0x02000000 /* 25 */ -#define BOUNDARY 0x04000000 /* 26 */ -#define INTERP_DOWN 0x08000000 /* 27 */ -#define FORCE_DOWN 0x10000000 /* 28 */ -#define INTERP_UP 0x20000000 /* 29 */ -#define SMOOTH_UP 0x40000000 /* 20 */ -#define METADATA 0x80000000 /* 31 */ - - -#define REGISTRY_H -#endif - -#ifdef WIN32 -#define snprintf _snprintf -#endif - diff --git a/OpenFAST/modules/openfast-registry/src/sym.c b/OpenFAST/modules/openfast-registry/src/sym.c deleted file mode 100644 index 689f5800b..000000000 --- a/OpenFAST/modules/openfast-registry/src/sym.c +++ /dev/null @@ -1,163 +0,0 @@ -/*********************************************************************** - - COPYRIGHT - - The following is a notice of limited availability of the code and - Government license and disclaimer which must be included in the - prologue of the code and in all source listings of the code. - - Copyright notice - (c) 1977 University of Chicago - - Permission is hereby granted to use, reproduce, prepare - derivative works, and to redistribute to others at no charge. If - you distribute a copy or copies of the Software, or you modify a - copy or copies of the Software or any portion of it, thus forming - a work based on the Software and make and/or distribute copies of - such work, you must meet the following conditions: - - a) If you make a copy of the Software (modified or verbatim) - it must include the copyright notice and Government - license and disclaimer. - - b) You must cause the modified Software to carry prominent - notices stating that you changed specified portions of - the Software. - - This software was authored by: - - Argonne National Laboratory - J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov - Mathematics and Computer Science Division - Argonne National Laboratory, Argonne, IL 60439 - - ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES - OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, - AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A - CONTRACT WITH THE DEPARTMENT OF ENERGY. - - GOVERNMENT LICENSE AND DISCLAIMER - - This computer code material was prepared, in part, as an account - of work sponsored by an agency of the United States Government. - The Government is granted for itself and others acting on its - behalf a paid-up, nonexclusive, irrevocable worldwide license in - this data to reproduce, prepare derivative works, distribute - copies to the public, perform publicly and display publicly, and - to permit others to do so. NEITHER THE UNITED STATES GOVERNMENT - NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF - THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR - ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, - COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, - PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD - NOT INFRINGE PRIVATELY OWNED RIGHTS. - -***************************************************************************/ -/* sym.c - - Implementation dependent routines for using symtab_gen.c - in N32 . - -*/ - -#include -#include -#include "sym.h" -#include "protos.h" - -extern sym_nodeptr symget() ; - -static char ** symtab ; /* 2-19-90 */ - -int -sym_init() /* 2-19-90, initialize symbol table package */ -{ - create_ht( &symtab ) ; - if (symtab == NULL) - { - fprintf(stderr,"init_sym(): could not create hash table") ; - exit(1) ; - } - return(0) ; -} - -sym_nodeptr -sym_add( name ) -char * name ; -{ - sym_nodeptr new_sym_node(); - char **node_name() ; - sym_nodeptr *node_next() ; - return( symget( name, new_sym_node, node_name, node_next, symtab, 1 ) ) ; -} - -sym_nodeptr -sym_get( name ) -char * name ; -{ - sym_nodeptr new_sym_node(); - char **node_name() ; - sym_nodeptr *node_next() ; - return( symget( name, new_sym_node, node_name, node_next, symtab, 0 ) ) ; -} - -sym_nodeptr -new_sym_node() -{ - void * malloc() ; - sym_nodeptr p ; - p = (sym_nodeptr) malloc( sizeof( struct sym_node ) ) ; - p->name = NULL ; - p->next = NULL ; - - return( p ) ; -} - -char ** -node_name(p) -sym_nodeptr p ; -{ - char ** x ; - x = &(p->name) ; - return( x ) ; -} - -sym_nodeptr * -node_next(p) -sym_nodeptr p ; -{ - sym_nodeptr *x ; - x = &(p->next) ; - return( x ) ; -} - -int -show_entry(x) -sym_nodeptr x ; -{ - int i ; - if ( x == NULL ) return(0) ; - printf("Symbol table entry:\n") ; - printf("lexeme %s\n", x->name ) ; - printf(" dim %s\n", (x->dim==1?"M":(x->dim==2?"N":"O")) ) ; - printf(" ndims %d\n", x->ndims ) ; - for ( i = 0 ; i < x->ndims && i < 7 ; i++ ) - printf(" dim %d -> %s\n",i,(x->dims[i]==1?"M":(x->dims[i]==2?"N":"O")) ) ; - return(0) ; -} - -/* MEMORY LEAK !!!! -- this just abandons the old table and leaves on the heap. */ -/* The registry mechanism is not a long-running program and is not apt to - run into memory problems. Might want to fix this anyway, though, someday. */ -int -sym_forget() -{ - create_ht( &symtab ) ; - if (symtab == NULL) - { - fprintf(stderr,"init_sym(): could not create hash table") ; - exit(1) ; - } - return(0) ; -} - diff --git a/OpenFAST/modules/openfast-registry/src/sym.h b/OpenFAST/modules/openfast-registry/src/sym.h deleted file mode 100644 index 71de45686..000000000 --- a/OpenFAST/modules/openfast-registry/src/sym.h +++ /dev/null @@ -1,97 +0,0 @@ -/*********************************************************************** - - COPYRIGHT - - The following is a notice of limited availability of the code and - Government license and disclaimer which must be included in the - prologue of the code and in all source listings of the code. - - Copyright notice - (c) 1977 University of Chicago - - Permission is hereby granted to use, reproduce, prepare - derivative works, and to redistribute to others at no charge. If - you distribute a copy or copies of the Software, or you modify a - copy or copies of the Software or any portion of it, thus forming - a work based on the Software and make and/or distribute copies of - such work, you must meet the following conditions: - - a) If you make a copy of the Software (modified or verbatim) - it must include the copyright notice and Government - license and disclaimer. - - b) You must cause the modified Software to carry prominent - notices stating that you changed specified portions of - the Software. - - This software was authored by: - - Argonne National Laboratory - J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov - Mathematics and Computer Science Division - Argonne National Laboratory, Argonne, IL 60439 - - ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES - OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, - AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A - CONTRACT WITH THE DEPARTMENT OF ENERGY. - - GOVERNMENT LICENSE AND DISCLAIMER - - This computer code material was prepared, in part, as an account - of work sponsored by an agency of the United States Government. - The Government is granted for itself and others acting on its - behalf a paid-up, nonexclusive, irrevocable worldwide license in - this data to reproduce, prepare derivative works, distribute - copies to the public, perform publicly and display publicly, and - to permit others to do so. NEITHER THE UNITED STATES GOVERNMENT - NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF - THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR - ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, - COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, - PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD - NOT INFRINGE PRIVATELY OWNED RIGHTS. - -***************************************************************************/ -#ifndef SYM_H -#define SYM_H - -/* file: sym.h - - Header info for symbol table module. - -*/ - -typedef struct sym_node * sym_nodeptr ; - -struct sym_node -{ - char * name ; /* lexeme */ - sym_nodeptr next ; /* pointer to next node in symbol table */ -/* fields that are associated with dimension declaration constants */ - unsigned char dim ; -/* fields that are associated with arrays */ - int ndims ; - int MDEX ; /* which index is the M dimension */ - int NDEX ; /* which index is the N dimension */ - unsigned char dims[7] ; - char dimname[7][64] ; -/* name of temporary variable associated with string. variable */ - char varx[32] ; -/* name of core association, July 2004 */ - char core_name[64] ; -/* internal name of variable associated with dataname entry, July 2004 */ - char internal_name[64] ; -/* fields associated with integer scalar variables */ - unsigned long info ; - unsigned long assigned ; /* pointer to assignment statement */ - unsigned long thisif ; - int iflev ; - int marked ; /* general purpose marker */ -} ; - -sym_nodeptr sym_add() ; -sym_nodeptr sym_get() ; -int sym_forget(); - -#endif diff --git a/OpenFAST/modules/openfast-registry/src/symtab_gen.c b/OpenFAST/modules/openfast-registry/src/symtab_gen.c deleted file mode 100644 index 944ce461b..000000000 --- a/OpenFAST/modules/openfast-registry/src/symtab_gen.c +++ /dev/null @@ -1,208 +0,0 @@ -/* symtab.c - -Symbol Table Handler -- Generic - -The routine symget() returns a pointer to a C structure matching a -given lexeme. If the lexeme does not already exist in the symbol -table, the routine will create a new symbol structure, store it, and -then return a pointer to the newly created structure. - -It is up to the calling module to declare the symbol structure as -well as several routines for manipulating the symbol structure. The -routines are passed to symget as pointers. - - name type description - - newnode() *char returns a pointer to a symbol structure. - - nodename() **char retrieves the lexeme name from a symbol - structure, returned as a pointer to a - character array. - - nodenext() **char retrieves pointer to the next field of - the symbol structure (the next field - is itself a pointer to a symbol structure) - -For a sample main or calling program see the end of this file. - -**** - REVISED 2-19-90. Added code to make hashtable interchangible. - new routine: create_ht() creates new hashtable - rev routine: symget() added parameter to pass hash table -*/ - -#include -#include -#ifndef _WIN32 -# include -#endif - -#include "protos.h" - -#define HASHSIZE 1024 - -/* commented out 2-29-90 -static char * symtab[HASHSIZE] ; -*/ - -void * malloc() ; -void * calloc() ; - -char * symget(name,newnode,nodename,nodenext,symtab,flag) -char *name ; -char *(*newnode)(), **(*nodename)(), **(*nodenext)() ; -char *symtab[] ; -int flag ; /* 1 is create if not there, 0 return NULL if not there */ -{ - int index ; - int found ; - register char *s ; - register char *t ; - char **x ; - char *p ; - - index = hash( name ) ; - p = symtab[index] ; - found = 0 ; - - while (p) { - s = name ; - t = *(*nodename)(p) ; - while (*s && *t && *s == *t ) { - s++ ; - t++ ; - } - if (!*s && !*t) { - found = 1 ; - break ; - } - p = *(*nodenext)(p) ; - } - - if (!found ) { - if (flag ) { - p = (*newnode)() ; - x = (*nodename)(p) ; - *x = (char *) malloc(strlen(name)+1) ; - strcpy(*x,name) ; - x = (*nodenext)(p) ; - *x = symtab[index] ; - symtab[index] = p ; - } else { - return(NULL) ; - } - } - - return(p) ; -} - -int -hash(name) -char * name ; -{ - register int result = 0 ; - register char * p = name ; - - while (*p) - result = 3*result + (int)*p++ ; - - result = result % HASHSIZE ; - while (result < 0) - result = result + HASHSIZE ; - return(result) ; -} - - -/* added 2-19-90, attaches a new hash table to pointer */ - -int -create_ht( p ) -char *** p ; -{ - *p = (char **) calloc( HASHSIZE , sizeof( char * ) ) ; - return(0) ; -} - - -/* added 4-15-92. - -This is a generic routine that, given a hash table pointer, -will traverse the hash table and apply a caller supplied -function to each entry - -*/ - -int -sym_traverse( ht, nodenext, f ) -char *ht[] ; -char **(*nodenext)() ; -void (*f)() ; -{ - char * p, **x ; - int i ; - for ( i = 0 ; i < HASHSIZE ; i++ ) - { - if ( ( p = ht[i] ) != NULL ) - { - while ( p ) - { - (*f)(p) ; - x = (*nodenext)(p) ; - p = *x ; - } - } - } - return(0) ; -} - -/**********************************************************************/ -/**********************************************************************/ -/**********************************************************************/ - -#ifdef COMMENTOUTSAMPLE -/* sample_main.c - - sample main program for symget() in the file symtab.c - -*/ - -#include - -struct symnode { - char * name ; - struct symnode *next ; -} ; - -extern struct symnode * symget() ; - -struct symnode * -newnode() -{ - struct symnode * malloc() ; - return( malloc( sizeof( struct symnode ) ) ) ; -} - -char ** -nodename(p) -struct symnode *p ; -{ - char ** x ; - x = &(p->name) ; - return( x ) ; -} - -struct symnode ** -nodenext(p) -struct symnode *p ; -{ - struct symnode **x ; - x = &(p->next) ; - return( x ) ; -} - -#endif - -/**********************************************************************/ -/**********************************************************************/ -/**********************************************************************/ - diff --git a/OpenFAST/modules/openfast-registry/src/type.c b/OpenFAST/modules/openfast-registry/src/type.c deleted file mode 100644 index 310d7b793..000000000 --- a/OpenFAST/modules/openfast-registry/src/type.c +++ /dev/null @@ -1,426 +0,0 @@ -#include -#include -#include -#include -#ifdef _WIN32 -# define rindex(X,Y) strrchr(X,Y) -# define index(X,Y) strchr(X,Y) -#else -# include -#endif - - -#include "registry.h" -#include "protos.h" -#include "data.h" - -int -init_type_table() -{ - node_t *p ; - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "integer" ) ; - strcpy( p->mapsto, "INTEGER(IntKi)") ; - add_node_to_end ( p , &Type ) ; - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "intki" ) ; - strcpy( p->mapsto, "INTEGER(IntKi)") ; - add_node_to_end ( p , &Type ) ; - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "b4ki" ) ; // this won't necesarially work as intended! - strcpy( p->mapsto, "INTEGER(IntKi)") ; - add_node_to_end ( p , &Type ) ; - - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "real" ) ; - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "real" ) ; - strcpy( p->mapsto, "REAL(ReKi)") ; - add_node_to_end ( p , &Type ) ; - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "reki" ) ; - strcpy( p->mapsto, "REAL(ReKi)") ; - add_node_to_end ( p , &Type ) ; - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "siki" ) ; - strcpy( p->mapsto, "REAL(SiKi)") ; - add_node_to_end ( p , &Type ) ; - - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "logical" ) ; - strcpy( p->mapsto, "LOGICAL") ; - add_node_to_end ( p , &Type ) ; - -#if 0 // bjj: would like to add this back to see if we can use this for pack/unpack -// these have to be handled individually because people can and will put lengths after them -// so can't make a generic type node here - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "character" ) ; - strcpy( p->mapsto, "CHARACTER") /**/ ; - add_node_to_end ( p , &Type ) ; -#endif - - - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "doubleprecision" ) ; - strcpy( p->mapsto, "REAL(DbKi)") ; - add_node_to_end ( p , &Type ) ; - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "dbki" ) ; - strcpy( p->mapsto, "REAL(DbKi)") ; - add_node_to_end ( p , &Type ) ; - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "r8ki" ) ; - strcpy( p->mapsto, "REAL(R8Ki)") ; - add_node_to_end ( p , &Type ) ; - p = new_node(TYPE) ; p->type_type = DERIVED ; strcpy( p->name , "meshtype" ) ; - strcpy( p->mapsto, "MeshType") ; - add_node_to_end ( p , &Type ) ; - p = new_node(TYPE) ; p->type_type = DERIVED ; strcpy( p->name , "dll_type" ) ; - strcpy( p->mapsto, "DLL_Type") ; - add_node_to_end ( p , &Type ) ; - - return(0) ; -} - - - -/* return the C equivalent of the simple Fortran types, expects the "mapsto" strings, set above */ -char * -C_type( char * s ) -{ - if ( !strcmp( s, "INTEGER(IntKi)") ) return("int" ) ; - if ( !strcmp( s, "LOGICAL" ) ) return("bool" ) ; - if (!strcmp(s, "REAL(ReKi)")) return("float"); - if (!strcmp(s, "REAL(SiKi)")) return("float"); - if (!strcmp(s, "REAL(DbKi)")) return("double"); - if (!strcmp(s, "REAL(R8Ki)")) return("double"); - if (!strncmp(s, "CHARACTER", 9)) return("char"); - return("unknown") ; -} - -char * -c_types_binding( char *s ) -{ - char * str_to_return = "CHARACTER(KIND=C_CHAR), DIMENSION("; - char * name_with_extension; - - - if ( !strcmp( s, "INTEGER(IntKi)") ) return("INTEGER(KIND=C_INT)" ) ; - if ( !strcmp( s, "LOGICAL" ) ) return("LOGICAL(KIND=C_BOOL)") ; - if (!strcmp(s, "REAL(ReKi)")) return("REAL(KIND=C_FLOAT)"); - if (!strcmp(s, "REAL(SiKi)")) return("REAL(KIND=C_FLOAT)"); - if (!strcmp(s, "REAL(DbKi)")) return("REAL(KIND=C_DOUBLE)"); - if (!strcmp(s, "REAL(R8Ki)")) return("REAL(KIND=C_DOUBLE)"); - if (!strncmp(s, "CHARACTER", 9)) { // give the C string a length identical to the fortran type - char *p = s, buf[10]; - while ( *p ) { - if ( isdigit(*p) ) { - long val = strtol( p, &p, 10 ); - snprintf( buf, 10, "%lu", val ); - } else { - p++; - } - } - - - name_with_extension = malloc(strlen(str_to_return)+15); // memory leak, should take care of this ? //bjj: made it larger to account for size of buf - strcpy(name_with_extension, str_to_return); - strcat(name_with_extension, buf); - strcat(name_with_extension, ")"); - - return name_with_extension; - }; - return("unknown") ; -} - -char * -assoc_or_allocated( node_t * r ) -{ - - if ( is_pointer(r) ){ - return("ASSOCIATED"); - } else { - return("ALLOCATED"); - } - -} - -int -is_pointer( node_t * r ) -{ - - if ( sw_ccode && r->ndims > 0 && r->dims[0]->deferred ){ - if ( !strncmp( make_lower_temp(r-> name), "writeoutput", 11) ) { // this covers WriteOutput, WriteOutputHdr, and WriteOutputUnt - return( 0 ); // we're going to use these in the glue code, so these will be a special case - } else if (r->type->type_type == DERIVED){ - return(0); // derived types aren't passed through the c-interface, so don't make them pointers - } else { - return(1); - } - } else { - return( 0 ); - } - -} - - -int -set_state_dims ( char * dims , node_t * node ) -{ - int modifiers ; - node_t *d, *d1 ; - char *c ; - char dspec[NAMELEN] ; - int inbrace ; - - if ( dims == NULL ) dims = "-" ; - modifiers = 0 ; - node->ndims = 0 ; - node->boundary_array = 0 ; - - inbrace = 0 ; - node->subgrid = 0 ; - strcpy(dspec,"") ; - for ( c = dims ; *c ; c++ ) - { - if ( *c == '-' && ! inbrace ) - { - break ; - } - else if ( *c == '{' && ! inbrace ) - { - inbrace = 1 ; - continue ; - } - else if ( modifiers == 0 ) - { - if ( *c == '}' && inbrace ) { inbrace = 0 ; } - else { int n = strlen(dspec) ; dspec[n] = *c ; dspec[n+1]='\0' ; } - if ( inbrace ) { - continue ; - } - d1 = new_node(DIM) ; /* make a copy */ - if (( d = get_dim_entry ( dspec, 1 )) != NULL ) { - *d1 = *d ; - } else { - set_dim_len( dspec , d1 ) ; - } - node->dims[node->ndims++] = d1 ; - strcpy(dspec,"") ; - } - } - // check to make sure that if any dimension is deferred they all must be - - has_deferred_dim( node, 1 ) ; - - return (0) ; -} - -int -has_deferred_dim( node_t * node, int noisy ) -{ - int deferred, i ; - deferred = 0 ; - if ( node->ndims > 0 ) { - deferred = node->dims[0]->deferred ; - for ( i = 1 ; i < node->ndims ; i++ ) - { - if ( deferred != node->dims[i]->deferred ) { - if ( node->dims[i]->deferred ) { - if ( noisy ) fprintf(stderr, - "Registry warning: dimension %d of %s is allocatable while others are not.\n",i,node->name) ; - } else { - if ( noisy ) fprintf(stderr, - "Registry warning: dimension %d of %s is not allocatable while others are.\n",i,node->name) ; - } - } - if ( node->dims[i]->deferred ) deferred = 1 ; - } - } - return(deferred) ; -} - -#if 0 -node_t * -get_4d_entry ( char * name ) -{ - node_t *p ; - if ( name == NULL ) return (NULL) ; - for ( p = FourD ; p != NULL ; p = p->next4d ) - { - if ( !strcmp( p->name , name ) ) - { - return(p) ; - } - } - return(NULL) ; -} -#endif - -node_t * -get_type_entry ( char * typename ) -{ - node_t * retval ; - retval = get_entry(typename,Type) ; - return(retval) ; -} - -node_t * -get_modname_entry ( char * modname ) -{ - return(get_entry(modname,ModNames)) ; -} - -node_t * -get_rconfig_entry ( char * name ) -{ - node_t * p ; - if ((p=get_entry(name,Domain.fields))==NULL) return(NULL) ; - if (p->node_kind & RCONFIG) return(p) ; - return(NULL) ; -} - -node_t * -get_entry ( char * name , node_t * node ) -{ - node_t *p ; - char tmp[NAMELEN] ; - if ( name == NULL ) return (NULL) ; - if ( node == NULL ) return (NULL) ; - strcpy( tmp, name ) ; - make_lower_temp(tmp) ; - for ( p = node ; p != NULL ; p = p->next ) - { - if ( !strncmp( name , "character", 9 ) ) - { - if ( !strncmp( p->name , name, 9 ) ) - { - return(p) ; - } - } else { - if ( !strcmp( make_lower_temp(p->name) , tmp ) ) - { - return(p) ; - } - } - } - return(NULL) ; -} - -/* this gets the entry for the node even if it */ -/* is a derived data structure; does this by following */ -/* the fully specified f90 reference. For example: */ -/* "xa%f" for the field of derived type xa. */ -/* note it will also take care to ignore the _1 or _2 */ -/* suffixes from variables that have ntl > 1 */ -/* 11/10/2001 -- added use field; if the entry has a use */ -/* that starts with "dyn_" and use doesn't correspond to */ -/* that, skip that entry and continue */ - -node_t * -get_entry_r ( char * name , char * use , node_t * node ) -{ - node_t *p ; - char tmp[NAMELEN], *t1, *t2 ; - - if ( name == NULL ) return (NULL) ; - if ( node == NULL ) return (NULL) ; - - for ( p = node ; p != NULL ; p = p->next ) - { - strcpy( tmp, name ) ; - - /* first check for exact match */ - if ( !strcmp( p->name , tmp ) ) - { - return(p) ; - } - - t1 = NULL ; - if ((t1 = index(tmp,'%'))!= NULL ) *t1 = '\0' ; - - if ( p->ntl > 1 ) - { - if (( t2 = rindex( tmp , '_' )) != NULL ) - { - /* be sure it really is an integer that follows the _ and that */ - /* that is that is the last character */ - if ((*(t2+1) >= '0' && *(t2+1) <= '9') && *(t2+2)=='\0') *t2 = '\0' ; - } - } - - /* also allow _tend */ - if (( t2 = rindex( tmp , '_' )) != NULL ) { - if (!strcmp(t2,"_tend")) *t2 = '\0' ; - } - - /* also allow _tend */ - if (( t2 = rindex( tmp , '_' )) != NULL ) { - if (!strcmp(t2,"_old")) *t2 = '\0' ; - } - - if ( !strcmp( p->name , tmp ) ) - { - if ( t1 != NULL ) return( get_entry_r( t1+1 , use , p->type->fields ) ) ; - return(p) ; - } - } - return(NULL) ; -} - -node_t * -get_dimnode_for_coord ( node_t * node , int coord_axis ) -{ - int i ; - if ( node == NULL ) return(NULL) ; - for ( i = 0 ; i < node->ndims ; i++ ) - { - if ( node->dims[i] == NULL ) continue ; - if ( node->dims[i]->coord_axis == coord_axis ) - { - return(node->dims[i]) ; - } - } - return(NULL) ; -} - -int -get_index_for_coord ( node_t * node , int coord_axis ) -{ - int i ; - if ( node == NULL ) return( -1 ) ; - for ( i = 0 ; i < node->ndims ; i++ ) - { - if ( node->dims[i] == NULL ) continue ; - if ( node->dims[i]->coord_axis == coord_axis ) - { - return(i) ; - } - } - return(-1) ; -} - - -char * -set_mem_order( node_t * node , char * str , int n ) -{ - int i ; - node_t * p ; - - if ( str == NULL || node == NULL ) return(NULL) ; - strcpy(str,"") ; - if ( node->boundary_array ) - { - strcpy(str, "C") ; /* if this is called for a boundary array, just give it a */ - /* "reasonable" value and move on. */ - } - else - { - if ( node->ndims <= 0 ) - { - strcat(str,"0") ; return(str) ; - } - for ( i = 0 ; i < node->ndims && i < n ; i++ ) - { - p = node->dims[i] ; - switch( p->coord_axis ) - { - case(COORD_X) : strcat(str,"X") ; break ; - case(COORD_Y) : strcat(str,"Y") ; break ; - case(COORD_Z) : strcat(str,"Z") ; break ; - case(COORD_C) : strcat(str,"C") ; break ; - default : break ; - } - } - } - return(str) ; -} diff --git a/OpenFAST/modules/openfoam/CMakeLists.txt b/OpenFAST/modules/openfoam/CMakeLists.txt deleted file mode 100644 index 7d895a7cf..000000000 --- a/OpenFAST/modules/openfoam/CMakeLists.txt +++ /dev/null @@ -1,41 +0,0 @@ -# -# Copyright 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. -# - -if (GENERATE_TYPES) - generate_f90_types(src/OpenFOAM_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/OpenFOAM_Types.f90 -ccode) -endif() - -# copy the header files to their build location -configure_file(src/OpenFOAM_Types.h ${CMAKE_CURRENT_BINARY_DIR} COPYONLY) - -add_library(openfoamtypeslib src/OpenFOAM_Types.f90) -target_link_libraries(openfoamtypeslib nwtclibs) - -add_library(foamfastlib - src/OpenFOAM.f90 -) -target_link_libraries(foamfastlib openfoamtypeslib openfast_prelib nwtclibs) - -install(TARGETS openfoamtypeslib foamfastlib - EXPORT "${CMAKE_PROJECT_NAME}Libraries" - RUNTIME DESTINATION bin - LIBRARY DESTINATION lib - ARCHIVE DESTINATION lib) - -install(FILES - ${CMAKE_CURRENT_BINARY_DIR}/OpenFOAM_Types.h - DESTINATION include -) diff --git a/OpenFAST/modules/openfoam/README.md b/OpenFAST/modules/openfoam/README.md deleted file mode 100644 index 0d5740074..000000000 --- a/OpenFAST/modules/openfoam/README.md +++ /dev/null @@ -1,5 +0,0 @@ -# OpenFOAM Module - -## Overview -This is a pseudo module used to couple OpenFAST with OpenFOAM; -it is considered part of the OpenFAST glue code. diff --git a/OpenFAST/modules/openfoam/src/OpenFOAM.f90 b/OpenFAST/modules/openfoam/src/OpenFOAM.f90 deleted file mode 100644 index a45b1d525..000000000 --- a/OpenFAST/modules/openfoam/src/OpenFOAM.f90 +++ /dev/null @@ -1,1184 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2015 National Renewable Energy Laboratory -! -! Lidar module, a submodule of InflowWind -! -! 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. -! -!********************************************************************************************************************************** -MODULE OpenFOAM - -! This is a pseudo module used to couple FAST v8 with OpenFOAM; it is considered part of the FAST glue code - USE FAST_Types -! USE OpenFOAM_IO - - IMPLICIT NONE - - PRIVATE - - TYPE(ProgDesc), PARAMETER :: OpFM_Ver = ProgDesc( 'OpenFOAM Integration', '', '' ) - - -! ===================================================================================================" - - - ! ..... Public Subroutines ................................................................................................... - - PUBLIC :: Init_OpFM ! Initialization routine - PUBLIC :: OpFM_SetInputs ! Glue-code routine to update inputs for OpenFOAM - PUBLIC :: OpFM_SetWriteOutput - - -CONTAINS -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Init_OpFM( InitInp, p_FAST, AirDens, u_AD14, u_AD, initOut_AD, y_AD, y_ED, OpFM, InitOut, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(OpFM_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST ! Parameters for the glue code - REAL(ReKi), INTENT(IN ) :: AirDens ! Air Density kg/m^3 - TYPE(AD14_InputType), INTENT(IN ) :: u_AD14 ! AeroDyn14 input data - TYPE(AD_InputType), INTENT(IN ) :: u_AD ! AeroDyn input data - TYPE(AD_OutputType), INTENT(IN ) :: y_AD ! AeroDyn output data (for mesh mapping) - TYPE(AD_InitOutputType), INTENT(IN ) :: initOut_AD ! AeroDyn InitOutput data (for BladeProps) - TYPE(ED_OutputType), INTENT(IN) :: y_ED ! The outputs of the structural dynamics module - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM ! data for the OpenFOAM integration module - TYPE(OpFM_InitOutputType), INTENT(INOUT) :: 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 - INTEGER(IntKi) :: k ! blade loop counter - - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'Init_OpFM' - - ! Initialize variables - - ErrStat = ErrID_None - ErrMsg = "" - - !............................................................................................ - ! Define parameters here: - !............................................................................................ - - ! number of velocity nodes in the interface: - - OpFM%p%NnodesVel = 1 ! always want the hub point - IF ( p_FAST%CompAero == Module_AD14 ) THEN ! AeroDyn 14 needs these velocities - CALL SetErrStat(ErrID_Fatal, 'Error AeroDyn14 is not supported yet with different number of velocity and force actuator nodes', ErrStat, ErrMsg, RoutineName) - RETURN - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN ! AeroDyn 15 needs these velocities - OpFM%p%NumBl = SIZE( u_AD%rotors(1)%BladeMotion, 1 ) - - OpFM%p%NnodesVel = OpFM%p%NnodesVel + y_AD%rotors(1)%TowerLoad%NNodes ! tower nodes (if any) - DO k=1,OpFM%p%NumBl - OpFM%p%NnodesVel = OpFM%p%NnodesVel + u_AD%rotors(1)%BladeMotion(k)%NNodes ! blade nodes - END DO - END IF - - ! number of force nodes in the interface - Opfm%p%NnodesForceBlade = InitInp%NumActForcePtsBlade - OpFM%p%NnodesForceTower = InitInp%NumActForcePtsTower - OpFM%p%NnodesForce = 1 + OpFM%p%NumBl * InitInp%NumActForcePtsBlade - OpFM%p%BladeLength = InitInp%BladeLength - - if ( y_AD%rotors(1)%TowerLoad%NNodes > 0 ) then - OpFM%p%NMappings = OpFM%p%NumBl + 1 - OpFM%p%TowerHeight = InitInp%TowerHeight - OpFM%p%TowerBaseHeight = InitInp%TowerBaseHeight - OpFM%p%NnodesForce = OpFM%p%NnodesForce + InitInp%NumActForcePtsTower - else - OpFM%p%NMappings = OpFM%p%NumBl - end if - - ! air density, required for normalizing values sent to OpenFOAM: - OpFM%p%AirDens = AirDens - if ( EqualRealNos( AirDens, 0.0_ReKi ) ) & - CALL SetErrStat( ErrID_Fatal, 'Air density cannot be zero for OpenFOAM integration. Check that AeroDyn is used and that air density is set properly', ErrStat,ErrMsg,RoutineName) - - !............................................................................................ - ! Allocate arrays and define initial guesses for the OpenFOAM inputs here: - !............................................................................................ - CALL AllocPAry( OpFM%u%pxVel, OpFM%p%NnodesVel, 'pxVel', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( OpFM%u%pyVel, OpFM%p%NnodesVel, 'pyVel', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( OpFM%u%pzVel, OpFM%p%NnodesVel, 'pzVel', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( OpFM%u%pxForce, OpFM%p%NnodesForce, 'pxForce', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( OpFM%u%pyForce, OpFM%p%NnodesForce, 'pyForce', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( OpFM%u%pzForce, OpFM%p%NnodesForce, 'pzForce', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( OpFM%u%xdotForce, OpFM%p%NnodesForce, 'xdotForce', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( OpFM%u%ydotForce, OpFM%p%NnodesForce, 'ydotForce', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( OpFM%u%zdotForce, OpFM%p%NnodesForce, 'zdotForce', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( OpFM%u%pOrientation, 3*3*OpFM%p%NnodesForce, 'pOrientation', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( OpFM%u%fx, OpFM%p%NnodesForce, 'fx', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( OpFM%u%fy, OpFM%p%NnodesForce, 'fy', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( OpFM%u%fz, OpFM%p%NnodesForce, 'fz', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( OpFM%u%momentx, OpFM%p%NnodesForce, 'momentx', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( OpFM%u%momenty, OpFM%p%NnodesForce, 'momenty', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( OpFM%u%momentz, OpFM%p%NnodesForce, 'momentz', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( OpFM%u%forceNodesChord, OpFM%p%NnodesForce, 'forceNodesChord', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - IF (ErrStat >= AbortErrLev) RETURN - - ! make sure the C versions are synced with these arrays - OpFM%u%c_obj%pxVel_Len = OpFM%p%NnodesVel; OpFM%u%c_obj%pxVel = C_LOC( OpFM%u%pxVel(1) ) - OpFM%u%c_obj%pyVel_Len = OpFM%p%NnodesVel; OpFM%u%c_obj%pyVel = C_LOC( OpFM%u%pyVel(1) ) - OpFM%u%c_obj%pzVel_Len = OpFM%p%NnodesVel; OpFM%u%c_obj%pzVel = C_LOC( OpFM%u%pzVel(1) ) - OpFM%u%c_obj%pxForce_Len = OpFM%p%NnodesForce; OpFM%u%c_obj%pxForce = C_LOC( OpFM%u%pxForce(1) ) - OpFM%u%c_obj%pyForce_Len = OpFM%p%NnodesForce; OpFM%u%c_obj%pyForce = C_LOC( OpFM%u%pyForce(1) ) - OpFM%u%c_obj%pzForce_Len = OpFM%p%NnodesForce; OpFM%u%c_obj%pzForce = C_LOC( OpFM%u%pzForce(1) ) - OpFM%u%c_obj%xdotForce_Len = OpFM%p%NnodesForce; OpFM%u%c_obj%xdotForce = C_LOC( OpFM%u%xdotForce(1) ) - OpFM%u%c_obj%ydotForce_Len = OpFM%p%NnodesForce; OpFM%u%c_obj%ydotForce = C_LOC( OpFM%u%ydotForce(1) ) - OpFM%u%c_obj%zdotForce_Len = OpFM%p%NnodesForce; OpFM%u%c_obj%zdotForce = C_LOC( OpFM%u%zdotForce(1) ) - OpFM%u%c_obj%pOrientation_Len = OpFM%p%NnodesForce*3*3; OpFM%u%c_obj%pOrientation = C_LOC( OpFM%u%pOrientation(1) ) - OpFM%u%c_obj%fx_Len = OpFM%p%NnodesForce; OpFM%u%c_obj%fx = C_LOC( OpFM%u%fx(1) ) - OpFM%u%c_obj%fy_Len = OpFM%p%NnodesForce; OpFM%u%c_obj%fy = C_LOC( OpFM%u%fy(1) ) - OpFM%u%c_obj%fz_Len = OpFM%p%NnodesForce; OpFM%u%c_obj%fz = C_LOC( OpFM%u%fz(1) ) - OpFM%u%c_obj%momentx_Len = OpFM%p%NnodesForce; OpFM%u%c_obj%momentx = C_LOC( OpFM%u%momentx(1) ) - OpFM%u%c_obj%momenty_Len = OpFM%p%NnodesForce; OpFM%u%c_obj%momenty = C_LOC( OpFM%u%momenty(1) ) - OpFM%u%c_obj%momentz_Len = OpFM%p%NnodesForce; OpFM%u%c_obj%momentz = C_LOC( OpFM%u%momentz(1) ) - OpFM%u%c_obj%forceNodesChord_Len = OpFM%p%NnodesForce; OpFM%u%c_obj%forceNodesChord = C_LOC( OpFM%u%forceNodesChord(1) ) - - ! initialize the arrays: - call OpFM_CreateActForceBladeTowerNodes(OpFM%p, ErrStat2, ErrMsg2) !Creates the blade and tower nodes in radial and tower height co-ordinates - call OpFM_InterpolateForceNodesChord(initOut_AD, OpFM%p, OpFM%u, ErrStat2, ErrMsg2) !Interpolates the chord distribution to the force nodes - call OpFM_CreateActForceMotionsMesh( p_FAST, y_ED, InitInp, OpFM, ErrStat2, ErrMsg2) - - !............................................................................................ - ! Allocate arrays and set up mappings to point loads (for AD15 only): - ! (bjj: note that normally I'd put these things in the FAST_ModuleMapType, but I don't want - ! to add OpenFOAM integrations in the rest fo the code). - !............................................................................................ - ! Allocate space for mapping data structures - ALLOCATE( OpFM%m%ActForceLoads(OpFM%p%NMappings), OpFM%m%Line2_to_Line2_Loads(OpFM%p%NMappings), OpFM%m%Line2_to_Line2_Motions(OpFM%p%NMappings),STAT=ErrStat2) - ALLOCATE( OpFM%m%ActForceLoadsPoints(OpFM%p%NMappings), OpFM%m%Line2_to_Point_Loads(OpFM%p%NMappings), OpFM%m%Line2_to_Point_Motions(OpFM%p%NMappings),STAT=ErrStat2) - - do k=1,OpFM%p%NMappings - call MeshCopy ( SrcMesh = OpFM%m%ActForceMotions(k) & - , DestMesh = OpFM%m%ActForceLoads(k) & - , CtrlCode = MESH_SIBLING & - , IOS = COMPONENT_OUTPUT & - , Force = .true. & - , Moment = .true. & - , ErrStat = ErrStat2 & - , ErrMess = ErrMsg2 ) - OpFM%m%ActForceLoads(k)%RemapFlag = .true. - call MeshCopy ( SrcMesh = OpFM%m%ActForceMotionsPoints(k) & - , DestMesh = OpFM%m%ActForceLoadsPoints(k) & - , CtrlCode = MESH_SIBLING & - , IOS = COMPONENT_OUTPUT & - , Force = .true. & - , Moment = .true. & - , ErrStat = ErrStat2 & - , ErrMess = ErrMsg2 ) - OpFM%m%ActForceLoadsPoints(k)%RemapFlag = .true. - end do - - ! create the mapping data structures: - DO k=1,OpFM%p%NumBl - IF (p_FAST%CompElast == Module_ED ) THEN - call MeshMapCreate( y_ED%BladeLn2Mesh(k), OpFM%m%ActForceMotions(k), OpFM%m%Line2_to_Line2_Motions(k), ErrStat2, ErrMsg2 ); - ELSEIF (p_FAST%CompElast == Module_BD ) THEN - ! call MeshMapCreate( BD%y(k)%BldMotion, OpFM%m%ActForceMotions(k), OpFM%m%Line2_to_Line2_Motions(k), ErrStat2, ErrMsg2 ); - END IF - call MeshMapCreate( y_AD%rotors(1)%BladeLoad(k), OpFM%m%ActForceLoads(k), OpFM%m%Line2_to_Line2_Loads(k), ErrStat2, ErrMsg2 ); - - call MeshMapCreate( OpFM%m%ActForceMotions(k), OpFM%m%ActForceMotionsPoints(k), OpFM%m%Line2_to_Point_Motions(k), ErrStat2, ErrMsg2 ); - call MeshMapCreate( OpFM%m%ActForceLoads(k), OpFM%m%ActForceLoadsPoints(k), OpFM%m%Line2_to_Point_Loads(k), ErrStat2, ErrMsg2 ); -! OpFM%m%ActForceLoads(k)%RemapFlag = .false. - END DO - - do k=OpFM%p%NumBl+1,OpFM%p%NMappings - call MeshMapCreate( y_ED%TowerLn2Mesh, OpFM%m%ActForceMotions(k), OpFM%m%Line2_to_Line2_Motions(k), ErrStat2, ErrMsg2 ); - call MeshMapCreate( OpFM%m%ActForceMotions(k), OpFM%m%ActForceMotionsPoints(k), OpFM%m%Line2_to_Point_Motions(k), ErrStat2, ErrMsg2 ); - - if ( y_AD%rotors(1)%TowerLoad%nnodes > 0 ) then ! we can have an input mesh on the tower without having an output mesh. - call MeshMapCreate( y_AD%rotors(1)%TowerLoad, OpFM%m%ActForceLoads(k), OpFM%m%Line2_to_Line2_Loads(k), ErrStat2, ErrMsg2 ); - call MeshMapCreate( OpFM%m%ActForceLoads(k), OpFM%m%ActForceLoadsPoints(k), OpFM%m%Line2_to_Point_Loads(k), ErrStat2, ErrMsg2 ); -! OpFM%m%ActForceLoads(k)%RemapFlag = .false. - end if - - end do - - call SetOpFMPositions(p_FAST, u_AD14, u_AD, y_ED, OpFM) - OpFM%u%fx = 0.0_ReKi - OpFM%u%fy = 0.0_ReKi - OpFM%u%fz = 0.0_ReKi - - !............................................................................................ - ! Define system output initializations (set up mesh) here: - !............................................................................................ - CALL AllocPAry( OpFM%y%u, OpFM%p%NnodesVel, 'u', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( OpFM%y%v, OpFM%p%NnodesVel, 'v', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( OpFM%y%w, OpFM%p%NnodesVel, 'w', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - IF (ErrStat >= AbortErrLev) RETURN - - ! make sure the C versions are synced with these arrays - OpFM%y%c_obj%u_Len = OpFM%p%NnodesVel; OpFM%y%c_obj%u = C_LOC( OpFM%y%u(1) ) - OpFM%y%c_obj%v_Len = OpFM%p%NnodesVel; OpFM%y%c_obj%v = C_LOC( OpFM%y%v(1) ) - OpFM%y%c_obj%w_Len = OpFM%p%NnodesVel; OpFM%y%c_obj%w = C_LOC( OpFM%y%w(1) ) - - - !............................................................................................ - ! Define initialization-routine output (including writeOutput array) here: - !............................................................................................ - - CALL AllocAry( InitOut%WriteOutputHdr, 3, 'WriteOutputHdr', ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry( InitOut%WriteOutputUnt, 3, 'WriteOutputUnt', ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry( OpFM%y%WriteOutput, 3, 'WriteOutput', ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - InitOut%WriteOutputHdr(1) = 'Wind1VelX'; InitOut%WriteOutputUnt(1) = '(m/s)' - InitOut%WriteOutputHdr(2) = 'Wind1VelY'; InitOut%WriteOutputUnt(2) = '(m/s)' - InitOut%WriteOutputHdr(3) = 'Wind1VelZ'; InitOut%WriteOutputUnt(3) = '(m/s)' - OpFM%y%WriteOutput = 0.0_ReKi - - InitOut%Ver = OpFM_Ver - - RETURN - -END SUBROUTINE Init_OpFM -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE OpFM_SetInputs( p_FAST, p_AD14, u_AD14, y_AD14, u_AD, y_AD, y_ED, y_SrvD, OpFM, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST ! Parameters for the glue code - TYPE(AD14_ParameterType), INTENT(IN) :: p_AD14 ! The parameters from AeroDyn14 (for mesh transfer with improperly set meshes) - TYPE(AD14_InputType), INTENT(IN) :: u_AD14 ! The input meshes (already calculated) from AeroDyn14 - TYPE(AD14_OutputType), INTENT(IN) :: y_AD14 ! The output meshes (already calculated) from AeroDyn14 - TYPE(AD_InputType), INTENT(IN) :: u_AD ! The input meshes (already calculated) from AeroDyn - TYPE(AD_OutputType), INTENT(IN) :: y_AD ! The output meshes (already calculated) from AeroDyn - TYPE(ED_OutputType), INTENT(IN) :: y_ED ! The outputs of the structural dynamics module - TYPE(SrvD_OutputType), INTENT(IN) :: y_SrvD ! The outputs of the ServoDyn module (control) - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM ! data for the OpenFOAM integration module - 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 of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_SetInputs' - - - ErrStat = ErrID_None - ErrMsg = "" - - ! set the positions - call SetOpFMPositions(p_FAST, u_AD14, u_AD, y_ED, OpFM) - - ! set the forces - call SetOpFMForces(p_FAST, p_AD14, u_AD14, y_AD14, u_AD, y_AD, y_ED, OpFM, ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - -END SUBROUTINE OpFM_SetInputs -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE SetOpFMPositions(p_FAST, u_AD14, u_AD, y_ED, OpFM) - - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM ! data for the OpenFOAM integration module - TYPE(AD14_InputType), INTENT(IN) :: u_AD14 ! The input meshes (already calculated) from AeroDyn14 - TYPE(AD_InputType), INTENT(IN) :: u_AD ! The input meshes (already calculated) from AeroDyn - TYPE(ED_OutputType), INTENT(IN) :: y_ED ! The outputs of the structural dynamics module - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST ! FAST parameter data - - - ! Local variables: - - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - INTEGER(IntKi) :: J ! Loops through nodes / elements. - INTEGER(IntKi) :: K ! Loops through blades. - INTEGER(IntKi) :: Node ! Node number for blade/node on mesh - - - ! Do the Velocity (AeroDyn) nodes first - !------------------------------------------------------------------------------------------------- - Node = 1 ! displaced hub position - OpFM%u%pxVel(Node) = y_ED%HubPtMotion%Position(1,1) + y_ED%HubPtMotion%TranslationDisp(1,1) - OpFM%u%pyVel(Node) = y_ED%HubPtMotion%Position(2,1) + y_ED%HubPtMotion%TranslationDisp(2,1) - OpFM%u%pzVel(Node) = y_ED%HubPtMotion%Position(3,1) + y_ED%HubPtMotion%TranslationDisp(3,1) - - - ! blade nodes - DO K = 1,SIZE(u_AD%rotors(1)%BladeMotion) - DO J = 1,u_AD%rotors(1)%BladeMotion(k)%Nnodes - - Node = Node + 1 - OpFM%u%pxVel(Node) = u_AD%rotors(1)%BladeMotion(k)%TranslationDisp(1,j) + u_AD%rotors(1)%BladeMotion(k)%Position(1,j) - OpFM%u%pyVel(Node) = u_AD%rotors(1)%BladeMotion(k)%TranslationDisp(2,j) + u_AD%rotors(1)%BladeMotion(k)%Position(2,j) - OpFM%u%pzVel(Node) = u_AD%rotors(1)%BladeMotion(k)%TranslationDisp(3,j) + u_AD%rotors(1)%BladeMotion(k)%Position(3,j) - - END DO !J = 1,p%BldNodes ! Loop through the blade nodes / elements - END DO !K = 1,p%NumBl - - if (OpFM%p%NMappings .gt. OpFM%p%NumBl) then - ! tower nodes - DO J=1,u_AD%rotors(1)%TowerMotion%nnodes - Node = Node + 1 - OpFM%u%pxVel(Node) = u_AD%rotors(1)%TowerMotion%TranslationDisp(1,J) + u_AD%rotors(1)%TowerMotion%Position(1,J) - OpFM%u%pyVel(Node) = u_AD%rotors(1)%TowerMotion%TranslationDisp(2,J) + u_AD%rotors(1)%TowerMotion%Position(2,J) - OpFM%u%pzVel(Node) = u_AD%rotors(1)%TowerMotion%TranslationDisp(3,J) + u_AD%rotors(1)%TowerMotion%Position(3,J) - END DO - end if - - ! Do the Actuator Force nodes now - Node = 1 ! displaced hub position - OpFM%u%pxForce(Node) = OpFM%u%pxVel(Node) - OpFM%u%pyForce(Node) = OpFM%u%pyVel(Node) - OpFM%u%pzForce(Node) = OpFM%u%pzVel(Node) - OpFM%u%pOrientation((Node-1)*9 + 1) = y_ED%HubPtMotion%Orientation(1,1,1) - OpFM%u%pOrientation((Node-1)*9 + 2) = y_ED%HubPtMotion%Orientation(2,1,1) - OpFM%u%pOrientation((Node-1)*9 + 3) = y_ED%HubPtMotion%Orientation(3,1,1) - OpFM%u%pOrientation((Node-1)*9 + 4) = y_ED%HubPtMotion%Orientation(1,2,1) - OpFM%u%pOrientation((Node-1)*9 + 5) = y_ED%HubPtMotion%Orientation(2,2,1) - OpFM%u%pOrientation((Node-1)*9 + 6) = y_ED%HubPtMotion%Orientation(3,2,1) - OpFM%u%pOrientation((Node-1)*9 + 7) = y_ED%HubPtMotion%Orientation(1,3,1) - OpFM%u%pOrientation((Node-1)*9 + 8) = y_ED%HubPtMotion%Orientation(2,3,1) - OpFM%u%pOrientation((Node-1)*9 + 9) = y_ED%HubPtMotion%Orientation(3,3,1) - - - DO K = 1,OpFM%p%NumBl - ! mesh mapping from line2 mesh to point mesh - IF (p_FAST%CompElast == Module_ED ) THEN - call Transfer_Line2_to_Line2( y_ED%BladeLn2Mesh(k), OpFM%m%ActForceMotions(k), OpFM%m%Line2_to_Line2_Motions(k), ErrStat2, ErrMsg2 ) - ELSEIF (p_FAST%CompElast == Module_BD ) THEN - ! call Transfer_Line2_to_Point( BD%y(k)%BldMotion, OpFM%m%ActForceMotions(k), OpFM%m%Line2_to_Line2_Motions(k), ErrStat2, ErrMsg2 ) - END IF - call Transfer_Line2_to_Point( OpFM%m%ActForceMotions(k), OpFM%m%ActForceMotionsPoints(k), OpFM%m%Line2_to_Point_Motions(k), ErrStat2, ErrMsg2 ) - - - DO J = 1, OpFM%p%NnodesForceBlade - Node = Node + 1 - OpFM%u%pxForce(Node) = OpFM%m%ActForceMotionsPoints(k)%Position(1,J) + OpFM%m%ActForceMotionsPoints(k)%TranslationDisp(1,J) - OpFM%u%pyForce(Node) = OpFM%m%ActForceMotionsPoints(k)%Position(2,J) + OpFM%m%ActForceMotionsPoints(k)%TranslationDisp(2,J) - OpFM%u%pzForce(Node) = OpFM%m%ActForceMotionsPoints(k)%Position(3,J) + OpFM%m%ActForceMotionsPoints(k)%TranslationDisp(3,J) - OpFM%u%xdotForce(Node) = OpFM%m%ActForceMotionsPoints(k)%TranslationVel(1,J) - OpFM%u%ydotForce(Node) = OpFM%m%ActForceMotionsPoints(k)%TranslationVel(2,J) - OpFM%u%zdotForce(Node) = OpFM%m%ActForceMotionsPoints(k)%TranslationVel(3,J) - OpFM%u%pOrientation((Node-1)*9 + 1) = OpFM%m%ActForceMotionsPoints(k)%Orientation(1,1,J) - OpFM%u%pOrientation((Node-1)*9 + 2) = OpFM%m%ActForceMotionsPoints(k)%Orientation(2,1,J) - OpFM%u%pOrientation((Node-1)*9 + 3) = OpFM%m%ActForceMotionsPoints(k)%Orientation(3,1,J) - OpFM%u%pOrientation((Node-1)*9 + 4) = OpFM%m%ActForceMotionsPoints(k)%Orientation(1,2,J) - OpFM%u%pOrientation((Node-1)*9 + 5) = OpFM%m%ActForceMotionsPoints(k)%Orientation(2,2,J) - OpFM%u%pOrientation((Node-1)*9 + 6) = OpFM%m%ActForceMotionsPoints(k)%Orientation(3,2,J) - OpFM%u%pOrientation((Node-1)*9 + 7) = OpFM%m%ActForceMotionsPoints(k)%Orientation(1,3,J) - OpFM%u%pOrientation((Node-1)*9 + 8) = OpFM%m%ActForceMotionsPoints(k)%Orientation(2,3,J) - OpFM%u%pOrientation((Node-1)*9 + 9) = OpFM%m%ActForceMotionsPoints(k)%Orientation(3,3,J) - END DO - - END DO - - DO K = OpFM%p%NumBl+1,OpFM%p%NMappings - - call Transfer_Line2_to_Line2( y_ED%TowerLn2Mesh, OpFM%m%ActForceMotions(k), OpFM%m%Line2_to_Line2_Motions(k), ErrStat2, ErrMsg2 ) - call Transfer_Line2_to_Point( OpFM%m%ActForceMotions(k), OpFM%m%ActForceMotionsPoints(k), OpFM%m%Line2_to_Point_Motions(k), ErrStat2, ErrMsg2 ) - - DO J=1,OpFM%p%NnodesForceTower - Node = Node + 1 - OpFM%u%pxForce(Node) = OpFM%m%ActForceMotionsPoints(k)%Position(1,J) + OpFM%m%ActForceMotionsPoints(k)%TranslationDisp(1,J) - OpFM%u%pyForce(Node) = OpFM%m%ActForceMotionsPoints(k)%Position(2,J) + OpFM%m%ActForceMotionsPoints(k)%TranslationDisp(2,J) - OpFM%u%pzForce(Node) = OpFM%m%ActForceMotionsPoints(k)%Position(3,J) + OpFM%m%ActForceMotionsPoints(k)%TranslationDisp(3,J) - OpFM%u%pOrientation((Node-1)*9 + 1) = OpFM%m%ActForceMotionsPoints(k)%Orientation(1,1,J) - OpFM%u%pOrientation((Node-1)*9 + 2) = OpFM%m%ActForceMotionsPoints(k)%Orientation(2,1,J) - OpFM%u%pOrientation((Node-1)*9 + 3) = OpFM%m%ActForceMotionsPoints(k)%Orientation(3,1,J) - OpFM%u%pOrientation((Node-1)*9 + 4) = OpFM%m%ActForceMotionsPoints(k)%Orientation(1,2,J) - OpFM%u%pOrientation((Node-1)*9 + 5) = OpFM%m%ActForceMotionsPoints(k)%Orientation(2,2,J) - OpFM%u%pOrientation((Node-1)*9 + 6) = OpFM%m%ActForceMotionsPoints(k)%Orientation(3,2,J) - OpFM%u%pOrientation((Node-1)*9 + 7) = OpFM%m%ActForceMotionsPoints(k)%Orientation(1,3,J) - OpFM%u%pOrientation((Node-1)*9 + 8) = OpFM%m%ActForceMotionsPoints(k)%Orientation(2,3,J) - OpFM%u%pOrientation((Node-1)*9 + 9) = OpFM%m%ActForceMotionsPoints(k)%Orientation(3,3,J) - - END DO - - END DO - - -END SUBROUTINE SetOpFMPositions -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE SetOpFMForces(p_FAST, p_AD14, u_AD14, y_AD14, u_AD, y_AD, y_ED, OpFM, ErrStat, ErrMsg) - - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM ! data for the OpenFOAM integration module - TYPE(AD14_ParameterType), INTENT(IN) :: p_AD14 ! The input meshes (already calculated) from AeroDyn14 - TYPE(AD14_InputType), INTENT(IN) :: u_AD14 ! The input meshes (already calculated) from AeroDyn14 - TYPE(AD14_OutputType), INTENT(IN) :: y_AD14 ! The output meshes (already calculated) from AeroDyn14 - TYPE(AD_InputType), INTENT(IN) :: u_AD ! The input meshes (already calculated) from AeroDyn - TYPE(AD_OutputType), INTENT(IN) :: y_AD ! The output meshes (already calculated) from AeroDyn - TYPE(ED_OutputType), INTENT(IN) :: y_ED ! The outputs of the structural dynamics module - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST ! FAST parameter data - !TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST ! misc FAST data, including inputs from external codes like Simulink - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - - ! Local variables: - REAL(ReKi) :: dRforceNodes ! Uniform distance between two consecutive blade force nodes - REAL(ReKi) :: dHforceNodes ! Uniform distance between two consecutive tower force nodes - - INTEGER(IntKi) :: J ! Loops through nodes / elements - INTEGER(IntKi) :: K ! Loops through blades. - INTEGER(IntKi) :: Node ! Node number for blade/node on mesh -#ifdef DEBUG_OPENFOAM - INTEGER(IntKi) :: actForcesFile, aerodynForcesFile ! Unit numbers for files containing actuator forces and aerodyn forces -#endif - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'SetOpFMForces' - - ErrStat = ErrID_None - ErrMsg = '' - - !------------------------------------------------------------------------------------------------- - Node = 1 ! undisplaced hub position (no aerodynamics computed here) - OpFM%u%fx(Node) = 0.0_ReKi - OpFM%u%fy(Node) = 0.0_ReKi - OpFM%u%fz(Node) = 0.0_ReKi - - !....................... - ! blade nodes - !....................... - -#ifdef DEBUG_OPENFOAM - CALL GetNewUnit( aerodynForcesFile ) - open(unit=aerodynForcesFile,file='fast_aerodyn_velocity_forces.csv') - write(aerodynForcesFile,*) '#x, y, z, fx, fy, fz' - - CALL GetNewUnit( actForcesFile ) - open(unit=actForcesFile,file='fast_actuator_forces.csv') - write(actForcesFile,*) '#x, y, z, fx, fy, fz' -#endif - - DO K = 1,OpFM%p%NumBl - -#ifdef DEBUG_OPENFOAM - DO J = 1,u_AD%BladeMotion(k)%NNodes - write(aerodynForcesFile,*) u_AD%BladeMotion(k)%TranslationDisp(1,j) + u_AD%BladeMotion(k)%Position(1,j), ', ', u_AD%BladeMotion(k)%TranslationDisp(2,j) + u_AD%BladeMotion(k)%Position(2,j), ', ', u_AD%BladeMotion(k)%TranslationDisp(3,j) + u_AD%BladeMotion(k)%Position(3,j), ', ', OpFM%y%u(1 + (k-1)*u_AD%BladeMotion(k)%NNodes + j), ', ', OpFM%y%v(1 + (k-1)*u_AD%BladeMotion(k)%NNodes + j), ', ', OpFM%y%w(1 + (k-1)*u_AD%BladeMotion(k)%NNodes + j), ', ', y_AD%rotors(1)%BladeLoad(k)%Force(1,j), ', ', y_AD%rotors(1)%BladeLoad(k)%Force(2,j), ', ', y_AD%rotors(1)%BladeLoad(k)%Force(2,j) - END DO -#endif - - call Transfer_Line2_to_Line2( y_AD%rotors(1)%BladeLoad(k), OpFM%m%ActForceLoads(k), OpFM%m%Line2_to_Line2_Loads(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), OpFM%m%ActForceMotions(k) ) - call Transfer_Line2_to_Point( OpFM%m%ActForceLoads(k), OpFM%m%ActForceLoadsPoints(k), OpFM%m%Line2_to_Point_Loads(k), ErrStat2, ErrMsg2, OpFM%m%ActForceMotions(k), OpFM%m%ActForceMotionsPoints(k) ) - - DO J = 1, OpFM%p%NnodesForceBlade - Node = Node + 1 - OpFM%u%fx(Node) = OpFM%m%ActForceLoadsPoints(k)%Force(1,j) - OpFM%u%fy(Node) = OpFM%m%ActForceLoadsPoints(k)%Force(2,j) - OpFM%u%fz(Node) = OpFM%m%ActForceLoadsPoints(k)%Force(3,j) - OpFM%u%momentx(Node) = OpFM%m%ActForceLoadsPoints(k)%Moment(1,j) - OpFM%u%momenty(Node) = OpFM%m%ActForceLoadsPoints(k)%Moment(2,j) - OpFM%u%momentz(Node) = OpFM%m%ActForceLoadsPoints(k)%Moment(3,j) - -#ifdef DEBUG_OPENFOAM - write(actForcesFile,*) OpFM%u%pxForce(Node), ', ', OpFM%u%pyForce(Node), ', ', OpFM%u%pzForce(Node), ', ', OpFM%u%fx(Node), ', ', OpFM%u%fy(Node), ', ', OpFM%u%fz(Node), ', ' -#endif - - END DO - - END DO !K = 1,OpFM%p%NumBl - - !....................... - ! tower nodes - !....................... - - ! mesh mapping from line2 mesh to point mesh - DO K = OpFM%p%NumBl+1,OpFM%p%NMappings - -#ifdef DEBUG_OPENFOAM - DO J = 1,u_AD%rotors(1)%TowerMotion%NNodes - write(aerodynForcesFile,*) u_AD%rotors(1)%TowerMotion%TranslationDisp(1,j) + u_AD%rotors(1)%TowerMotion%Position(1,j), ', ', u_AD%rotors(1)%TowerMotion%TranslationDisp(2,j) + u_AD%rotors(1)%TowerMotion%Position(2,j), ', ', u_AD%TowerMotion%TranslationDisp(3,j) + u_AD%TowerMotion%Position(3,j), ', ', OpFM%y%u(1 + OpFM%p%NumBl*u_AD%BladeMotion(k)%NNodes + j), ', ', OpFM%y%v(1 + OpFM%p%NumBl*u_AD%BladeMotion(k)%NNodes + j), ', ', OpFM%y%w(1 + OpFM%p%NumBl*u_AD%BladeMotion(k)%NNodes + j), ', ', y_AD%rotors(1)%TowerLoad%Force(1,j), ', ', y_AD%rotors(1)%TowerLoad%Force(2,j), ', ', y_AD%rotors(1)%TowerLoad%Force(2,j) - END DO -#endif - - call Transfer_Line2_to_Line2( y_AD%rotors(1)%TowerLoad, OpFM%m%ActForceLoads(k), OpFM%m%Line2_to_Line2_Loads(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%TowerMotion, OpFM%m%ActForceMotions(k) ) - call Transfer_Line2_to_Point( OpFM%m%ActForceLoads(k), OpFM%m%ActForceLoadsPoints(k), OpFM%m%Line2_to_Point_Loads(k), ErrStat2, ErrMsg2, OpFM%m%ActForceMotions(k), OpFM%m%ActForceMotionsPoints(k) ) - - DO J=1,OpFM%p%NnodesForceTower - Node = Node + 1 - OpFM%u%fx(Node) = OpFM%m%ActForceLoadsPoints(k)%Force(1,j) - OpFM%u%fy(Node) = OpFM%m%ActForceLoadsPoints(k)%Force(2,j) - OpFM%u%fz(Node) = OpFM%m%ActForceLoadsPoints(k)%Force(3,j) - OpFM%u%momentx(Node) = OpFM%m%ActForceLoadsPoints(k)%Moment(1,j) - OpFM%u%momenty(Node) = OpFM%m%ActForceLoadsPoints(k)%Moment(2,j) - OpFM%u%momentz(Node) = OpFM%m%ActForceLoadsPoints(k)%Moment(3,j) - -#ifdef DEBUG_OPENFOAM - write(actForcesFile,*) OpFM%u%pxForce(Node), ', ', OpFM%u%pyForce(Node), ', ', OpFM%u%pzForce(Node), ', ', OpFM%u%fx(Node), ', ', OpFM%u%fy(Node), ', ', OpFM%u%fz(Node), ', ' -#endif - END DO - -#ifdef DEBUG_OPENFOAM - close(aerodynForcesFile) - close(actForcesFile) -#endif - - END DO - -END SUBROUTINE SetOpFMForces -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE OpFM_SetWriteOutput( OpFM ) -!.................................................................................................................................. - - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM ! data for the OpenFOAM integration module - - ! set the hub-height wind speeds - IF ( ALLOCATED( OpFM%y%WriteOutput ) ) THEN - IF ( ASSOCIATED( OpFM%y%u ) ) then - OpFM%y%WriteOutput(1) = OpFM%y%u(1) - OpFM%y%WriteOutput(2) = OpFM%y%v(1) - OpFM%y%WriteOutput(3) = OpFM%y%w(1) - END IF - END IF - - - -END SUBROUTINE OpFM_SetWriteOutput -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE OpFM_CreateActForceMotionsMesh( p_FAST, y_ED, InitIn_OpFM, OpFM, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST ! Parameters for the glue code - TYPE(ED_OutputType), INTENT(IN) :: y_ED ! The outputs of the structural dynamics module - TYPE(OpFM_InitInputType), INTENT(IN ) :: InitIn_OpFM ! InitInp data for the OpenFOAM integration module - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM ! data for the OpenFOAM integration module - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - ! local variables - TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: tmpActForceMotionsMesh !< temporary mesh for interpolating orientation to actuator force points [-] - INTEGER(IntKi) :: k ! blade loop counter - INTEGER(IntKi) :: i,j ! node counter - - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_CreateActForceMotionsMesh' - - ! Initialize variables - - ErrStat = ErrID_None - ErrMsg = "" - - ! Allocate space for mapping data structures - ALLOCATE(tmpActForceMotionsMesh(OpFM%p%NMappings) , STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating force nodes mesh mapping types', ErrStat, ErrMsg, RoutineName) - RETURN - END IF - CALL OpFM_CreateTmpActForceMotionsMesh( p_FAST, y_ED, OpFM%p, InitIn_OpFM, tmpActForceMotionsMesh, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (errStat >= AbortErrLev) return - - ALLOCATE(OpFM%m%ActForceMotions(OpFM%p%NMappings), STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating force nodes mesh', ErrStat, ErrMsg, RoutineName) - RETURN - END IF - ALLOCATE(OpFM%m%ActForceMotionsPoints(OpFM%p%NMappings), STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating force nodes mesh', ErrStat, ErrMsg, RoutineName) - RETURN - END IF - DO k=1,OpFM%p%NumBl - call MeshCreate ( BlankMesh = OpFM%m%ActForceMotions(k) & - ,IOS = COMPONENT_INPUT & - ,Nnodes = OpFM%p%NnodesForceBlade & - ,Orientation = .true. & - ,TranslationDisp = .true. & - ,TranslationVel = .true. & - ,RotationVel = .true. & - ,ErrStat = ErrStat2 & - ,ErrMess = ErrMsg2 & - ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - OpFM%m%ActForceMotions(k)%RemapFlag = .false. - - call MeshCreate ( BlankMesh = OpFM%m%ActForceMotionsPoints(k) & - ,IOS = COMPONENT_INPUT & - ,Nnodes = OpFM%p%NnodesForceBlade & - ,Orientation = .true. & - ,TranslationDisp = .true. & - ,TranslationVel = .true. & - ,RotationVel = .true. & - ,ErrStat = ErrStat2 & - ,ErrMess = ErrMsg2 & - ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - OpFM%m%ActForceMotions(k)%RemapFlag = .false. - - do j=1,OpFM%p%NnodesForceBlade - call MeshPositionNode(OpFM%m%ActForceMotions(k), j, tmpActForceMotionsMesh(k)%position(:,j), errStat2, errMsg2, & - orient=tmpActForceMotionsMesh(k)%Orientation(:,:,j) ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - call MeshPositionNode(OpFM%m%ActForceMotionsPoints(k), j, tmpActForceMotionsMesh(k)%position(:,j), errStat2, errMsg2, & - orient=tmpActForceMotionsMesh(k)%Orientation(:,:,j) ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call MeshConstructElement(OpFM%m%ActForceMotionsPoints(k), ELEMENT_POINT, errStat2, errMsg2, p1=j ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - end do !j - - ! create elements: - DO J = 2,OpFM%p%NnodesForceBlade - call MeshConstructElement ( Mesh = OpFM%m%ActForceMotions(k) & - , Xelement = ELEMENT_LINE2 & - , P1 = J-1 & ! node1 number - , P2 = J & ! node2 number - , ErrStat = ErrStat2 & - , ErrMess = ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - END DO ! J (blade nodes) - call MeshCommit(OpFM%m%ActForceMotions(k), errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (errStat >= AbortErrLev) return - call MeshCommit(OpFM%m%ActForceMotionsPoints(k), errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (errStat >= AbortErrLev) return - END DO - - DO k=OpFM%p%NumBl+1,OpFM%p%NMappings !Tower if present - call MeshCreate ( BlankMesh = OpFM%m%ActForceMotions(k) & - ,IOS = COMPONENT_INPUT & - ,Nnodes = OpFM%p%NnodesForceTower & - ,Orientation = .true. & - ,TranslationDisp = .true. & - ,TranslationVel = .true. & - ,RotationVel = .true. & - ,ErrStat = ErrStat2 & - ,ErrMess = ErrMsg2 & - ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - OpFM%m%ActForceMotions(k)%RemapFlag = .false. - - call MeshCreate ( BlankMesh = OpFM%m%ActForceMotionsPoints(k) & - ,IOS = COMPONENT_INPUT & - ,Nnodes = OpFM%p%NnodesForceTower & - ,Orientation = .true. & - ,TranslationDisp = .true. & - ,TranslationVel = .true. & - ,RotationVel = .true. & - ,ErrStat = ErrStat2 & - ,ErrMess = ErrMsg2 & - ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - OpFM%m%ActForceMotionsPoints(k)%RemapFlag = .false. - - do j=1,OpFM%p%NnodesForceTower - call MeshPositionNode(OpFM%m%ActForceMotions(k), j, tmpActForceMotionsMesh(k)%position(:,j), errStat2, errMsg2, & - orient=tmpActForceMotionsMesh(k)%Orientation(:,:,j) ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - call MeshPositionNode(OpFM%m%ActForceMotionsPoints(k), j, tmpActForceMotionsMesh(k)%position(:,j), errStat2, errMsg2, & - orient=tmpActForceMotionsMesh(k)%Orientation(:,:,j) ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call MeshConstructElement(OpFM%m%ActForceMotionsPoints(k), ELEMENT_POINT, errStat2, errMsg2, p1=j ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - end do !j - ! create elements: - DO J = 2,OpFM%p%NnodesForceTower - call MeshConstructElement ( Mesh = OpFM%m%ActForceMotions(k) & - , Xelement = ELEMENT_LINE2 & - , P1 = J-1 & ! node1 number - , P2 = J & ! node2 number - , ErrStat = ErrStat2 & - , ErrMess = ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - END DO ! J (tower nodes) - - call MeshCommit(OpFM%m%ActForceMotions(k), errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (errStat >= AbortErrLev) return - call MeshCommit(OpFM%m%ActForceMotionsPoints(k), errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (errStat >= AbortErrLev) return - END DO - - DO k=1,OpFM%p%NMappings - call MeshDestroy ( tmpActForceMotionsMesh(k), ErrStat2, ErrMsg2 ) - END DO - DEALLOCATE(tmpActForceMotionsMesh) - -END SUBROUTINE OpFM_CreateActForceMotionsMesh -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE OpFM_CreateTmpActForceMotionsMesh( p_FAST, y_ED, p_OpFM, InitIn_OpFM, tmpActForceMotions, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST ! Parameters for the glue code - TYPE(ED_OutputType), INTENT(IN ) :: y_ED ! The outputs of the structural dynamics module - TYPE(OpFM_ParameterType), INTENT(IN ) :: p_OpFM ! data for the OpenFOAM integration module - TYPE(OpFM_InitInputType), INTENT(IN ) :: InitIn_OpFM ! InitInp data for the OpenFOAM integration module - TYPE(MeshType), INTENT(INOUT) :: tmpActForceMotions(:) ! temporary mesh to create the actuator force nodes - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - ! local variables - TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: tmp_line2_to_point_Motions !< mapping data structure to convert orientation of structural nodes to actuator force nodes [-] - TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: tmp_StructModelMesh !< temporary mesh copying Structural model mesh - REAL(ReKi), DIMENSION(:,:), ALLOCATABLE :: forceNodePositions ! new positions for the force actuator nodes - INTEGER(IntKi) :: NumBl ! number of blades - INTEGER(IntKi) :: k ! blade loop counter - INTEGER(IntKi) :: i,j ! node counter - - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_CreateTmpActForceMotionsMesh' - - ! Initialize variables - - ErrStat = ErrID_None - ErrMsg = "" - - ! Make a copy of the Structural model mesh with the reference orientation set to zero - ALLOCATE(tmp_StructModelMesh(p_OpFM%NMappings) , STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating temporary copy of ElastoDyn mesh type', ErrStat, ErrMsg, RoutineName) - RETURN - END IF - CALL CreateTmpStructModelMesh(p_FAST, y_ED, p_OpFM, tmp_StructModelMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - - ! Allocate space for mapping data structures - ALLOCATE( tmp_line2_to_point_Motions(p_OpFM%NMappings),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating temporary actuator force mesh mapping types', ErrStat, ErrMsg, RoutineName) - RETURN - END IF - - ! create meshes to map: - ALLOCATE(forceNodePositions(3,p_OpFM%NnodesForceBlade)) ! Allocate space to create new positions - DO k=1,p_OpFM%NumBl - call MeshCreate ( BlankMesh = tmpActForceMotions(k) & - ,IOS = COMPONENT_INPUT & - ,Nnodes = p_OpFM%NnodesForceBlade & - ,ErrStat = ErrStat2 & - ,ErrMess = ErrMsg2 & - ,force = .false. & - ,moment = .false. & - ,orientation = .true. & - ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - - tmpActForceMotions(k)%RemapFlag = .false. - call CalcForceActuatorPositionsBlade(InitIn_OpFM, p_OpFM, tmp_StructModelMesh(k)%position, forceNodePositions, errStat2, errMsg2) - do j=1,p_OpFM%NnodesForceBlade - call MeshPositionNode(tmpActForceMotions(k), j, forceNodePositions(:,j), errStat2, errMsg2) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - call MeshConstructElement( tmpActForceMotions(k), ELEMENT_POINT, errStat2, errMsg2, p1=j ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - end do !j - - call MeshCommit(tmpActForceMotions(k), errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (errStat >= AbortErrLev) return - end do - DEALLOCATE(forceNodePositions) ! Free space - - ALLOCATE(forceNodePositions(3,p_OpFM%NnodesForceTower)) ! Allocate space to create new positions - DO k=p_OpFM%NumBl+1,p_OpFM%NMappings - call CalcForceActuatorPositionsTower(InitIn_OpFM, p_OpFM, tmp_StructModelMesh(k)%position, forceNodePositions, errStat2, errMsg2) - - call MeshCreate ( BlankMesh = tmpActForceMotions(k) & - ,IOS = COMPONENT_INPUT & - ,Nnodes = p_OpFM%NnodesForceTower & - ,ErrStat = ErrStat2 & - ,ErrMess = ErrMsg2 & - ,force = .false. & - ,moment = .false. & - ,orientation = .true. & - ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - - tmpActForceMotions(k)%RemapFlag = .false. - do j=1,p_OpFM%NnodesForceTower - call MeshPositionNode(tmpActForceMotions(k), j, forceNodePositions(:,j), errStat2, errMsg2) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - call MeshConstructElement( tmpActForceMotions(k), ELEMENT_POINT, errStat2, errMsg2, p1=j ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - end do !j - - call MeshCommit(tmpActForceMotions(k), errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (errStat >= AbortErrLev) return - END DO - DEALLOCATE(forceNodePositions) ! Free space - - ! create the mapping data structures: - DO k=1,p_OpFM%NumBl - call MeshMapCreate( tmp_StructModelMesh(k), tmpActForceMotions(k), tmp_line2_to_point_Motions(k), ErrStat2, ErrMsg2 ); - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - DO k=p_OpFM%NumBl+1,p_OpFM%NMappings - call MeshMapCreate( tmp_StructModelMesh(k), tmpActForceMotions(k), tmp_line2_to_point_Motions(k), ErrStat2, ErrMsg2 ); - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - ! Map the orientation - DO K = 1,p_OpFM%NMappings - ! mesh mapping from line2 mesh to point mesh - call Transfer_Line2_to_Point( tmp_StructModelMesh(k), tmpActForceMotions(k), tmp_line2_to_point_Motions(k), ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END DO - - DO k=1,p_OpFM%NMappings - call MeshDestroy ( tmp_StructModelMesh(k), ErrStat2, ErrMsg2 ) - call MeshMapDestroy ( tmp_line2_to_point_Motions(k), ErrStat2, ErrMsg2 ) - END DO - DEALLOCATE(tmp_StructModelMesh) - DEALLOCATE(tmp_line2_to_point_Motions) - - RETURN - -END SUBROUTINE OpFM_CreateTmpActForceMotionsMesh -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE CreateTmpStructModelMesh(p_FAST, y_ED, p_OpFM, tmpStructModelMesh, ErrStat, ErrMsg ) - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST ! Parameters for the glue code - TYPE(ED_OutputType), INTENT(IN ) :: y_ED ! The outputs of the structural dynamics module - TYPE(OpFM_ParameterType), INTENT(IN ) :: p_OpFM ! Parameters of the OpenFOAM integration module - TYPE(MeshType), INTENT(INOUT) :: tmpStructModelMesh(:) ! temporary copy of structural model mesh - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - - !Local variables - INTEGER(IntKi) :: nNodesStructModel ! Number of nodes (tower/blade) in the structural model mesh - - INTEGER(IntKi) :: i,j ! node counter - INTEGER(IntKi) :: k ! blade counter - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'CreateTmpStructModelMesh' - - - IF (p_FAST%CompElast == Module_ED ) THEN - - - DO K = 1,p_OpFM%NumBl - - nNodesStructModel = SIZE(y_ED%BladeLn2Mesh(K)%position(1,:)) - - CALL MeshCreate( BlankMesh = tmpStructModelMesh(K) & - , NNodes = nNodesStructModel & - , IOS = COMPONENT_OUTPUT & - , Orientation = .TRUE. & - , ErrStat = ErrStat2 & - , ErrMess = ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - - tmpStructModelMesh(K)%RemapFlag = .false. - !For some reason, ElastoDyn keeps the last point as the blade/tower root - CALL MeshPositionNode ( tmpStructModelMesh(K), 1, y_ED%BladeLn2Mesh(K)%Position(:,nNodesStructModel), ErrStat2, ErrMsg2 ) - DO J = 1,nNodesStructModel-1 - CALL MeshPositionNode ( tmpStructModelMesh(K), J+1, y_ED%BladeLn2Mesh(K)%Position(:,J), ErrStat2, ErrMsg2 ) - END DO - - ! create elements: - DO J = 2,nNodesStructModel - - CALL MeshConstructElement ( Mesh = tmpStructModelMesh(K) & - , Xelement = ELEMENT_LINE2 & - , P1 = J-1 & ! node1 number - , P2 = J & ! node2 number - , ErrStat = ErrStat2 & - , ErrMess = ErrMsg2 ) - END DO ! J (blade nodes) - - ! that's our entire mesh: - CALL MeshCommit ( tmpStructModelMesh(K), ErrStat2, ErrMsg2 ) - - ! Copy the orientation - tmpStructModelMesh(K)%Orientation(:,:,1) = y_ED%BladeLn2Mesh(k)%RefOrientation(:,:,nNodesStructModel) - DO J=1,nNodesStructModel-1 - tmpStructModelMesh(K)%Orientation(:,:,J+1) = y_ED%BladeLn2Mesh(K)%RefOrientation(:,:,J) - END DO - - END DO - - DO K = p_OpFM%NumBl+1, p_OpFM%NMappings - - nNodesStructModel = SIZE(y_ED%TowerLn2Mesh%position(1,:)) - - CALL MeshCreate( BlankMesh = tmpStructModelMesh(K) & - , NNodes = nNodesStructModel & - , IOS = COMPONENT_OUTPUT & - , Orientation = .TRUE. & - , ErrStat = ErrStat2 & - , ErrMess = ErrMsg2 ) - - tmpStructModelMesh(K)%RemapFlag = .false. - !For some reason, ElastoDyn keeps the last point as the blade/tower root - CALL MeshPositionNode ( tmpStructModelMesh(K), 1, y_ED%TowerLn2Mesh%Position(:,nNodesStructModel), ErrStat2, ErrMsg2 ) - DO J = 1,nNodesStructModel-1 - CALL MeshPositionNode ( tmpStructModelMesh(K), J+1, y_ED%TowerLn2Mesh%Position(:,J), ErrStat2, ErrMsg2 ) - END DO - - ! create elements: - DO J = 2,nNodesStructModel - - CALL MeshConstructElement ( Mesh = tmpStructModelMesh(K) & - , Xelement = ELEMENT_LINE2 & - , P1 = J-1 & ! node1 number - , P2 = J & ! node2 number - , ErrStat = ErrStat2 & - , ErrMess = ErrMsg2 ) - - END DO ! J (blade nodes) - - ! that's our entire mesh: - CALL MeshCommit ( tmpStructModelMesh(K), ErrStat2, ErrMsg2 ) - - ! Copy the orientation - tmpStructModelMesh(K)%Orientation(:,:,1) = y_ED%TowerLn2Mesh%RefOrientation(:,:,nNodesStructModel) - DO J=1,nNodesStructModel-1 - tmpStructModelMesh(K)%Orientation(:,:,J+1) = y_ED%TowerLn2Mesh%RefOrientation(:,:,J) - END DO - - END DO - - - ELSEIF (p_FAST%CompElast == Module_BD ) THEN - - CALL SetErrStat(ErrID_Fatal, 'Error BeamDyn is not supported yet with OpenFOAM module', ErrStat, ErrMsg, RoutineName) - RETURN - - END IF - - RETURN -END SUBROUTINE CreateTmpStructModelMesh -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE CalcForceActuatorPositionsBlade(InitIn_OpFM, p_OpFM, structPositions, forceNodePositions, ErrStat2, ErrMsg2) - - TYPE(OpFM_InitInputType), INTENT(IN ) :: InitIn_OpFM ! data for the OpenFOAM integration module - TYPE(OpFM_ParameterType), INTENT(IN ) :: p_OpFM ! data for the OpenFOAM integration module - REAL(ReKi), POINTER :: structPositions(:,:) ! structural model positions - REAL(ReKi), INTENT(INOUT) :: forceNodePositions(:,:) ! Array to store the newly created positions - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - - !Local variables - INTEGER(IntKi) :: nStructNodes ! Number of velocity nodes - REAL(ReKi), DIMENSION(:), ALLOCATABLE :: rStructNodes ! Distance of velocity nodes from the first node - Used as a parameter for curve fitting - INTEGER(IntKI) :: i ! Loop variables - INTEGER(IntKI) :: jLower ! Index of the struct node just smaller than the force node - REAL(ReKi) :: rInterp ! The location of this force node in (0,1) co-ordinates between the jLower and jLower+1 nodes - - nStructNodes = SIZE(structPositions,2) - ALLOCATE(rStructNodes(nStructNodes), STAT=ErrStat2) - - ! Store the distance of the structural model nodes from the root into an array - rStructNodes(1) = 0.0 ! First node - rStructNodes(2:nStructNodes-1) = InitIn_OpFM%StructBldRnodes(:) - rStructNodes(nStructNodes) = p_OpFM%BladeLength - - ! Now calculate the positions of the force nodes based on interpolation - forceNodePositions(:,1) = structPositions(:,1) - DO I=2,p_OpFM%NnodesForceBlade-1 ! Calculate the position of the force nodes - do jLower = 1, (nStructNodes - 1) - if ((rStructNodes(jLower) - p_OpFM%forceBldRnodes(I))*(rStructNodes(jLower+1) - p_OpFM%forceBldRnodes(I)) .le. 0) then - exit - endif - end do - rInterp = (p_OpFM%forceBldRnodes(I) - rStructNodes(jLower))/(rStructNodes(jLower+1)-rStructNodes(jLower)) ! The location of this force node in (0,1) co-ordinates between the jLower and jLower+1 nodes - forceNodePositions(:,I) = structPositions(:,jLower) + rInterp * (structPositions(:,jLower+1) - structPositions(:,jLower)) - END DO - forceNodePositions(:,p_OpFM%NnodesForceBlade) = structPositions(:,nStructNodes) - - DEALLOCATE(rStructNodes) - - RETURN - -END SUBROUTINE CalcForceActuatorPositionsBlade -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE CalcForceActuatorPositionsTower(InitIn_OpFM, p_OpFM, structPositions, forceNodePositions, ErrStat, ErrMsg) - - TYPE(OpFM_InitInputType), INTENT(IN ) :: InitIn_OpFM ! data for the OpenFOAM integration module - TYPE(OpFM_ParameterType), INTENT(IN ) :: p_OpFM ! data for the OpenFOAM integration module - REAL(ReKi), POINTER :: structPositions(:,:) ! structural model positions - REAL(ReKi), INTENT(INOUT) :: forceNodePositions(:,:) ! Array to store the newly created positions - INTEGER(IntKi) , intent(out) :: ErrStat ! temporary Error status of the operation - CHARACTER(ErrMsgLen) , intent(out) :: ErrMsg ! temporary Error message if ErrStat /= ErrID_None - - - !Local variables - INTEGER(IntKi) :: nStructNodes ! Number of velocity nodes - REAL(ReKi), DIMENSION(:), ALLOCATABLE :: hStructNodes ! Distance of velocity nodes from the first node - Used as a parameter for curve fitting - INTEGER(IntKI) :: i ! Loop variables - INTEGER(IntKI) :: jLower ! Index of the struct node just smaller than the force node - REAL(ReKi) :: hInterp ! The location of this force node in (0,1) co-ordinates between the jLower and jLower+1 nodes - - nStructNodes = SIZE(structPositions,2) - ALLOCATE(hStructNodes(nStructNodes), STAT=ErrStat) - IF (ErrStat /= 0) then - ErrStat=ErrID_Fatal - ErrMsg = "error allocating hStructNodes" - return - ELSE - ErrStat = ErrID_None - ErrMsg = "" - END IF - - ! Store the distance of the structural model nodes from the root into an array - hStructNodes(1) = 0.0 ! First node - hStructNodes(2:nStructNodes-1) = InitIn_OpFM%StructTwrHnodes(:) - hStructNodes(nStructNodes) = p_OpFM%TowerHeight - - ! Now calculate the positions of the force nodes based on interpolation - forceNodePositions(:,1) = structPositions(:,1) - DO I=2,p_OpFM%NnodesForceTower-1 ! Calculate the position of the force nodes - do jLower = 1, (nStructNodes - 1) - if ((hStructNodes(jLower) - p_OpFM%forceTwrHnodes(I))*(hStructNodes(jLower+1) - p_OpFM%forceTwrHnodes(I)) .le. 0) then - exit - endif - enddo - hInterp = (p_OpFM%forceTwrHnodes(I) - hStructNodes(jLower))/(hStructNodes(jLower+1)-hStructNodes(jLower)) ! The location of this force node in (0,1) co-ordinates between the jLower and jLower+1 nodes - forceNodePositions(:,I) = structPositions(:,jLower) + hInterp * (structPositions(:,jLower+1) - structPositions(:,jLower)) - END DO - forceNodePositions(:,p_OpFM%NnodesForceTower) = structPositions(:,nStructNodes) - DEALLOCATE(hStructNodes) - - RETURN - -END SUBROUTINE CalcForceActuatorPositionsTower - -SUBROUTINE OpFM_CreateActForceBladeTowerNodes(p_OpFM, ErrStat, ErrMsg) -!Creates the blade and tower nodes in radial and tower height co-ordinates - - TYPE(OpFM_ParameterType), INTENT(INOUT) :: p_OpFM ! data for the OpenFOAM integration module - INTEGER(IntKi) :: ErrStat ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg ! temporary Error message if ErrStat /= ErrID_None - - !Local variables - REAL(ReKi) :: dRforceNodes ! Uniform distance between two consecutive force nodes - INTEGER(IntKI) :: i ! Loop variables - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - - ErrStat = ErrID_None - ErrMsg = "" - - ! Line2 to Line2 mapping expects the destination mesh to be smaller than the source mesh for deformation mapping and larger than the source mesh for load mapping. This forces me to create nodes at the very ends of the blade. - - !Do the blade first - allocate(p_OpFM%forceBldRnodes(p_OpFM%NnodesForceBlade), stat=errStat2) - dRforceNodes = p_OpFM%BladeLength/(p_OpFM%NnodesForceBlade-1) - do i=1,p_OpFM%NnodesForceBlade-1 - p_OpFM%forceBldRnodes(i) = (i-1)*dRforceNodes - end do - p_OpFM%forceBldRnodes(p_OpFM%NnodesForceBlade) = p_OpFM%BladeLength - - - if (p_OpFM%NMappings .gt. p_OpFM%NumBl) then - !Do the tower now - allocate(p_OpFM%forceTwrHnodes(p_OpFM%NnodesForceTower), stat=errStat2) - dRforceNodes = p_OpFM%TowerHeight/(p_OpFM%NnodesForceTower-1) - do i=1,p_OpFM%NnodesForceTower-1 - p_OpFM%forceTwrHnodes(i) = (i-1)*dRforceNodes - end do - p_OpFM%forceTwrHnodes(p_OpFM%NnodesForceTower) = p_OpFM%TowerHeight - end if - - return - -END SUBROUTINE OpFM_CreateActForceBladeTowerNodes - -SUBROUTINE OpFM_InterpolateForceNodesChord(InitOut_AD, p_OpFM, u_OpFM, ErrStat, ErrMsg) - - !Interpolates the chord distribution to the force nodes - - TYPE(AD_InitOutputType), INTENT(IN ) :: InitOut_AD ! InitOut data for the OpenFOAM integration module - TYPE(OpFM_ParameterType), INTENT(IN ) :: p_OpFM ! Input data for the OpenFOAM integration module - TYPE(OpFM_InputType), INTENT(INOUT) :: u_OpFM ! Parameter data for the OpenFOAM integration module - INTEGER(IntKi) :: ErrStat ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg ! temporary Error message if ErrStat /= ErrID_None - - !Local variables - INTEGER(IntKI) :: i,k,node ! Loop variables - INTEGER(IntKI) :: nNodesBladeProps ! Number of nodes in the blade properties for a given blade - INTEGER(IntKI) :: nNodesTowerProps ! Number of nodes in the tower properties - INTEGER(IntKI) :: jLower ! Index of the blade properties node just smaller than the force node - REAL(ReKi) :: rInterp ! The location of this force node in (0,1) co-ordinates between the jLower and jLower+1 nodes - - ErrStat = ErrID_None - ErrMsg = "" - - ! Set the chord for the hub node to be zero. Ideally, I'd like this to be the hub radius. Will figure this out later. - Node = 1 - u_OpFM%forceNodesChord(Node) = 0.0_ReKi - - ! The blades first - do k = 1, p_OpFM%NumBl - ! Calculate the chord at the force nodes based on interpolation - nNodesBladeProps = SIZE(InitOut_AD%rotors(1)%BladeProps(k)%BlChord) - DO I=1,p_OpFM%NnodesForceBlade - Node = Node + 1 - do jLower = 1, (nNodesBladeProps - 1) - if ( (InitOut_AD%rotors(1)%BladeProps(k)%BlSpn(jLower) - p_OpFM%forceBldRnodes(I))*(InitOut_AD%rotors(1)%BladeProps(k)%BlSpn(jLower+1) - p_OpFM%forceBldRnodes(I)) .le. 0 ) then - exit - endif - enddo - if (jLower .lt. nNodesBladeProps) then - rInterp = (p_OpFM%forceBldRnodes(I) - InitOut_AD%rotors(1)%BladeProps(k)%BlSpn(jLower))/(InitOut_AD%rotors(1)%BladeProps(k)%BlSpn(jLower+1)-InitOut_AD%rotors(1)%BladeProps(k)%BlSpn(jLower)) ! The location of this force node in (0,1) co-ordinates between the jLower and jLower+1 nodes - u_OpFM%forceNodesChord(Node) = InitOut_AD%rotors(1)%BladeProps(k)%BlChord(jLower) + rInterp * (InitOut_AD%rotors(1)%BladeProps(k)%BlChord(jLower+1) - InitOut_AD%rotors(1)%BladeProps(k)%BlChord(jLower)) - else - u_OpFM%forceNodesChord(Node) = InitOut_AD%rotors(1)%BladeProps(k)%BlChord(nNodesBladeProps) !Work around for when the last node of the actuator mesh is slightly outside of the Aerodyn blade properties. Surprisingly this is not an issue with the tower. - end if - END DO - - - end do - - - ! The tower now - do k = p_OpFM%NumBl+1,p_OpFM%NMappings - nNodesTowerProps = SIZE(InitOut_AD%rotors(1)%TwrElev) - ! Calculate the chord at the force nodes based on interpolation - DO I=1,p_OpFM%NnodesForceTower - Node = Node + 1 - do jLower = 1, (nNodesTowerProps - 1) - if ( (InitOut_AD%rotors(1)%TwrElev(jLower) - p_OpFM%forceTwrHnodes(I)-p_OpFM%TowerBaseHeight)*(InitOut_AD%rotors(1)%TwrElev(jLower+1) - p_OpFM%forceTwrHnodes(I)-p_OpFM%TowerBaseHeight) .le. 0) then - exit - endif - enddo - if (jLower .lt. nNodesTowerProps) then - rInterp = (p_OpFM%forceTwrHnodes(I)+p_OpFM%TowerBaseHeight - InitOut_AD%rotors(1)%TwrElev(jLower))/(InitOut_AD%rotors(1)%TwrElev(jLower+1)-InitOut_AD%rotors(1)%TwrElev(jLower)) ! The location of this force node in (0,1) co-ordinates between the jLower and jLower+1 nodes - u_OpFM%forceNodesChord(Node) = InitOut_AD%rotors(1)%TwrDiam(jLower) + rInterp * (InitOut_AD%rotors(1)%TwrDiam(jLower+1) - InitOut_AD%rotors(1)%TwrDiam(jLower)) - else - u_OpFM%forceNodesChord(Node) = InitOut_AD%rotors(1)%TwrDiam(nNodesTowerProps) !Work around for when the last node of the actuator mesh is slightly outside of the Aerodyn tower properties. - end if - END DO - end do - -END SUBROUTINE OpFM_InterpolateForceNodesChord - -END MODULE OpenFOAM -!********************************************************************************************************************************** diff --git a/OpenFAST/modules/openfoam/src/OpenFOAM_Registry.txt b/OpenFAST/modules/openfoam/src/OpenFOAM_Registry.txt deleted file mode 100644 index bb1e5a0f0..000000000 --- a/OpenFAST/modules/openfoam/src/OpenFOAM_Registry.txt +++ /dev/null @@ -1,81 +0,0 @@ -################################################################################################################################### -# Registry for OpenFOAM - CFD interface types in the FAST Modularization Framework -# 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 - - - -# ..... OpenFOAM_InitInputType data ....................................................................................................... -typedef OpenFOAM/OpFM InitInputType IntKi NumActForcePtsBlade - - - "number of actuator line force points in blade" - -typedef ^ ^ IntKi NumActForcePtsTower - - - "number of actuator line force points in tower" - -typedef ^ ^ ReKi StructBldRNodes {:} - - "Radius to structural model analysis nodes relative to hub" -typedef ^ ^ ReKi StructTwrHNodes {:} - - "Location of variable-spaced structural model tower nodes (relative to the tower rigid base height)" -typedef ^ ^ ReKi BladeLength - - - "Blade length" meters -typedef ^ ^ ReKi TowerHeight - - - "Tower Height" meters -typedef ^ ^ ReKi TowerBaseHeight - - - "Tower Base Height" meters - - - - - -# ..... OpenFOAM_InitOutputType data ....................................................................................................... -# Define outputs from the initialization routine here: -typedef OpenFOAM/OpFM InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - -typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - -typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - - -# ..... MiscVars ................................................................................................................ -typedef OpenFOAM/OpFM OpFM_MiscVarType MeshType ActForceLoads {:} - - "line2 mesh for transferring AeroDyn distributed loads to OpenFOAM" - -typedef ^ ^ MeshType ActForceMotions {:} - - "line2 mesh for transferring AeroDyn distributed loads to OpenFOAM (needs translationDisp)" - -typedef ^ ^ MeshType ActForceMotionsPoints {:} - - "point mesh for transferring AeroDyn distributed loads to OpenFOAM (needs translationDisp)" - -typedef ^ ^ MeshType ActForceLoadsPoints {:} - - "point mesh for transferring AeroDyn distributed loads to OpenFOAM" - -typedef ^ ^ MeshMapType Line2_to_Line2_Loads {:} - - "mapping data structure to convert line2 loads to line2 loads" - -typedef ^ ^ MeshMapType Line2_to_Line2_Motions {:} - - "mapping data structure to convert line2 loads to line2 motions" - -typedef ^ ^ MeshMapType Line2_to_Point_Loads {:} - - "mapping data structure to convert line2 loads to point loads" - -typedef ^ ^ MeshMapType Line2_to_Point_Motions {:} - - "mapping data structure to convert line2 loads to point motions" - - - -# ..... Parameters ................................................................................................................ -typedef OpenFOAM/OpFM ParameterType ReKi AirDens - - - "Air density for normalization of loads sent to OpenFOAM" kg/m^3 -typedef OpenFOAM/OpFM ParameterType IntKi NumBl - - - "Number of blades" - -typedef OpenFOAM/OpFM ParameterType IntKi NMappings - - - "Number of mappings" - -typedef OpenFOAM/OpFM ParameterType IntKi NnodesVel - - - "number of velocity nodes on FAST v8-OpenFOAM interface" - -typedef OpenFOAM/OpFM ParameterType IntKi NnodesForce - - - "number of force nodes on FAST v8-OpenFOAM interface" - -typedef OpenFOAM/OpFM ParameterType IntKi NnodesForceBlade - - - "number of force nodes on FAST v8-OpenFOAM interface" - -typedef OpenFOAM/OpFM ParameterType IntKi NnodesForceTower - - - "number of force nodes on FAST v8-OpenFOAM interface" - -typedef ^ ^ ReKi forceBldRnodes {:} "Radial location of force nodes" - -typedef ^ ^ ReKi forceTwrHnodes {:} "Radial location of force nodes" - -typedef ^ ^ ReKi BladeLength - - - "Blade length (same for all blades)" "m" -typedef ^ ^ ReKi TowerHeight - - - "Tower height" "m" -typedef ^ ^ ReKi TowerBaseHeight - - - "Tower base height" "m" - - -# ..... OpenFOAM_InputType data ....................................................................................................... -typedef ^ InputType ReKi pxVel {:} - - "x position of velocity interface (Aerodyn) nodes" "m" -typedef ^ InputType ReKi pyVel {:} - - "y position of velocity interface (Aerodyn) nodes" "m" -typedef ^ InputType ReKi pzVel {:} - - "z position of velocity interface (Aerodyn) nodes" "m" -typedef ^ InputType ReKi pxForce {:} - - "x position of actuator force nodes" "m" -typedef ^ InputType ReKi pyForce {:} - - "y position of actuator force nodes" "m" -typedef ^ InputType ReKi pzForce {:} - - "z position of actuator force nodes" "m" -typedef ^ InputType ReKi xdotForce {:} - - "x velocity of actuator force nodes" "m/s" -typedef ^ InputType ReKi ydotForce {:} - - "y velocity of actuator force nodes" "m/s" -typedef ^ InputType ReKi zdotForce {:} - - "z velocity of actuator force nodes" "m/s" -typedef ^ InputType ReKi pOrientation {:} - - "Direction cosine matrix to transform vectors from global frame of reference to actuator force node frame of reference" - -typedef ^ InputType ReKi fx {:} - - "normalized x force at actuator force nodes" "N/kg/m^3" -typedef ^ InputType ReKi fy {:} - - "normalized y force at actuator force nodes" "N/kg/m^3" -typedef ^ InputType ReKi fz {:} - - "normalized z force at actuator force nodes" "N/kg/m^3" -typedef ^ InputType ReKi momentx {:} - - "normalized x moment at actuator force nodes" "Nm/kg/m^3" -typedef ^ InputType ReKi momenty {:} - - "normalized y moment at actuator force nodes" "Nm/kg/m^3" -typedef ^ InputType ReKi momentz {:} - - "normalized z moment at actuator force nodes" "Nm/kg/m^3" -typedef ^ InputType ReKi forceNodesChord {:} - - "chord distribution at the actuator force nodes" "m" - -# ..... OpenFOAM_OutputType data ....................................................................................................... -typedef OpenFOAM/OpFM OutputType ReKi u {:} - - "U-component wind speed (in the X-direction) at interface nodes" m/s -typedef ^ OutputType ReKi v {:} - - "V-component wind speed (in the Y-direction) at interface nodes" m/s -typedef ^ OutputType ReKi w {:} - - "W-component wind speed (in the Z-direction) at interface nodes" m/s -typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" diff --git a/OpenFAST/modules/openfoam/src/OpenFOAM_Types.f90 b/OpenFAST/modules/openfoam/src/OpenFOAM_Types.f90 deleted file mode 100644 index cea50b0c4..000000000 --- a/OpenFAST/modules/openfoam/src/OpenFOAM_Types.f90 +++ /dev/null @@ -1,5266 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'OpenFOAM_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 -!********************************************************************************************************************************* -! OpenFOAM_Types -!................................................................................................................................. -! This file is part of OpenFOAM. -! -! 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 OpenFOAM. 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 OpenFOAM_Types -!--------------------------------------------------------------------------------------------------------------------------------- -!USE, INTRINSIC :: ISO_C_Binding -USE NWTC_Library -IMPLICIT NONE -! ========= OpFM_InitInputType_C ======= - TYPE, BIND(C) :: OpFM_InitInputType_C - TYPE(C_PTR) :: object = C_NULL_PTR - INTEGER(KIND=C_INT) :: NumActForcePtsBlade - INTEGER(KIND=C_INT) :: NumActForcePtsTower - TYPE(C_ptr) :: StructBldRNodes = C_NULL_PTR - INTEGER(C_int) :: StructBldRNodes_Len = 0 - TYPE(C_ptr) :: StructTwrHNodes = C_NULL_PTR - INTEGER(C_int) :: StructTwrHNodes_Len = 0 - REAL(KIND=C_FLOAT) :: BladeLength - REAL(KIND=C_FLOAT) :: TowerHeight - REAL(KIND=C_FLOAT) :: TowerBaseHeight - END TYPE OpFM_InitInputType_C - TYPE, PUBLIC :: OpFM_InitInputType - TYPE( OpFM_InitInputType_C ) :: C_obj - INTEGER(IntKi) :: NumActForcePtsBlade !< number of actuator line force points in blade [-] - INTEGER(IntKi) :: NumActForcePtsTower !< number of actuator line force points in tower [-] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: StructBldRNodes => NULL() !< Radius to structural model analysis nodes relative to hub [-] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: StructTwrHNodes => NULL() !< Location of variable-spaced structural model tower nodes (relative to the tower rigid base height) [-] - REAL(ReKi) :: BladeLength !< Blade length [meters] - REAL(ReKi) :: TowerHeight !< Tower Height [meters] - REAL(ReKi) :: TowerBaseHeight !< Tower Base Height [meters] - END TYPE OpFM_InitInputType -! ======================= -! ========= OpFM_InitOutputType_C ======= - TYPE, BIND(C) :: OpFM_InitOutputType_C - TYPE(C_PTR) :: object = C_NULL_PTR - TYPE(C_ptr) :: WriteOutputHdr = C_NULL_PTR - INTEGER(C_int) :: WriteOutputHdr_Len = 0 - TYPE(C_ptr) :: WriteOutputUnt = C_NULL_PTR - INTEGER(C_int) :: WriteOutputUnt_Len = 0 - END TYPE OpFM_InitOutputType_C - TYPE, PUBLIC :: OpFM_InitOutputType - TYPE( OpFM_InitOutputType_C ) :: C_obj - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] - TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - END TYPE OpFM_InitOutputType -! ======================= -! ========= OpFM_MiscVarType_C ======= - TYPE, BIND(C) :: OpFM_MiscVarType_C - TYPE(C_PTR) :: object = C_NULL_PTR - END TYPE OpFM_MiscVarType_C - TYPE, PUBLIC :: OpFM_MiscVarType - TYPE( OpFM_MiscVarType_C ) :: C_obj - TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: ActForceLoads !< line2 mesh for transferring AeroDyn distributed loads to OpenFOAM [-] - TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: ActForceMotions !< line2 mesh for transferring AeroDyn distributed loads to OpenFOAM (needs translationDisp) [-] - TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: ActForceMotionsPoints !< point mesh for transferring AeroDyn distributed loads to OpenFOAM (needs translationDisp) [-] - TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: ActForceLoadsPoints !< point mesh for transferring AeroDyn distributed loads to OpenFOAM [-] - TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: Line2_to_Line2_Loads !< mapping data structure to convert line2 loads to line2 loads [-] - TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: Line2_to_Line2_Motions !< mapping data structure to convert line2 loads to line2 motions [-] - TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: Line2_to_Point_Loads !< mapping data structure to convert line2 loads to point loads [-] - TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: Line2_to_Point_Motions !< mapping data structure to convert line2 loads to point motions [-] - END TYPE OpFM_MiscVarType -! ======================= -! ========= OpFM_ParameterType_C ======= - TYPE, BIND(C) :: OpFM_ParameterType_C - TYPE(C_PTR) :: object = C_NULL_PTR - REAL(KIND=C_FLOAT) :: AirDens - INTEGER(KIND=C_INT) :: NumBl - INTEGER(KIND=C_INT) :: NMappings - INTEGER(KIND=C_INT) :: NnodesVel - INTEGER(KIND=C_INT) :: NnodesForce - INTEGER(KIND=C_INT) :: NnodesForceBlade - INTEGER(KIND=C_INT) :: NnodesForceTower - TYPE(C_ptr) :: forceBldRnodes = C_NULL_PTR - INTEGER(C_int) :: forceBldRnodes_Len = 0 - TYPE(C_ptr) :: forceTwrHnodes = C_NULL_PTR - INTEGER(C_int) :: forceTwrHnodes_Len = 0 - REAL(KIND=C_FLOAT) :: BladeLength - REAL(KIND=C_FLOAT) :: TowerHeight - REAL(KIND=C_FLOAT) :: TowerBaseHeight - END TYPE OpFM_ParameterType_C - TYPE, PUBLIC :: OpFM_ParameterType - TYPE( OpFM_ParameterType_C ) :: C_obj - REAL(ReKi) :: AirDens !< Air density for normalization of loads sent to OpenFOAM [kg/m^3] - INTEGER(IntKi) :: NumBl !< Number of blades [-] - INTEGER(IntKi) :: NMappings !< Number of mappings [-] - INTEGER(IntKi) :: NnodesVel !< number of velocity nodes on FAST v8-OpenFOAM interface [-] - INTEGER(IntKi) :: NnodesForce !< number of force nodes on FAST v8-OpenFOAM interface [-] - INTEGER(IntKi) :: NnodesForceBlade !< number of force nodes on FAST v8-OpenFOAM interface [-] - INTEGER(IntKi) :: NnodesForceTower !< number of force nodes on FAST v8-OpenFOAM interface [-] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: forceBldRnodes => NULL() - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: forceTwrHnodes => NULL() - REAL(ReKi) :: BladeLength !< Blade length (same for all blades) [m] - REAL(ReKi) :: TowerHeight !< Tower height [m] - REAL(ReKi) :: TowerBaseHeight !< Tower base height [m] - END TYPE OpFM_ParameterType -! ======================= -! ========= OpFM_InputType_C ======= - TYPE, BIND(C) :: OpFM_InputType_C - TYPE(C_PTR) :: object = C_NULL_PTR - TYPE(C_ptr) :: pxVel = C_NULL_PTR - INTEGER(C_int) :: pxVel_Len = 0 - TYPE(C_ptr) :: pyVel = C_NULL_PTR - INTEGER(C_int) :: pyVel_Len = 0 - TYPE(C_ptr) :: pzVel = C_NULL_PTR - INTEGER(C_int) :: pzVel_Len = 0 - TYPE(C_ptr) :: pxForce = C_NULL_PTR - INTEGER(C_int) :: pxForce_Len = 0 - TYPE(C_ptr) :: pyForce = C_NULL_PTR - INTEGER(C_int) :: pyForce_Len = 0 - TYPE(C_ptr) :: pzForce = C_NULL_PTR - INTEGER(C_int) :: pzForce_Len = 0 - TYPE(C_ptr) :: xdotForce = C_NULL_PTR - INTEGER(C_int) :: xdotForce_Len = 0 - TYPE(C_ptr) :: ydotForce = C_NULL_PTR - INTEGER(C_int) :: ydotForce_Len = 0 - TYPE(C_ptr) :: zdotForce = C_NULL_PTR - INTEGER(C_int) :: zdotForce_Len = 0 - TYPE(C_ptr) :: pOrientation = C_NULL_PTR - INTEGER(C_int) :: pOrientation_Len = 0 - TYPE(C_ptr) :: fx = C_NULL_PTR - INTEGER(C_int) :: fx_Len = 0 - TYPE(C_ptr) :: fy = C_NULL_PTR - INTEGER(C_int) :: fy_Len = 0 - TYPE(C_ptr) :: fz = C_NULL_PTR - INTEGER(C_int) :: fz_Len = 0 - TYPE(C_ptr) :: momentx = C_NULL_PTR - INTEGER(C_int) :: momentx_Len = 0 - TYPE(C_ptr) :: momenty = C_NULL_PTR - INTEGER(C_int) :: momenty_Len = 0 - TYPE(C_ptr) :: momentz = C_NULL_PTR - INTEGER(C_int) :: momentz_Len = 0 - TYPE(C_ptr) :: forceNodesChord = C_NULL_PTR - INTEGER(C_int) :: forceNodesChord_Len = 0 - END TYPE OpFM_InputType_C - TYPE, PUBLIC :: OpFM_InputType - TYPE( OpFM_InputType_C ) :: C_obj - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: pxVel => NULL() !< x position of velocity interface (Aerodyn) nodes [m] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: pyVel => NULL() !< y position of velocity interface (Aerodyn) nodes [m] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: pzVel => NULL() !< z position of velocity interface (Aerodyn) nodes [m] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: pxForce => NULL() !< x position of actuator force nodes [m] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: pyForce => NULL() !< y position of actuator force nodes [m] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: pzForce => NULL() !< z position of actuator force nodes [m] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: xdotForce => NULL() !< x velocity of actuator force nodes [m/s] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: ydotForce => NULL() !< y velocity of actuator force nodes [m/s] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: zdotForce => NULL() !< z velocity of actuator force nodes [m/s] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: pOrientation => NULL() !< Direction cosine matrix to transform vectors from global frame of reference to actuator force node frame of reference [-] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: fx => NULL() !< normalized x force at actuator force nodes [N/kg/m^3] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: fy => NULL() !< normalized y force at actuator force nodes [N/kg/m^3] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: fz => NULL() !< normalized z force at actuator force nodes [N/kg/m^3] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: momentx => NULL() !< normalized x moment at actuator force nodes [Nm/kg/m^3] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: momenty => NULL() !< normalized y moment at actuator force nodes [Nm/kg/m^3] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: momentz => NULL() !< normalized z moment at actuator force nodes [Nm/kg/m^3] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: forceNodesChord => NULL() !< chord distribution at the actuator force nodes [m] - END TYPE OpFM_InputType -! ======================= -! ========= OpFM_OutputType_C ======= - TYPE, BIND(C) :: OpFM_OutputType_C - TYPE(C_PTR) :: object = C_NULL_PTR - TYPE(C_ptr) :: u = C_NULL_PTR - INTEGER(C_int) :: u_Len = 0 - TYPE(C_ptr) :: v = C_NULL_PTR - INTEGER(C_int) :: v_Len = 0 - TYPE(C_ptr) :: w = C_NULL_PTR - INTEGER(C_int) :: w_Len = 0 - TYPE(C_ptr) :: WriteOutput = C_NULL_PTR - INTEGER(C_int) :: WriteOutput_Len = 0 - END TYPE OpFM_OutputType_C - TYPE, PUBLIC :: OpFM_OutputType - TYPE( OpFM_OutputType_C ) :: C_obj - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: u => NULL() !< U-component wind speed (in the X-direction) at interface nodes [m/s] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: v => NULL() !< V-component wind speed (in the Y-direction) at interface nodes [m/s] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: w => NULL() !< W-component wind speed (in the Z-direction) at interface nodes [m/s] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] - END TYPE OpFM_OutputType -! ======================= -CONTAINS - SUBROUTINE OpFM_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpFM_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(OpFM_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%NumActForcePtsBlade = SrcInitInputData%NumActForcePtsBlade - DstInitInputData%C_obj%NumActForcePtsBlade = SrcInitInputData%C_obj%NumActForcePtsBlade - DstInitInputData%NumActForcePtsTower = SrcInitInputData%NumActForcePtsTower - DstInitInputData%C_obj%NumActForcePtsTower = SrcInitInputData%C_obj%NumActForcePtsTower -IF (ASSOCIATED(SrcInitInputData%StructBldRNodes)) THEN - i1_l = LBOUND(SrcInitInputData%StructBldRNodes,1) - i1_u = UBOUND(SrcInitInputData%StructBldRNodes,1) - IF (.NOT. ASSOCIATED(DstInitInputData%StructBldRNodes)) THEN - ALLOCATE(DstInitInputData%StructBldRNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%StructBldRNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInitInputData%c_obj%StructBldRNodes_Len = SIZE(DstInitInputData%StructBldRNodes) - IF (DstInitInputData%c_obj%StructBldRNodes_Len > 0) & - DstInitInputData%c_obj%StructBldRNodes = C_LOC( DstInitInputData%StructBldRNodes(i1_l) ) - END IF - DstInitInputData%StructBldRNodes = SrcInitInputData%StructBldRNodes -ENDIF -IF (ASSOCIATED(SrcInitInputData%StructTwrHNodes)) THEN - i1_l = LBOUND(SrcInitInputData%StructTwrHNodes,1) - i1_u = UBOUND(SrcInitInputData%StructTwrHNodes,1) - IF (.NOT. ASSOCIATED(DstInitInputData%StructTwrHNodes)) THEN - ALLOCATE(DstInitInputData%StructTwrHNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%StructTwrHNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInitInputData%c_obj%StructTwrHNodes_Len = SIZE(DstInitInputData%StructTwrHNodes) - IF (DstInitInputData%c_obj%StructTwrHNodes_Len > 0) & - DstInitInputData%c_obj%StructTwrHNodes = C_LOC( DstInitInputData%StructTwrHNodes(i1_l) ) - END IF - DstInitInputData%StructTwrHNodes = SrcInitInputData%StructTwrHNodes -ENDIF - DstInitInputData%BladeLength = SrcInitInputData%BladeLength - DstInitInputData%C_obj%BladeLength = SrcInitInputData%C_obj%BladeLength - DstInitInputData%TowerHeight = SrcInitInputData%TowerHeight - DstInitInputData%C_obj%TowerHeight = SrcInitInputData%C_obj%TowerHeight - DstInitInputData%TowerBaseHeight = SrcInitInputData%TowerBaseHeight - DstInitInputData%C_obj%TowerBaseHeight = SrcInitInputData%C_obj%TowerBaseHeight - END SUBROUTINE OpFM_CopyInitInput - - SUBROUTINE OpFM_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyInitInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(InitInputData%StructBldRNodes)) THEN - DEALLOCATE(InitInputData%StructBldRNodes) - InitInputData%StructBldRNodes => NULL() - InitInputData%C_obj%StructBldRNodes = C_NULL_PTR - InitInputData%C_obj%StructBldRNodes_Len = 0 -ENDIF -IF (ASSOCIATED(InitInputData%StructTwrHNodes)) THEN - DEALLOCATE(InitInputData%StructTwrHNodes) - InitInputData%StructTwrHNodes => NULL() - InitInputData%C_obj%StructTwrHNodes = C_NULL_PTR - InitInputData%C_obj%StructTwrHNodes_Len = 0 -ENDIF - END SUBROUTINE OpFM_DestroyInitInput - - SUBROUTINE OpFM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OpFM_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NumActForcePtsBlade - Int_BufSz = Int_BufSz + 1 ! NumActForcePtsTower - Int_BufSz = Int_BufSz + 1 ! StructBldRNodes allocated yes/no - IF ( ASSOCIATED(InData%StructBldRNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StructBldRNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StructBldRNodes) ! StructBldRNodes - END IF - Int_BufSz = Int_BufSz + 1 ! StructTwrHNodes allocated yes/no - IF ( ASSOCIATED(InData%StructTwrHNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StructTwrHNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StructTwrHNodes) ! StructTwrHNodes - END IF - Re_BufSz = Re_BufSz + 1 ! BladeLength - Re_BufSz = Re_BufSz + 1 ! TowerHeight - Re_BufSz = Re_BufSz + 1 ! TowerBaseHeight - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%NumActForcePtsBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumActForcePtsTower - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ASSOCIATED(InData%StructBldRNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StructBldRNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StructBldRNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StructBldRNodes,1), UBOUND(InData%StructBldRNodes,1) - ReKiBuf(Re_Xferred) = InData%StructBldRNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%StructTwrHNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StructTwrHNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StructTwrHNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StructTwrHNodes,1), UBOUND(InData%StructTwrHNodes,1) - ReKiBuf(Re_Xferred) = InData%StructTwrHNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerBaseHeight - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE OpFM_PackInitInput - - SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OpFM_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%NumActForcePtsBlade = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumActForcePtsBlade = OutData%NumActForcePtsBlade - OutData%NumActForcePtsTower = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumActForcePtsTower = OutData%NumActForcePtsTower - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StructBldRNodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%StructBldRNodes)) DEALLOCATE(OutData%StructBldRNodes) - ALLOCATE(OutData%StructBldRNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StructBldRNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%StructBldRNodes_Len = SIZE(OutData%StructBldRNodes) - IF (OutData%c_obj%StructBldRNodes_Len > 0) & - OutData%c_obj%StructBldRNodes = C_LOC( OutData%StructBldRNodes(i1_l) ) - DO i1 = LBOUND(OutData%StructBldRNodes,1), UBOUND(OutData%StructBldRNodes,1) - OutData%StructBldRNodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StructTwrHNodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%StructTwrHNodes)) DEALLOCATE(OutData%StructTwrHNodes) - ALLOCATE(OutData%StructTwrHNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StructTwrHNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%StructTwrHNodes_Len = SIZE(OutData%StructTwrHNodes) - IF (OutData%c_obj%StructTwrHNodes_Len > 0) & - OutData%c_obj%StructTwrHNodes = C_LOC( OutData%StructTwrHNodes(i1_l) ) - DO i1 = LBOUND(OutData%StructTwrHNodes,1), UBOUND(OutData%StructTwrHNodes,1) - OutData%StructTwrHNodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%BladeLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%BladeLength = OutData%BladeLength - OutData%TowerHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%TowerHeight = OutData%TowerHeight - OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight - END SUBROUTINE OpFM_UnPackInitInput - - SUBROUTINE OpFM_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%NumActForcePtsBlade = InitInputData%C_obj%NumActForcePtsBlade - InitInputData%NumActForcePtsTower = InitInputData%C_obj%NumActForcePtsTower - - ! -- StructBldRNodes InitInput Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructBldRNodes ) ) THEN - NULLIFY( InitInputData%StructBldRNodes ) - ELSE - CALL C_F_POINTER(InitInputData%C_obj%StructBldRNodes, InitInputData%StructBldRNodes, (/InitInputData%C_obj%StructBldRNodes_Len/)) - END IF - END IF - - ! -- StructTwrHNodes InitInput Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructTwrHNodes ) ) THEN - NULLIFY( InitInputData%StructTwrHNodes ) - ELSE - CALL C_F_POINTER(InitInputData%C_obj%StructTwrHNodes, InitInputData%StructTwrHNodes, (/InitInputData%C_obj%StructTwrHNodes_Len/)) - END IF - END IF - InitInputData%BladeLength = InitInputData%C_obj%BladeLength - InitInputData%TowerHeight = InitInputData%C_obj%TowerHeight - InitInputData%TowerBaseHeight = InitInputData%C_obj%TowerBaseHeight - END SUBROUTINE OpFM_C2Fary_CopyInitInput - - SUBROUTINE OpFM_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%C_obj%NumActForcePtsBlade = InitInputData%NumActForcePtsBlade - InitInputData%C_obj%NumActForcePtsTower = InitInputData%NumActForcePtsTower - - ! -- StructBldRNodes InitInput Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InitInputData%StructBldRNodes)) THEN - InitInputData%c_obj%StructBldRNodes_Len = 0 - InitInputData%c_obj%StructBldRNodes = C_NULL_PTR - ELSE - InitInputData%c_obj%StructBldRNodes_Len = SIZE(InitInputData%StructBldRNodes) - IF (InitInputData%c_obj%StructBldRNodes_Len > 0) & - InitInputData%c_obj%StructBldRNodes = C_LOC( InitInputData%StructBldRNodes( LBOUND(InitInputData%StructBldRNodes,1) ) ) - END IF - END IF - - ! -- StructTwrHNodes InitInput Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InitInputData%StructTwrHNodes)) THEN - InitInputData%c_obj%StructTwrHNodes_Len = 0 - InitInputData%c_obj%StructTwrHNodes = C_NULL_PTR - ELSE - InitInputData%c_obj%StructTwrHNodes_Len = SIZE(InitInputData%StructTwrHNodes) - IF (InitInputData%c_obj%StructTwrHNodes_Len > 0) & - InitInputData%c_obj%StructTwrHNodes = C_LOC( InitInputData%StructTwrHNodes( LBOUND(InitInputData%StructTwrHNodes,1) ) ) - END IF - END IF - InitInputData%C_obj%BladeLength = InitInputData%BladeLength - InitInputData%C_obj%TowerHeight = InitInputData%TowerHeight - InitInputData%C_obj%TowerBaseHeight = InitInputData%TowerBaseHeight - END SUBROUTINE OpFM_F2C_CopyInitInput - - SUBROUTINE OpFM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpFM_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(OpFM_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE OpFM_CopyInitOutput - - SUBROUTINE OpFM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyInitOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, ErrMsg ) - END SUBROUTINE OpFM_DestroyInitOutput - - SUBROUTINE OpFM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OpFM_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE OpFM_PackInitOutput - - SUBROUTINE OpFM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OpFM_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE OpFM_UnPackInitOutput - - SUBROUTINE OpFM_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - END SUBROUTINE OpFM_C2Fary_CopyInitOutput - - SUBROUTINE OpFM_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - END SUBROUTINE OpFM_F2C_CopyInitOutput - - SUBROUTINE OpFM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpFM_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(OpFM_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%ActForceLoads)) THEN - i1_l = LBOUND(SrcMiscData%ActForceLoads,1) - i1_u = UBOUND(SrcMiscData%ActForceLoads,1) - IF (.NOT. ALLOCATED(DstMiscData%ActForceLoads)) THEN - ALLOCATE(DstMiscData%ActForceLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ActForceLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%ActForceLoads,1), UBOUND(SrcMiscData%ActForceLoads,1) - CALL MeshCopy( SrcMiscData%ActForceLoads(i1), DstMiscData%ActForceLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%ActForceMotions)) THEN - i1_l = LBOUND(SrcMiscData%ActForceMotions,1) - i1_u = UBOUND(SrcMiscData%ActForceMotions,1) - IF (.NOT. ALLOCATED(DstMiscData%ActForceMotions)) THEN - ALLOCATE(DstMiscData%ActForceMotions(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ActForceMotions.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%ActForceMotions,1), UBOUND(SrcMiscData%ActForceMotions,1) - CALL MeshCopy( SrcMiscData%ActForceMotions(i1), DstMiscData%ActForceMotions(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%ActForceMotionsPoints)) THEN - i1_l = LBOUND(SrcMiscData%ActForceMotionsPoints,1) - i1_u = UBOUND(SrcMiscData%ActForceMotionsPoints,1) - IF (.NOT. ALLOCATED(DstMiscData%ActForceMotionsPoints)) THEN - ALLOCATE(DstMiscData%ActForceMotionsPoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ActForceMotionsPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%ActForceMotionsPoints,1), UBOUND(SrcMiscData%ActForceMotionsPoints,1) - CALL MeshCopy( SrcMiscData%ActForceMotionsPoints(i1), DstMiscData%ActForceMotionsPoints(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%ActForceLoadsPoints)) THEN - i1_l = LBOUND(SrcMiscData%ActForceLoadsPoints,1) - i1_u = UBOUND(SrcMiscData%ActForceLoadsPoints,1) - IF (.NOT. ALLOCATED(DstMiscData%ActForceLoadsPoints)) THEN - ALLOCATE(DstMiscData%ActForceLoadsPoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ActForceLoadsPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%ActForceLoadsPoints,1), UBOUND(SrcMiscData%ActForceLoadsPoints,1) - CALL MeshCopy( SrcMiscData%ActForceLoadsPoints(i1), DstMiscData%ActForceLoadsPoints(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%Line2_to_Line2_Loads)) THEN - i1_l = LBOUND(SrcMiscData%Line2_to_Line2_Loads,1) - i1_u = UBOUND(SrcMiscData%Line2_to_Line2_Loads,1) - IF (.NOT. ALLOCATED(DstMiscData%Line2_to_Line2_Loads)) THEN - ALLOCATE(DstMiscData%Line2_to_Line2_Loads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line2_to_Line2_Loads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%Line2_to_Line2_Loads,1), UBOUND(SrcMiscData%Line2_to_Line2_Loads,1) - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%Line2_to_Line2_Loads(i1), DstMiscData%Line2_to_Line2_Loads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%Line2_to_Line2_Motions)) THEN - i1_l = LBOUND(SrcMiscData%Line2_to_Line2_Motions,1) - i1_u = UBOUND(SrcMiscData%Line2_to_Line2_Motions,1) - IF (.NOT. ALLOCATED(DstMiscData%Line2_to_Line2_Motions)) THEN - ALLOCATE(DstMiscData%Line2_to_Line2_Motions(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line2_to_Line2_Motions.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%Line2_to_Line2_Motions,1), UBOUND(SrcMiscData%Line2_to_Line2_Motions,1) - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%Line2_to_Line2_Motions(i1), DstMiscData%Line2_to_Line2_Motions(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%Line2_to_Point_Loads)) THEN - i1_l = LBOUND(SrcMiscData%Line2_to_Point_Loads,1) - i1_u = UBOUND(SrcMiscData%Line2_to_Point_Loads,1) - IF (.NOT. ALLOCATED(DstMiscData%Line2_to_Point_Loads)) THEN - ALLOCATE(DstMiscData%Line2_to_Point_Loads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line2_to_Point_Loads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%Line2_to_Point_Loads,1), UBOUND(SrcMiscData%Line2_to_Point_Loads,1) - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%Line2_to_Point_Loads(i1), DstMiscData%Line2_to_Point_Loads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%Line2_to_Point_Motions)) THEN - i1_l = LBOUND(SrcMiscData%Line2_to_Point_Motions,1) - i1_u = UBOUND(SrcMiscData%Line2_to_Point_Motions,1) - IF (.NOT. ALLOCATED(DstMiscData%Line2_to_Point_Motions)) THEN - ALLOCATE(DstMiscData%Line2_to_Point_Motions(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line2_to_Point_Motions.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%Line2_to_Point_Motions,1), UBOUND(SrcMiscData%Line2_to_Point_Motions,1) - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%Line2_to_Point_Motions(i1), DstMiscData%Line2_to_Point_Motions(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE OpFM_CopyMisc - - SUBROUTINE OpFM_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(OpFM_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyMisc' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(MiscData%ActForceLoads)) THEN -DO i1 = LBOUND(MiscData%ActForceLoads,1), UBOUND(MiscData%ActForceLoads,1) - CALL MeshDestroy( MiscData%ActForceLoads(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(MiscData%ActForceLoads) -ENDIF -IF (ALLOCATED(MiscData%ActForceMotions)) THEN -DO i1 = LBOUND(MiscData%ActForceMotions,1), UBOUND(MiscData%ActForceMotions,1) - CALL MeshDestroy( MiscData%ActForceMotions(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(MiscData%ActForceMotions) -ENDIF -IF (ALLOCATED(MiscData%ActForceMotionsPoints)) THEN -DO i1 = LBOUND(MiscData%ActForceMotionsPoints,1), UBOUND(MiscData%ActForceMotionsPoints,1) - CALL MeshDestroy( MiscData%ActForceMotionsPoints(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(MiscData%ActForceMotionsPoints) -ENDIF -IF (ALLOCATED(MiscData%ActForceLoadsPoints)) THEN -DO i1 = LBOUND(MiscData%ActForceLoadsPoints,1), UBOUND(MiscData%ActForceLoadsPoints,1) - CALL MeshDestroy( MiscData%ActForceLoadsPoints(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(MiscData%ActForceLoadsPoints) -ENDIF -IF (ALLOCATED(MiscData%Line2_to_Line2_Loads)) THEN -DO i1 = LBOUND(MiscData%Line2_to_Line2_Loads,1), UBOUND(MiscData%Line2_to_Line2_Loads,1) - CALL NWTC_Library_Destroymeshmaptype( MiscData%Line2_to_Line2_Loads(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(MiscData%Line2_to_Line2_Loads) -ENDIF -IF (ALLOCATED(MiscData%Line2_to_Line2_Motions)) THEN -DO i1 = LBOUND(MiscData%Line2_to_Line2_Motions,1), UBOUND(MiscData%Line2_to_Line2_Motions,1) - CALL NWTC_Library_Destroymeshmaptype( MiscData%Line2_to_Line2_Motions(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(MiscData%Line2_to_Line2_Motions) -ENDIF -IF (ALLOCATED(MiscData%Line2_to_Point_Loads)) THEN -DO i1 = LBOUND(MiscData%Line2_to_Point_Loads,1), UBOUND(MiscData%Line2_to_Point_Loads,1) - CALL NWTC_Library_Destroymeshmaptype( MiscData%Line2_to_Point_Loads(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(MiscData%Line2_to_Point_Loads) -ENDIF -IF (ALLOCATED(MiscData%Line2_to_Point_Motions)) THEN -DO i1 = LBOUND(MiscData%Line2_to_Point_Motions,1), UBOUND(MiscData%Line2_to_Point_Motions,1) - CALL NWTC_Library_Destroymeshmaptype( MiscData%Line2_to_Point_Motions(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(MiscData%Line2_to_Point_Motions) -ENDIF - END SUBROUTINE OpFM_DestroyMisc - - SUBROUTINE OpFM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OpFM_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! ActForceLoads allocated yes/no - IF ( ALLOCATED(InData%ActForceLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ActForceLoads upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%ActForceLoads,1), UBOUND(InData%ActForceLoads,1) - Int_BufSz = Int_BufSz + 3 ! ActForceLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%ActForceLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ActForceLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ActForceLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ActForceLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ActForceLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ActForceMotions allocated yes/no - IF ( ALLOCATED(InData%ActForceMotions) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ActForceMotions upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ActForceMotions,1), UBOUND(InData%ActForceMotions,1) - Int_BufSz = Int_BufSz + 3 ! ActForceMotions: size of buffers for each call to pack subtype - CALL MeshPack( InData%ActForceMotions(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ActForceMotions - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ActForceMotions - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ActForceMotions - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ActForceMotions - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ActForceMotionsPoints allocated yes/no - IF ( ALLOCATED(InData%ActForceMotionsPoints) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ActForceMotionsPoints upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ActForceMotionsPoints,1), UBOUND(InData%ActForceMotionsPoints,1) - Int_BufSz = Int_BufSz + 3 ! ActForceMotionsPoints: size of buffers for each call to pack subtype - CALL MeshPack( InData%ActForceMotionsPoints(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ActForceMotionsPoints - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ActForceMotionsPoints - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ActForceMotionsPoints - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ActForceMotionsPoints - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ActForceLoadsPoints allocated yes/no - IF ( ALLOCATED(InData%ActForceLoadsPoints) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ActForceLoadsPoints upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ActForceLoadsPoints,1), UBOUND(InData%ActForceLoadsPoints,1) - Int_BufSz = Int_BufSz + 3 ! ActForceLoadsPoints: size of buffers for each call to pack subtype - CALL MeshPack( InData%ActForceLoadsPoints(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ActForceLoadsPoints - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ActForceLoadsPoints - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ActForceLoadsPoints - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ActForceLoadsPoints - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Line2_to_Line2_Loads allocated yes/no - IF ( ALLOCATED(InData%Line2_to_Line2_Loads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Line2_to_Line2_Loads upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Line2_to_Line2_Loads,1), UBOUND(InData%Line2_to_Line2_Loads,1) - Int_BufSz = Int_BufSz + 3 ! Line2_to_Line2_Loads: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Line2_to_Line2_Loads(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Line2_to_Line2_Loads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Line2_to_Line2_Loads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Line2_to_Line2_Loads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Line2_to_Line2_Loads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Line2_to_Line2_Motions allocated yes/no - IF ( ALLOCATED(InData%Line2_to_Line2_Motions) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Line2_to_Line2_Motions upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Line2_to_Line2_Motions,1), UBOUND(InData%Line2_to_Line2_Motions,1) - Int_BufSz = Int_BufSz + 3 ! Line2_to_Line2_Motions: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Line2_to_Line2_Motions(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Line2_to_Line2_Motions - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Line2_to_Line2_Motions - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Line2_to_Line2_Motions - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Line2_to_Line2_Motions - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Line2_to_Point_Loads allocated yes/no - IF ( ALLOCATED(InData%Line2_to_Point_Loads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Line2_to_Point_Loads upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Line2_to_Point_Loads,1), UBOUND(InData%Line2_to_Point_Loads,1) - Int_BufSz = Int_BufSz + 3 ! Line2_to_Point_Loads: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Line2_to_Point_Loads(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Line2_to_Point_Loads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Line2_to_Point_Loads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Line2_to_Point_Loads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Line2_to_Point_Loads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Line2_to_Point_Motions allocated yes/no - IF ( ALLOCATED(InData%Line2_to_Point_Motions) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Line2_to_Point_Motions upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Line2_to_Point_Motions,1), UBOUND(InData%Line2_to_Point_Motions,1) - Int_BufSz = Int_BufSz + 3 ! Line2_to_Point_Motions: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Line2_to_Point_Motions(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Line2_to_Point_Motions - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Line2_to_Point_Motions - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Line2_to_Point_Motions - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Line2_to_Point_Motions - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%ActForceLoads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ActForceLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ActForceLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ActForceLoads,1), UBOUND(InData%ActForceLoads,1) - CALL MeshPack( InData%ActForceLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ActForceLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ActForceMotions) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ActForceMotions,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ActForceMotions,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ActForceMotions,1), UBOUND(InData%ActForceMotions,1) - CALL MeshPack( InData%ActForceMotions(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ActForceMotions - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ActForceMotionsPoints) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ActForceMotionsPoints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ActForceMotionsPoints,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ActForceMotionsPoints,1), UBOUND(InData%ActForceMotionsPoints,1) - CALL MeshPack( InData%ActForceMotionsPoints(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ActForceMotionsPoints - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ActForceLoadsPoints) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ActForceLoadsPoints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ActForceLoadsPoints,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ActForceLoadsPoints,1), UBOUND(InData%ActForceLoadsPoints,1) - CALL MeshPack( InData%ActForceLoadsPoints(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ActForceLoadsPoints - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Line2_to_Line2_Loads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line2_to_Line2_Loads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line2_to_Line2_Loads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Line2_to_Line2_Loads,1), UBOUND(InData%Line2_to_Line2_Loads,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Line2_to_Line2_Loads(i1), ErrStat2, ErrMsg2, OnlySize ) ! Line2_to_Line2_Loads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Line2_to_Line2_Motions) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line2_to_Line2_Motions,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line2_to_Line2_Motions,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Line2_to_Line2_Motions,1), UBOUND(InData%Line2_to_Line2_Motions,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Line2_to_Line2_Motions(i1), ErrStat2, ErrMsg2, OnlySize ) ! Line2_to_Line2_Motions - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Line2_to_Point_Loads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line2_to_Point_Loads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line2_to_Point_Loads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Line2_to_Point_Loads,1), UBOUND(InData%Line2_to_Point_Loads,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Line2_to_Point_Loads(i1), ErrStat2, ErrMsg2, OnlySize ) ! Line2_to_Point_Loads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Line2_to_Point_Motions) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line2_to_Point_Motions,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line2_to_Point_Motions,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Line2_to_Point_Motions,1), UBOUND(InData%Line2_to_Point_Motions,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Line2_to_Point_Motions(i1), ErrStat2, ErrMsg2, OnlySize ) ! Line2_to_Point_Motions - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE OpFM_PackMisc - - SUBROUTINE OpFM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OpFM_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ActForceLoads not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ActForceLoads)) DEALLOCATE(OutData%ActForceLoads) - ALLOCATE(OutData%ActForceLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActForceLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ActForceLoads,1), UBOUND(OutData%ActForceLoads,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%ActForceLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ActForceLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ActForceMotions not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ActForceMotions)) DEALLOCATE(OutData%ActForceMotions) - ALLOCATE(OutData%ActForceMotions(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActForceMotions.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ActForceMotions,1), UBOUND(OutData%ActForceMotions,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%ActForceMotions(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ActForceMotions - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ActForceMotionsPoints not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ActForceMotionsPoints)) DEALLOCATE(OutData%ActForceMotionsPoints) - ALLOCATE(OutData%ActForceMotionsPoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActForceMotionsPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ActForceMotionsPoints,1), UBOUND(OutData%ActForceMotionsPoints,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%ActForceMotionsPoints(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ActForceMotionsPoints - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ActForceLoadsPoints not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ActForceLoadsPoints)) DEALLOCATE(OutData%ActForceLoadsPoints) - ALLOCATE(OutData%ActForceLoadsPoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActForceLoadsPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ActForceLoadsPoints,1), UBOUND(OutData%ActForceLoadsPoints,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%ActForceLoadsPoints(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ActForceLoadsPoints - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Line2_to_Line2_Loads not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Line2_to_Line2_Loads)) DEALLOCATE(OutData%Line2_to_Line2_Loads) - ALLOCATE(OutData%Line2_to_Line2_Loads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line2_to_Line2_Loads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Line2_to_Line2_Loads,1), UBOUND(OutData%Line2_to_Line2_Loads,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%Line2_to_Line2_Loads(i1), ErrStat2, ErrMsg2 ) ! Line2_to_Line2_Loads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Line2_to_Line2_Motions not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Line2_to_Line2_Motions)) DEALLOCATE(OutData%Line2_to_Line2_Motions) - ALLOCATE(OutData%Line2_to_Line2_Motions(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line2_to_Line2_Motions.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Line2_to_Line2_Motions,1), UBOUND(OutData%Line2_to_Line2_Motions,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%Line2_to_Line2_Motions(i1), ErrStat2, ErrMsg2 ) ! Line2_to_Line2_Motions - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Line2_to_Point_Loads not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Line2_to_Point_Loads)) DEALLOCATE(OutData%Line2_to_Point_Loads) - ALLOCATE(OutData%Line2_to_Point_Loads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line2_to_Point_Loads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Line2_to_Point_Loads,1), UBOUND(OutData%Line2_to_Point_Loads,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%Line2_to_Point_Loads(i1), ErrStat2, ErrMsg2 ) ! Line2_to_Point_Loads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Line2_to_Point_Motions not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Line2_to_Point_Motions)) DEALLOCATE(OutData%Line2_to_Point_Motions) - ALLOCATE(OutData%Line2_to_Point_Motions(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line2_to_Point_Motions.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Line2_to_Point_Motions,1), UBOUND(OutData%Line2_to_Point_Motions,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%Line2_to_Point_Motions(i1), ErrStat2, ErrMsg2 ) ! Line2_to_Point_Motions - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE OpFM_UnPackMisc - - SUBROUTINE OpFM_C2Fary_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - END SUBROUTINE OpFM_C2Fary_CopyMisc - - SUBROUTINE OpFM_F2C_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - END SUBROUTINE OpFM_F2C_CopyMisc - - SUBROUTINE OpFM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpFM_ParameterType), INTENT(IN) :: SrcParamData - TYPE(OpFM_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%AirDens = SrcParamData%AirDens - DstParamData%C_obj%AirDens = SrcParamData%C_obj%AirDens - DstParamData%NumBl = SrcParamData%NumBl - DstParamData%C_obj%NumBl = SrcParamData%C_obj%NumBl - DstParamData%NMappings = SrcParamData%NMappings - DstParamData%C_obj%NMappings = SrcParamData%C_obj%NMappings - DstParamData%NnodesVel = SrcParamData%NnodesVel - DstParamData%C_obj%NnodesVel = SrcParamData%C_obj%NnodesVel - DstParamData%NnodesForce = SrcParamData%NnodesForce - DstParamData%C_obj%NnodesForce = SrcParamData%C_obj%NnodesForce - DstParamData%NnodesForceBlade = SrcParamData%NnodesForceBlade - DstParamData%C_obj%NnodesForceBlade = SrcParamData%C_obj%NnodesForceBlade - DstParamData%NnodesForceTower = SrcParamData%NnodesForceTower - DstParamData%C_obj%NnodesForceTower = SrcParamData%C_obj%NnodesForceTower -IF (ASSOCIATED(SrcParamData%forceBldRnodes)) THEN - i1_l = LBOUND(SrcParamData%forceBldRnodes,1) - i1_u = UBOUND(SrcParamData%forceBldRnodes,1) - IF (.NOT. ASSOCIATED(DstParamData%forceBldRnodes)) THEN - ALLOCATE(DstParamData%forceBldRnodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%forceBldRnodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstParamData%c_obj%forceBldRnodes_Len = SIZE(DstParamData%forceBldRnodes) - IF (DstParamData%c_obj%forceBldRnodes_Len > 0) & - DstParamData%c_obj%forceBldRnodes = C_LOC( DstParamData%forceBldRnodes(i1_l) ) - END IF - DstParamData%forceBldRnodes = SrcParamData%forceBldRnodes -ENDIF -IF (ASSOCIATED(SrcParamData%forceTwrHnodes)) THEN - i1_l = LBOUND(SrcParamData%forceTwrHnodes,1) - i1_u = UBOUND(SrcParamData%forceTwrHnodes,1) - IF (.NOT. ASSOCIATED(DstParamData%forceTwrHnodes)) THEN - ALLOCATE(DstParamData%forceTwrHnodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%forceTwrHnodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstParamData%c_obj%forceTwrHnodes_Len = SIZE(DstParamData%forceTwrHnodes) - IF (DstParamData%c_obj%forceTwrHnodes_Len > 0) & - DstParamData%c_obj%forceTwrHnodes = C_LOC( DstParamData%forceTwrHnodes(i1_l) ) - END IF - DstParamData%forceTwrHnodes = SrcParamData%forceTwrHnodes -ENDIF - DstParamData%BladeLength = SrcParamData%BladeLength - DstParamData%C_obj%BladeLength = SrcParamData%C_obj%BladeLength - DstParamData%TowerHeight = SrcParamData%TowerHeight - DstParamData%C_obj%TowerHeight = SrcParamData%C_obj%TowerHeight - DstParamData%TowerBaseHeight = SrcParamData%TowerBaseHeight - DstParamData%C_obj%TowerBaseHeight = SrcParamData%C_obj%TowerBaseHeight - END SUBROUTINE OpFM_CopyParam - - SUBROUTINE OpFM_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyParam' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(ParamData%forceBldRnodes)) THEN - DEALLOCATE(ParamData%forceBldRnodes) - ParamData%forceBldRnodes => NULL() - ParamData%C_obj%forceBldRnodes = C_NULL_PTR - ParamData%C_obj%forceBldRnodes_Len = 0 -ENDIF -IF (ASSOCIATED(ParamData%forceTwrHnodes)) THEN - DEALLOCATE(ParamData%forceTwrHnodes) - ParamData%forceTwrHnodes => NULL() - ParamData%C_obj%forceTwrHnodes = C_NULL_PTR - ParamData%C_obj%forceTwrHnodes_Len = 0 -ENDIF - END SUBROUTINE OpFM_DestroyParam - - SUBROUTINE OpFM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OpFM_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! AirDens - Int_BufSz = Int_BufSz + 1 ! NumBl - Int_BufSz = Int_BufSz + 1 ! NMappings - Int_BufSz = Int_BufSz + 1 ! NnodesVel - Int_BufSz = Int_BufSz + 1 ! NnodesForce - Int_BufSz = Int_BufSz + 1 ! NnodesForceBlade - Int_BufSz = Int_BufSz + 1 ! NnodesForceTower - Int_BufSz = Int_BufSz + 1 ! forceBldRnodes allocated yes/no - IF ( ASSOCIATED(InData%forceBldRnodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! forceBldRnodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%forceBldRnodes) ! forceBldRnodes - END IF - Int_BufSz = Int_BufSz + 1 ! forceTwrHnodes allocated yes/no - IF ( ASSOCIATED(InData%forceTwrHnodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! forceTwrHnodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%forceTwrHnodes) ! forceTwrHnodes - END IF - Re_BufSz = Re_BufSz + 1 ! BladeLength - Re_BufSz = Re_BufSz + 1 ! TowerHeight - Re_BufSz = Re_BufSz + 1 ! TowerBaseHeight - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NMappings - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NnodesVel - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NnodesForce - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NnodesForceBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NnodesForceTower - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ASSOCIATED(InData%forceBldRnodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%forceBldRnodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%forceBldRnodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%forceBldRnodes,1), UBOUND(InData%forceBldRnodes,1) - ReKiBuf(Re_Xferred) = InData%forceBldRnodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%forceTwrHnodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%forceTwrHnodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%forceTwrHnodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%forceTwrHnodes,1), UBOUND(InData%forceTwrHnodes,1) - ReKiBuf(Re_Xferred) = InData%forceTwrHnodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerBaseHeight - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE OpFM_PackParam - - SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OpFM_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%AirDens = OutData%AirDens - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumBl = OutData%NumBl - OutData%NMappings = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NMappings = OutData%NMappings - OutData%NnodesVel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NnodesVel = OutData%NnodesVel - OutData%NnodesForce = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NnodesForce = OutData%NnodesForce - OutData%NnodesForceBlade = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NnodesForceBlade = OutData%NnodesForceBlade - OutData%NnodesForceTower = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NnodesForceTower = OutData%NnodesForceTower - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! forceBldRnodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%forceBldRnodes)) DEALLOCATE(OutData%forceBldRnodes) - ALLOCATE(OutData%forceBldRnodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%forceBldRnodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%forceBldRnodes_Len = SIZE(OutData%forceBldRnodes) - IF (OutData%c_obj%forceBldRnodes_Len > 0) & - OutData%c_obj%forceBldRnodes = C_LOC( OutData%forceBldRnodes(i1_l) ) - DO i1 = LBOUND(OutData%forceBldRnodes,1), UBOUND(OutData%forceBldRnodes,1) - OutData%forceBldRnodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! forceTwrHnodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%forceTwrHnodes)) DEALLOCATE(OutData%forceTwrHnodes) - ALLOCATE(OutData%forceTwrHnodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%forceTwrHnodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%forceTwrHnodes_Len = SIZE(OutData%forceTwrHnodes) - IF (OutData%c_obj%forceTwrHnodes_Len > 0) & - OutData%c_obj%forceTwrHnodes = C_LOC( OutData%forceTwrHnodes(i1_l) ) - DO i1 = LBOUND(OutData%forceTwrHnodes,1), UBOUND(OutData%forceTwrHnodes,1) - OutData%forceTwrHnodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%BladeLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%BladeLength = OutData%BladeLength - OutData%TowerHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%TowerHeight = OutData%TowerHeight - OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight - END SUBROUTINE OpFM_UnPackParam - - SUBROUTINE OpFM_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%AirDens = ParamData%C_obj%AirDens - ParamData%NumBl = ParamData%C_obj%NumBl - ParamData%NMappings = ParamData%C_obj%NMappings - ParamData%NnodesVel = ParamData%C_obj%NnodesVel - ParamData%NnodesForce = ParamData%C_obj%NnodesForce - ParamData%NnodesForceBlade = ParamData%C_obj%NnodesForceBlade - ParamData%NnodesForceTower = ParamData%C_obj%NnodesForceTower - - ! -- forceBldRnodes Param Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceBldRnodes ) ) THEN - NULLIFY( ParamData%forceBldRnodes ) - ELSE - CALL C_F_POINTER(ParamData%C_obj%forceBldRnodes, ParamData%forceBldRnodes, (/ParamData%C_obj%forceBldRnodes_Len/)) - END IF - END IF - - ! -- forceTwrHnodes Param Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceTwrHnodes ) ) THEN - NULLIFY( ParamData%forceTwrHnodes ) - ELSE - CALL C_F_POINTER(ParamData%C_obj%forceTwrHnodes, ParamData%forceTwrHnodes, (/ParamData%C_obj%forceTwrHnodes_Len/)) - END IF - END IF - ParamData%BladeLength = ParamData%C_obj%BladeLength - ParamData%TowerHeight = ParamData%C_obj%TowerHeight - ParamData%TowerBaseHeight = ParamData%C_obj%TowerBaseHeight - END SUBROUTINE OpFM_C2Fary_CopyParam - - SUBROUTINE OpFM_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%C_obj%AirDens = ParamData%AirDens - ParamData%C_obj%NumBl = ParamData%NumBl - ParamData%C_obj%NMappings = ParamData%NMappings - ParamData%C_obj%NnodesVel = ParamData%NnodesVel - ParamData%C_obj%NnodesForce = ParamData%NnodesForce - ParamData%C_obj%NnodesForceBlade = ParamData%NnodesForceBlade - ParamData%C_obj%NnodesForceTower = ParamData%NnodesForceTower - - ! -- forceBldRnodes Param Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(ParamData%forceBldRnodes)) THEN - ParamData%c_obj%forceBldRnodes_Len = 0 - ParamData%c_obj%forceBldRnodes = C_NULL_PTR - ELSE - ParamData%c_obj%forceBldRnodes_Len = SIZE(ParamData%forceBldRnodes) - IF (ParamData%c_obj%forceBldRnodes_Len > 0) & - ParamData%c_obj%forceBldRnodes = C_LOC( ParamData%forceBldRnodes( LBOUND(ParamData%forceBldRnodes,1) ) ) - END IF - END IF - - ! -- forceTwrHnodes Param Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(ParamData%forceTwrHnodes)) THEN - ParamData%c_obj%forceTwrHnodes_Len = 0 - ParamData%c_obj%forceTwrHnodes = C_NULL_PTR - ELSE - ParamData%c_obj%forceTwrHnodes_Len = SIZE(ParamData%forceTwrHnodes) - IF (ParamData%c_obj%forceTwrHnodes_Len > 0) & - ParamData%c_obj%forceTwrHnodes = C_LOC( ParamData%forceTwrHnodes( LBOUND(ParamData%forceTwrHnodes,1) ) ) - END IF - END IF - ParamData%C_obj%BladeLength = ParamData%BladeLength - ParamData%C_obj%TowerHeight = ParamData%TowerHeight - ParamData%C_obj%TowerBaseHeight = ParamData%TowerBaseHeight - END SUBROUTINE OpFM_F2C_CopyParam - - SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpFM_InputType), INTENT(IN) :: SrcInputData - TYPE(OpFM_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcInputData%pxVel)) THEN - i1_l = LBOUND(SrcInputData%pxVel,1) - i1_u = UBOUND(SrcInputData%pxVel,1) - IF (.NOT. ASSOCIATED(DstInputData%pxVel)) THEN - ALLOCATE(DstInputData%pxVel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pxVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%pxVel_Len = SIZE(DstInputData%pxVel) - IF (DstInputData%c_obj%pxVel_Len > 0) & - DstInputData%c_obj%pxVel = C_LOC( DstInputData%pxVel(i1_l) ) - END IF - DstInputData%pxVel = SrcInputData%pxVel -ENDIF -IF (ASSOCIATED(SrcInputData%pyVel)) THEN - i1_l = LBOUND(SrcInputData%pyVel,1) - i1_u = UBOUND(SrcInputData%pyVel,1) - IF (.NOT. ASSOCIATED(DstInputData%pyVel)) THEN - ALLOCATE(DstInputData%pyVel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pyVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%pyVel_Len = SIZE(DstInputData%pyVel) - IF (DstInputData%c_obj%pyVel_Len > 0) & - DstInputData%c_obj%pyVel = C_LOC( DstInputData%pyVel(i1_l) ) - END IF - DstInputData%pyVel = SrcInputData%pyVel -ENDIF -IF (ASSOCIATED(SrcInputData%pzVel)) THEN - i1_l = LBOUND(SrcInputData%pzVel,1) - i1_u = UBOUND(SrcInputData%pzVel,1) - IF (.NOT. ASSOCIATED(DstInputData%pzVel)) THEN - ALLOCATE(DstInputData%pzVel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pzVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%pzVel_Len = SIZE(DstInputData%pzVel) - IF (DstInputData%c_obj%pzVel_Len > 0) & - DstInputData%c_obj%pzVel = C_LOC( DstInputData%pzVel(i1_l) ) - END IF - DstInputData%pzVel = SrcInputData%pzVel -ENDIF -IF (ASSOCIATED(SrcInputData%pxForce)) THEN - i1_l = LBOUND(SrcInputData%pxForce,1) - i1_u = UBOUND(SrcInputData%pxForce,1) - IF (.NOT. ASSOCIATED(DstInputData%pxForce)) THEN - ALLOCATE(DstInputData%pxForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pxForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%pxForce_Len = SIZE(DstInputData%pxForce) - IF (DstInputData%c_obj%pxForce_Len > 0) & - DstInputData%c_obj%pxForce = C_LOC( DstInputData%pxForce(i1_l) ) - END IF - DstInputData%pxForce = SrcInputData%pxForce -ENDIF -IF (ASSOCIATED(SrcInputData%pyForce)) THEN - i1_l = LBOUND(SrcInputData%pyForce,1) - i1_u = UBOUND(SrcInputData%pyForce,1) - IF (.NOT. ASSOCIATED(DstInputData%pyForce)) THEN - ALLOCATE(DstInputData%pyForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pyForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%pyForce_Len = SIZE(DstInputData%pyForce) - IF (DstInputData%c_obj%pyForce_Len > 0) & - DstInputData%c_obj%pyForce = C_LOC( DstInputData%pyForce(i1_l) ) - END IF - DstInputData%pyForce = SrcInputData%pyForce -ENDIF -IF (ASSOCIATED(SrcInputData%pzForce)) THEN - i1_l = LBOUND(SrcInputData%pzForce,1) - i1_u = UBOUND(SrcInputData%pzForce,1) - IF (.NOT. ASSOCIATED(DstInputData%pzForce)) THEN - ALLOCATE(DstInputData%pzForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pzForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%pzForce_Len = SIZE(DstInputData%pzForce) - IF (DstInputData%c_obj%pzForce_Len > 0) & - DstInputData%c_obj%pzForce = C_LOC( DstInputData%pzForce(i1_l) ) - END IF - DstInputData%pzForce = SrcInputData%pzForce -ENDIF -IF (ASSOCIATED(SrcInputData%xdotForce)) THEN - i1_l = LBOUND(SrcInputData%xdotForce,1) - i1_u = UBOUND(SrcInputData%xdotForce,1) - IF (.NOT. ASSOCIATED(DstInputData%xdotForce)) THEN - ALLOCATE(DstInputData%xdotForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%xdotForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%xdotForce_Len = SIZE(DstInputData%xdotForce) - IF (DstInputData%c_obj%xdotForce_Len > 0) & - DstInputData%c_obj%xdotForce = C_LOC( DstInputData%xdotForce(i1_l) ) - END IF - DstInputData%xdotForce = SrcInputData%xdotForce -ENDIF -IF (ASSOCIATED(SrcInputData%ydotForce)) THEN - i1_l = LBOUND(SrcInputData%ydotForce,1) - i1_u = UBOUND(SrcInputData%ydotForce,1) - IF (.NOT. ASSOCIATED(DstInputData%ydotForce)) THEN - ALLOCATE(DstInputData%ydotForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ydotForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%ydotForce_Len = SIZE(DstInputData%ydotForce) - IF (DstInputData%c_obj%ydotForce_Len > 0) & - DstInputData%c_obj%ydotForce = C_LOC( DstInputData%ydotForce(i1_l) ) - END IF - DstInputData%ydotForce = SrcInputData%ydotForce -ENDIF -IF (ASSOCIATED(SrcInputData%zdotForce)) THEN - i1_l = LBOUND(SrcInputData%zdotForce,1) - i1_u = UBOUND(SrcInputData%zdotForce,1) - IF (.NOT. ASSOCIATED(DstInputData%zdotForce)) THEN - ALLOCATE(DstInputData%zdotForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%zdotForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%zdotForce_Len = SIZE(DstInputData%zdotForce) - IF (DstInputData%c_obj%zdotForce_Len > 0) & - DstInputData%c_obj%zdotForce = C_LOC( DstInputData%zdotForce(i1_l) ) - END IF - DstInputData%zdotForce = SrcInputData%zdotForce -ENDIF -IF (ASSOCIATED(SrcInputData%pOrientation)) THEN - i1_l = LBOUND(SrcInputData%pOrientation,1) - i1_u = UBOUND(SrcInputData%pOrientation,1) - IF (.NOT. ASSOCIATED(DstInputData%pOrientation)) THEN - ALLOCATE(DstInputData%pOrientation(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pOrientation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%pOrientation_Len = SIZE(DstInputData%pOrientation) - IF (DstInputData%c_obj%pOrientation_Len > 0) & - DstInputData%c_obj%pOrientation = C_LOC( DstInputData%pOrientation(i1_l) ) - END IF - DstInputData%pOrientation = SrcInputData%pOrientation -ENDIF -IF (ASSOCIATED(SrcInputData%fx)) THEN - i1_l = LBOUND(SrcInputData%fx,1) - i1_u = UBOUND(SrcInputData%fx,1) - IF (.NOT. ASSOCIATED(DstInputData%fx)) THEN - ALLOCATE(DstInputData%fx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%fx_Len = SIZE(DstInputData%fx) - IF (DstInputData%c_obj%fx_Len > 0) & - DstInputData%c_obj%fx = C_LOC( DstInputData%fx(i1_l) ) - END IF - DstInputData%fx = SrcInputData%fx -ENDIF -IF (ASSOCIATED(SrcInputData%fy)) THEN - i1_l = LBOUND(SrcInputData%fy,1) - i1_u = UBOUND(SrcInputData%fy,1) - IF (.NOT. ASSOCIATED(DstInputData%fy)) THEN - ALLOCATE(DstInputData%fy(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%fy_Len = SIZE(DstInputData%fy) - IF (DstInputData%c_obj%fy_Len > 0) & - DstInputData%c_obj%fy = C_LOC( DstInputData%fy(i1_l) ) - END IF - DstInputData%fy = SrcInputData%fy -ENDIF -IF (ASSOCIATED(SrcInputData%fz)) THEN - i1_l = LBOUND(SrcInputData%fz,1) - i1_u = UBOUND(SrcInputData%fz,1) - IF (.NOT. ASSOCIATED(DstInputData%fz)) THEN - ALLOCATE(DstInputData%fz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%fz_Len = SIZE(DstInputData%fz) - IF (DstInputData%c_obj%fz_Len > 0) & - DstInputData%c_obj%fz = C_LOC( DstInputData%fz(i1_l) ) - END IF - DstInputData%fz = SrcInputData%fz -ENDIF -IF (ASSOCIATED(SrcInputData%momentx)) THEN - i1_l = LBOUND(SrcInputData%momentx,1) - i1_u = UBOUND(SrcInputData%momentx,1) - IF (.NOT. ASSOCIATED(DstInputData%momentx)) THEN - ALLOCATE(DstInputData%momentx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%momentx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%momentx_Len = SIZE(DstInputData%momentx) - IF (DstInputData%c_obj%momentx_Len > 0) & - DstInputData%c_obj%momentx = C_LOC( DstInputData%momentx(i1_l) ) - END IF - DstInputData%momentx = SrcInputData%momentx -ENDIF -IF (ASSOCIATED(SrcInputData%momenty)) THEN - i1_l = LBOUND(SrcInputData%momenty,1) - i1_u = UBOUND(SrcInputData%momenty,1) - IF (.NOT. ASSOCIATED(DstInputData%momenty)) THEN - ALLOCATE(DstInputData%momenty(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%momenty.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%momenty_Len = SIZE(DstInputData%momenty) - IF (DstInputData%c_obj%momenty_Len > 0) & - DstInputData%c_obj%momenty = C_LOC( DstInputData%momenty(i1_l) ) - END IF - DstInputData%momenty = SrcInputData%momenty -ENDIF -IF (ASSOCIATED(SrcInputData%momentz)) THEN - i1_l = LBOUND(SrcInputData%momentz,1) - i1_u = UBOUND(SrcInputData%momentz,1) - IF (.NOT. ASSOCIATED(DstInputData%momentz)) THEN - ALLOCATE(DstInputData%momentz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%momentz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%momentz_Len = SIZE(DstInputData%momentz) - IF (DstInputData%c_obj%momentz_Len > 0) & - DstInputData%c_obj%momentz = C_LOC( DstInputData%momentz(i1_l) ) - END IF - DstInputData%momentz = SrcInputData%momentz -ENDIF -IF (ASSOCIATED(SrcInputData%forceNodesChord)) THEN - i1_l = LBOUND(SrcInputData%forceNodesChord,1) - i1_u = UBOUND(SrcInputData%forceNodesChord,1) - IF (.NOT. ASSOCIATED(DstInputData%forceNodesChord)) THEN - ALLOCATE(DstInputData%forceNodesChord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%forceNodesChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%forceNodesChord_Len = SIZE(DstInputData%forceNodesChord) - IF (DstInputData%c_obj%forceNodesChord_Len > 0) & - DstInputData%c_obj%forceNodesChord = C_LOC( DstInputData%forceNodesChord(i1_l) ) - END IF - DstInputData%forceNodesChord = SrcInputData%forceNodesChord -ENDIF - END SUBROUTINE OpFM_CopyInput - - SUBROUTINE OpFM_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(OpFM_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(InputData%pxVel)) THEN - DEALLOCATE(InputData%pxVel) - InputData%pxVel => NULL() - InputData%C_obj%pxVel = C_NULL_PTR - InputData%C_obj%pxVel_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%pyVel)) THEN - DEALLOCATE(InputData%pyVel) - InputData%pyVel => NULL() - InputData%C_obj%pyVel = C_NULL_PTR - InputData%C_obj%pyVel_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%pzVel)) THEN - DEALLOCATE(InputData%pzVel) - InputData%pzVel => NULL() - InputData%C_obj%pzVel = C_NULL_PTR - InputData%C_obj%pzVel_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%pxForce)) THEN - DEALLOCATE(InputData%pxForce) - InputData%pxForce => NULL() - InputData%C_obj%pxForce = C_NULL_PTR - InputData%C_obj%pxForce_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%pyForce)) THEN - DEALLOCATE(InputData%pyForce) - InputData%pyForce => NULL() - InputData%C_obj%pyForce = C_NULL_PTR - InputData%C_obj%pyForce_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%pzForce)) THEN - DEALLOCATE(InputData%pzForce) - InputData%pzForce => NULL() - InputData%C_obj%pzForce = C_NULL_PTR - InputData%C_obj%pzForce_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%xdotForce)) THEN - DEALLOCATE(InputData%xdotForce) - InputData%xdotForce => NULL() - InputData%C_obj%xdotForce = C_NULL_PTR - InputData%C_obj%xdotForce_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%ydotForce)) THEN - DEALLOCATE(InputData%ydotForce) - InputData%ydotForce => NULL() - InputData%C_obj%ydotForce = C_NULL_PTR - InputData%C_obj%ydotForce_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%zdotForce)) THEN - DEALLOCATE(InputData%zdotForce) - InputData%zdotForce => NULL() - InputData%C_obj%zdotForce = C_NULL_PTR - InputData%C_obj%zdotForce_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%pOrientation)) THEN - DEALLOCATE(InputData%pOrientation) - InputData%pOrientation => NULL() - InputData%C_obj%pOrientation = C_NULL_PTR - InputData%C_obj%pOrientation_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%fx)) THEN - DEALLOCATE(InputData%fx) - InputData%fx => NULL() - InputData%C_obj%fx = C_NULL_PTR - InputData%C_obj%fx_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%fy)) THEN - DEALLOCATE(InputData%fy) - InputData%fy => NULL() - InputData%C_obj%fy = C_NULL_PTR - InputData%C_obj%fy_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%fz)) THEN - DEALLOCATE(InputData%fz) - InputData%fz => NULL() - InputData%C_obj%fz = C_NULL_PTR - InputData%C_obj%fz_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%momentx)) THEN - DEALLOCATE(InputData%momentx) - InputData%momentx => NULL() - InputData%C_obj%momentx = C_NULL_PTR - InputData%C_obj%momentx_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%momenty)) THEN - DEALLOCATE(InputData%momenty) - InputData%momenty => NULL() - InputData%C_obj%momenty = C_NULL_PTR - InputData%C_obj%momenty_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%momentz)) THEN - DEALLOCATE(InputData%momentz) - InputData%momentz => NULL() - InputData%C_obj%momentz = C_NULL_PTR - InputData%C_obj%momentz_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%forceNodesChord)) THEN - DEALLOCATE(InputData%forceNodesChord) - InputData%forceNodesChord => NULL() - InputData%C_obj%forceNodesChord = C_NULL_PTR - InputData%C_obj%forceNodesChord_Len = 0 -ENDIF - END SUBROUTINE OpFM_DestroyInput - - SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OpFM_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! pxVel allocated yes/no - IF ( ASSOCIATED(InData%pxVel) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pxVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pxVel) ! pxVel - END IF - Int_BufSz = Int_BufSz + 1 ! pyVel allocated yes/no - IF ( ASSOCIATED(InData%pyVel) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pyVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pyVel) ! pyVel - END IF - Int_BufSz = Int_BufSz + 1 ! pzVel allocated yes/no - IF ( ASSOCIATED(InData%pzVel) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pzVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pzVel) ! pzVel - END IF - Int_BufSz = Int_BufSz + 1 ! pxForce allocated yes/no - IF ( ASSOCIATED(InData%pxForce) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pxForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pxForce) ! pxForce - END IF - Int_BufSz = Int_BufSz + 1 ! pyForce allocated yes/no - IF ( ASSOCIATED(InData%pyForce) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pyForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pyForce) ! pyForce - END IF - Int_BufSz = Int_BufSz + 1 ! pzForce allocated yes/no - IF ( ASSOCIATED(InData%pzForce) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pzForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pzForce) ! pzForce - END IF - Int_BufSz = Int_BufSz + 1 ! xdotForce allocated yes/no - IF ( ASSOCIATED(InData%xdotForce) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xdotForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%xdotForce) ! xdotForce - END IF - Int_BufSz = Int_BufSz + 1 ! ydotForce allocated yes/no - IF ( ASSOCIATED(InData%ydotForce) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ydotForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ydotForce) ! ydotForce - END IF - Int_BufSz = Int_BufSz + 1 ! zdotForce allocated yes/no - IF ( ASSOCIATED(InData%zdotForce) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! zdotForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%zdotForce) ! zdotForce - END IF - Int_BufSz = Int_BufSz + 1 ! pOrientation allocated yes/no - IF ( ASSOCIATED(InData%pOrientation) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pOrientation upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pOrientation) ! pOrientation - END IF - Int_BufSz = Int_BufSz + 1 ! fx allocated yes/no - IF ( ASSOCIATED(InData%fx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fx) ! fx - END IF - Int_BufSz = Int_BufSz + 1 ! fy allocated yes/no - IF ( ASSOCIATED(InData%fy) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fy) ! fy - END IF - Int_BufSz = Int_BufSz + 1 ! fz allocated yes/no - IF ( ASSOCIATED(InData%fz) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fz) ! fz - END IF - Int_BufSz = Int_BufSz + 1 ! momentx allocated yes/no - IF ( ASSOCIATED(InData%momentx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! momentx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%momentx) ! momentx - END IF - Int_BufSz = Int_BufSz + 1 ! momenty allocated yes/no - IF ( ASSOCIATED(InData%momenty) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! momenty upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%momenty) ! momenty - END IF - Int_BufSz = Int_BufSz + 1 ! momentz allocated yes/no - IF ( ASSOCIATED(InData%momentz) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! momentz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%momentz) ! momentz - END IF - Int_BufSz = Int_BufSz + 1 ! forceNodesChord allocated yes/no - IF ( ASSOCIATED(InData%forceNodesChord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! forceNodesChord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%forceNodesChord) ! forceNodesChord - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%pxVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pxVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pxVel,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pxVel,1), UBOUND(InData%pxVel,1) - ReKiBuf(Re_Xferred) = InData%pxVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%pyVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pyVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pyVel,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pyVel,1), UBOUND(InData%pyVel,1) - ReKiBuf(Re_Xferred) = InData%pyVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%pzVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pzVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pzVel,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pzVel,1), UBOUND(InData%pzVel,1) - ReKiBuf(Re_Xferred) = InData%pzVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%pxForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pxForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pxForce,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pxForce,1), UBOUND(InData%pxForce,1) - ReKiBuf(Re_Xferred) = InData%pxForce(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%pyForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pyForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pyForce,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pyForce,1), UBOUND(InData%pyForce,1) - ReKiBuf(Re_Xferred) = InData%pyForce(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%pzForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pzForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pzForce,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pzForce,1), UBOUND(InData%pzForce,1) - ReKiBuf(Re_Xferred) = InData%pzForce(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%xdotForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xdotForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xdotForce,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xdotForce,1), UBOUND(InData%xdotForce,1) - ReKiBuf(Re_Xferred) = InData%xdotForce(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%ydotForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ydotForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ydotForce,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ydotForce,1), UBOUND(InData%ydotForce,1) - ReKiBuf(Re_Xferred) = InData%ydotForce(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%zdotForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zdotForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zdotForce,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%zdotForce,1), UBOUND(InData%zdotForce,1) - ReKiBuf(Re_Xferred) = InData%zdotForce(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%pOrientation) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pOrientation,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pOrientation,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pOrientation,1), UBOUND(InData%pOrientation,1) - ReKiBuf(Re_Xferred) = InData%pOrientation(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%fx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fx,1), UBOUND(InData%fx,1) - ReKiBuf(Re_Xferred) = InData%fx(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%fy) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fy,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fy,1), UBOUND(InData%fy,1) - ReKiBuf(Re_Xferred) = InData%fy(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%fz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fz,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fz,1), UBOUND(InData%fz,1) - ReKiBuf(Re_Xferred) = InData%fz(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%momentx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%momentx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%momentx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%momentx,1), UBOUND(InData%momentx,1) - ReKiBuf(Re_Xferred) = InData%momentx(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%momenty) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%momenty,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%momenty,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%momenty,1), UBOUND(InData%momenty,1) - ReKiBuf(Re_Xferred) = InData%momenty(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%momentz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%momentz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%momentz,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%momentz,1), UBOUND(InData%momentz,1) - ReKiBuf(Re_Xferred) = InData%momentz(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%forceNodesChord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%forceNodesChord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%forceNodesChord,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%forceNodesChord,1), UBOUND(InData%forceNodesChord,1) - ReKiBuf(Re_Xferred) = InData%forceNodesChord(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE OpFM_PackInput - - SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OpFM_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pxVel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%pxVel)) DEALLOCATE(OutData%pxVel) - ALLOCATE(OutData%pxVel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pxVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%pxVel_Len = SIZE(OutData%pxVel) - IF (OutData%c_obj%pxVel_Len > 0) & - OutData%c_obj%pxVel = C_LOC( OutData%pxVel(i1_l) ) - DO i1 = LBOUND(OutData%pxVel,1), UBOUND(OutData%pxVel,1) - OutData%pxVel(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pyVel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%pyVel)) DEALLOCATE(OutData%pyVel) - ALLOCATE(OutData%pyVel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pyVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%pyVel_Len = SIZE(OutData%pyVel) - IF (OutData%c_obj%pyVel_Len > 0) & - OutData%c_obj%pyVel = C_LOC( OutData%pyVel(i1_l) ) - DO i1 = LBOUND(OutData%pyVel,1), UBOUND(OutData%pyVel,1) - OutData%pyVel(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pzVel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%pzVel)) DEALLOCATE(OutData%pzVel) - ALLOCATE(OutData%pzVel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%pzVel_Len = SIZE(OutData%pzVel) - IF (OutData%c_obj%pzVel_Len > 0) & - OutData%c_obj%pzVel = C_LOC( OutData%pzVel(i1_l) ) - DO i1 = LBOUND(OutData%pzVel,1), UBOUND(OutData%pzVel,1) - OutData%pzVel(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pxForce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%pxForce)) DEALLOCATE(OutData%pxForce) - ALLOCATE(OutData%pxForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pxForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%pxForce_Len = SIZE(OutData%pxForce) - IF (OutData%c_obj%pxForce_Len > 0) & - OutData%c_obj%pxForce = C_LOC( OutData%pxForce(i1_l) ) - DO i1 = LBOUND(OutData%pxForce,1), UBOUND(OutData%pxForce,1) - OutData%pxForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pyForce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%pyForce)) DEALLOCATE(OutData%pyForce) - ALLOCATE(OutData%pyForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pyForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%pyForce_Len = SIZE(OutData%pyForce) - IF (OutData%c_obj%pyForce_Len > 0) & - OutData%c_obj%pyForce = C_LOC( OutData%pyForce(i1_l) ) - DO i1 = LBOUND(OutData%pyForce,1), UBOUND(OutData%pyForce,1) - OutData%pyForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pzForce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%pzForce)) DEALLOCATE(OutData%pzForce) - ALLOCATE(OutData%pzForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%pzForce_Len = SIZE(OutData%pzForce) - IF (OutData%c_obj%pzForce_Len > 0) & - OutData%c_obj%pzForce = C_LOC( OutData%pzForce(i1_l) ) - DO i1 = LBOUND(OutData%pzForce,1), UBOUND(OutData%pzForce,1) - OutData%pzForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xdotForce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%xdotForce)) DEALLOCATE(OutData%xdotForce) - ALLOCATE(OutData%xdotForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdotForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%xdotForce_Len = SIZE(OutData%xdotForce) - IF (OutData%c_obj%xdotForce_Len > 0) & - OutData%c_obj%xdotForce = C_LOC( OutData%xdotForce(i1_l) ) - DO i1 = LBOUND(OutData%xdotForce,1), UBOUND(OutData%xdotForce,1) - OutData%xdotForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ydotForce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%ydotForce)) DEALLOCATE(OutData%ydotForce) - ALLOCATE(OutData%ydotForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ydotForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%ydotForce_Len = SIZE(OutData%ydotForce) - IF (OutData%c_obj%ydotForce_Len > 0) & - OutData%c_obj%ydotForce = C_LOC( OutData%ydotForce(i1_l) ) - DO i1 = LBOUND(OutData%ydotForce,1), UBOUND(OutData%ydotForce,1) - OutData%ydotForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zdotForce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%zdotForce)) DEALLOCATE(OutData%zdotForce) - ALLOCATE(OutData%zdotForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zdotForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%zdotForce_Len = SIZE(OutData%zdotForce) - IF (OutData%c_obj%zdotForce_Len > 0) & - OutData%c_obj%zdotForce = C_LOC( OutData%zdotForce(i1_l) ) - DO i1 = LBOUND(OutData%zdotForce,1), UBOUND(OutData%zdotForce,1) - OutData%zdotForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pOrientation not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%pOrientation)) DEALLOCATE(OutData%pOrientation) - ALLOCATE(OutData%pOrientation(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pOrientation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%pOrientation_Len = SIZE(OutData%pOrientation) - IF (OutData%c_obj%pOrientation_Len > 0) & - OutData%c_obj%pOrientation = C_LOC( OutData%pOrientation(i1_l) ) - DO i1 = LBOUND(OutData%pOrientation,1), UBOUND(OutData%pOrientation,1) - OutData%pOrientation(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%fx)) DEALLOCATE(OutData%fx) - ALLOCATE(OutData%fx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%fx_Len = SIZE(OutData%fx) - IF (OutData%c_obj%fx_Len > 0) & - OutData%c_obj%fx = C_LOC( OutData%fx(i1_l) ) - DO i1 = LBOUND(OutData%fx,1), UBOUND(OutData%fx,1) - OutData%fx(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fy not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%fy)) DEALLOCATE(OutData%fy) - ALLOCATE(OutData%fy(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%fy_Len = SIZE(OutData%fy) - IF (OutData%c_obj%fy_Len > 0) & - OutData%c_obj%fy = C_LOC( OutData%fy(i1_l) ) - DO i1 = LBOUND(OutData%fy,1), UBOUND(OutData%fy,1) - OutData%fy(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fz not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%fz)) DEALLOCATE(OutData%fz) - ALLOCATE(OutData%fz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%fz_Len = SIZE(OutData%fz) - IF (OutData%c_obj%fz_Len > 0) & - OutData%c_obj%fz = C_LOC( OutData%fz(i1_l) ) - DO i1 = LBOUND(OutData%fz,1), UBOUND(OutData%fz,1) - OutData%fz(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! momentx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%momentx)) DEALLOCATE(OutData%momentx) - ALLOCATE(OutData%momentx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%momentx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%momentx_Len = SIZE(OutData%momentx) - IF (OutData%c_obj%momentx_Len > 0) & - OutData%c_obj%momentx = C_LOC( OutData%momentx(i1_l) ) - DO i1 = LBOUND(OutData%momentx,1), UBOUND(OutData%momentx,1) - OutData%momentx(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! momenty not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%momenty)) DEALLOCATE(OutData%momenty) - ALLOCATE(OutData%momenty(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%momenty.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%momenty_Len = SIZE(OutData%momenty) - IF (OutData%c_obj%momenty_Len > 0) & - OutData%c_obj%momenty = C_LOC( OutData%momenty(i1_l) ) - DO i1 = LBOUND(OutData%momenty,1), UBOUND(OutData%momenty,1) - OutData%momenty(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! momentz not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%momentz)) DEALLOCATE(OutData%momentz) - ALLOCATE(OutData%momentz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%momentz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%momentz_Len = SIZE(OutData%momentz) - IF (OutData%c_obj%momentz_Len > 0) & - OutData%c_obj%momentz = C_LOC( OutData%momentz(i1_l) ) - DO i1 = LBOUND(OutData%momentz,1), UBOUND(OutData%momentz,1) - OutData%momentz(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! forceNodesChord not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%forceNodesChord)) DEALLOCATE(OutData%forceNodesChord) - ALLOCATE(OutData%forceNodesChord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%forceNodesChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%forceNodesChord_Len = SIZE(OutData%forceNodesChord) - IF (OutData%c_obj%forceNodesChord_Len > 0) & - OutData%c_obj%forceNodesChord = C_LOC( OutData%forceNodesChord(i1_l) ) - DO i1 = LBOUND(OutData%forceNodesChord,1), UBOUND(OutData%forceNodesChord,1) - OutData%forceNodesChord(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE OpFM_UnPackInput - - SUBROUTINE OpFM_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- pxVel Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxVel ) ) THEN - NULLIFY( InputData%pxVel ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pxVel, InputData%pxVel, (/InputData%C_obj%pxVel_Len/)) - END IF - END IF - - ! -- pyVel Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyVel ) ) THEN - NULLIFY( InputData%pyVel ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pyVel, InputData%pyVel, (/InputData%C_obj%pyVel_Len/)) - END IF - END IF - - ! -- pzVel Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzVel ) ) THEN - NULLIFY( InputData%pzVel ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pzVel, InputData%pzVel, (/InputData%C_obj%pzVel_Len/)) - END IF - END IF - - ! -- pxForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxForce ) ) THEN - NULLIFY( InputData%pxForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pxForce, InputData%pxForce, (/InputData%C_obj%pxForce_Len/)) - END IF - END IF - - ! -- pyForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyForce ) ) THEN - NULLIFY( InputData%pyForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pyForce, InputData%pyForce, (/InputData%C_obj%pyForce_Len/)) - END IF - END IF - - ! -- pzForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzForce ) ) THEN - NULLIFY( InputData%pzForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pzForce, InputData%pzForce, (/InputData%C_obj%pzForce_Len/)) - END IF - END IF - - ! -- xdotForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%xdotForce ) ) THEN - NULLIFY( InputData%xdotForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%xdotForce, InputData%xdotForce, (/InputData%C_obj%xdotForce_Len/)) - END IF - END IF - - ! -- ydotForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%ydotForce ) ) THEN - NULLIFY( InputData%ydotForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%ydotForce, InputData%ydotForce, (/InputData%C_obj%ydotForce_Len/)) - END IF - END IF - - ! -- zdotForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%zdotForce ) ) THEN - NULLIFY( InputData%zdotForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%zdotForce, InputData%zdotForce, (/InputData%C_obj%zdotForce_Len/)) - END IF - END IF - - ! -- pOrientation Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pOrientation ) ) THEN - NULLIFY( InputData%pOrientation ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pOrientation, InputData%pOrientation, (/InputData%C_obj%pOrientation_Len/)) - END IF - END IF - - ! -- fx Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fx ) ) THEN - NULLIFY( InputData%fx ) - ELSE - CALL C_F_POINTER(InputData%C_obj%fx, InputData%fx, (/InputData%C_obj%fx_Len/)) - END IF - END IF - - ! -- fy Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fy ) ) THEN - NULLIFY( InputData%fy ) - ELSE - CALL C_F_POINTER(InputData%C_obj%fy, InputData%fy, (/InputData%C_obj%fy_Len/)) - END IF - END IF - - ! -- fz Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fz ) ) THEN - NULLIFY( InputData%fz ) - ELSE - CALL C_F_POINTER(InputData%C_obj%fz, InputData%fz, (/InputData%C_obj%fz_Len/)) - END IF - END IF - - ! -- momentx Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentx ) ) THEN - NULLIFY( InputData%momentx ) - ELSE - CALL C_F_POINTER(InputData%C_obj%momentx, InputData%momentx, (/InputData%C_obj%momentx_Len/)) - END IF - END IF - - ! -- momenty Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momenty ) ) THEN - NULLIFY( InputData%momenty ) - ELSE - CALL C_F_POINTER(InputData%C_obj%momenty, InputData%momenty, (/InputData%C_obj%momenty_Len/)) - END IF - END IF - - ! -- momentz Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentz ) ) THEN - NULLIFY( InputData%momentz ) - ELSE - CALL C_F_POINTER(InputData%C_obj%momentz, InputData%momentz, (/InputData%C_obj%momentz_Len/)) - END IF - END IF - - ! -- forceNodesChord Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%forceNodesChord ) ) THEN - NULLIFY( InputData%forceNodesChord ) - ELSE - CALL C_F_POINTER(InputData%C_obj%forceNodesChord, InputData%forceNodesChord, (/InputData%C_obj%forceNodesChord_Len/)) - END IF - END IF - END SUBROUTINE OpFM_C2Fary_CopyInput - - SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- pxVel Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%pxVel)) THEN - InputData%c_obj%pxVel_Len = 0 - InputData%c_obj%pxVel = C_NULL_PTR - ELSE - InputData%c_obj%pxVel_Len = SIZE(InputData%pxVel) - IF (InputData%c_obj%pxVel_Len > 0) & - InputData%c_obj%pxVel = C_LOC( InputData%pxVel( LBOUND(InputData%pxVel,1) ) ) - END IF - END IF - - ! -- pyVel Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%pyVel)) THEN - InputData%c_obj%pyVel_Len = 0 - InputData%c_obj%pyVel = C_NULL_PTR - ELSE - InputData%c_obj%pyVel_Len = SIZE(InputData%pyVel) - IF (InputData%c_obj%pyVel_Len > 0) & - InputData%c_obj%pyVel = C_LOC( InputData%pyVel( LBOUND(InputData%pyVel,1) ) ) - END IF - END IF - - ! -- pzVel Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%pzVel)) THEN - InputData%c_obj%pzVel_Len = 0 - InputData%c_obj%pzVel = C_NULL_PTR - ELSE - InputData%c_obj%pzVel_Len = SIZE(InputData%pzVel) - IF (InputData%c_obj%pzVel_Len > 0) & - InputData%c_obj%pzVel = C_LOC( InputData%pzVel( LBOUND(InputData%pzVel,1) ) ) - END IF - END IF - - ! -- pxForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%pxForce)) THEN - InputData%c_obj%pxForce_Len = 0 - InputData%c_obj%pxForce = C_NULL_PTR - ELSE - InputData%c_obj%pxForce_Len = SIZE(InputData%pxForce) - IF (InputData%c_obj%pxForce_Len > 0) & - InputData%c_obj%pxForce = C_LOC( InputData%pxForce( LBOUND(InputData%pxForce,1) ) ) - END IF - END IF - - ! -- pyForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%pyForce)) THEN - InputData%c_obj%pyForce_Len = 0 - InputData%c_obj%pyForce = C_NULL_PTR - ELSE - InputData%c_obj%pyForce_Len = SIZE(InputData%pyForce) - IF (InputData%c_obj%pyForce_Len > 0) & - InputData%c_obj%pyForce = C_LOC( InputData%pyForce( LBOUND(InputData%pyForce,1) ) ) - END IF - END IF - - ! -- pzForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%pzForce)) THEN - InputData%c_obj%pzForce_Len = 0 - InputData%c_obj%pzForce = C_NULL_PTR - ELSE - InputData%c_obj%pzForce_Len = SIZE(InputData%pzForce) - IF (InputData%c_obj%pzForce_Len > 0) & - InputData%c_obj%pzForce = C_LOC( InputData%pzForce( LBOUND(InputData%pzForce,1) ) ) - END IF - END IF - - ! -- xdotForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%xdotForce)) THEN - InputData%c_obj%xdotForce_Len = 0 - InputData%c_obj%xdotForce = C_NULL_PTR - ELSE - InputData%c_obj%xdotForce_Len = SIZE(InputData%xdotForce) - IF (InputData%c_obj%xdotForce_Len > 0) & - InputData%c_obj%xdotForce = C_LOC( InputData%xdotForce( LBOUND(InputData%xdotForce,1) ) ) - END IF - END IF - - ! -- ydotForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%ydotForce)) THEN - InputData%c_obj%ydotForce_Len = 0 - InputData%c_obj%ydotForce = C_NULL_PTR - ELSE - InputData%c_obj%ydotForce_Len = SIZE(InputData%ydotForce) - IF (InputData%c_obj%ydotForce_Len > 0) & - InputData%c_obj%ydotForce = C_LOC( InputData%ydotForce( LBOUND(InputData%ydotForce,1) ) ) - END IF - END IF - - ! -- zdotForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%zdotForce)) THEN - InputData%c_obj%zdotForce_Len = 0 - InputData%c_obj%zdotForce = C_NULL_PTR - ELSE - InputData%c_obj%zdotForce_Len = SIZE(InputData%zdotForce) - IF (InputData%c_obj%zdotForce_Len > 0) & - InputData%c_obj%zdotForce = C_LOC( InputData%zdotForce( LBOUND(InputData%zdotForce,1) ) ) - END IF - END IF - - ! -- pOrientation Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%pOrientation)) THEN - InputData%c_obj%pOrientation_Len = 0 - InputData%c_obj%pOrientation = C_NULL_PTR - ELSE - InputData%c_obj%pOrientation_Len = SIZE(InputData%pOrientation) - IF (InputData%c_obj%pOrientation_Len > 0) & - InputData%c_obj%pOrientation = C_LOC( InputData%pOrientation( LBOUND(InputData%pOrientation,1) ) ) - END IF - END IF - - ! -- fx Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%fx)) THEN - InputData%c_obj%fx_Len = 0 - InputData%c_obj%fx = C_NULL_PTR - ELSE - InputData%c_obj%fx_Len = SIZE(InputData%fx) - IF (InputData%c_obj%fx_Len > 0) & - InputData%c_obj%fx = C_LOC( InputData%fx( LBOUND(InputData%fx,1) ) ) - END IF - END IF - - ! -- fy Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%fy)) THEN - InputData%c_obj%fy_Len = 0 - InputData%c_obj%fy = C_NULL_PTR - ELSE - InputData%c_obj%fy_Len = SIZE(InputData%fy) - IF (InputData%c_obj%fy_Len > 0) & - InputData%c_obj%fy = C_LOC( InputData%fy( LBOUND(InputData%fy,1) ) ) - END IF - END IF - - ! -- fz Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%fz)) THEN - InputData%c_obj%fz_Len = 0 - InputData%c_obj%fz = C_NULL_PTR - ELSE - InputData%c_obj%fz_Len = SIZE(InputData%fz) - IF (InputData%c_obj%fz_Len > 0) & - InputData%c_obj%fz = C_LOC( InputData%fz( LBOUND(InputData%fz,1) ) ) - END IF - END IF - - ! -- momentx Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%momentx)) THEN - InputData%c_obj%momentx_Len = 0 - InputData%c_obj%momentx = C_NULL_PTR - ELSE - InputData%c_obj%momentx_Len = SIZE(InputData%momentx) - IF (InputData%c_obj%momentx_Len > 0) & - InputData%c_obj%momentx = C_LOC( InputData%momentx( LBOUND(InputData%momentx,1) ) ) - END IF - END IF - - ! -- momenty Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%momenty)) THEN - InputData%c_obj%momenty_Len = 0 - InputData%c_obj%momenty = C_NULL_PTR - ELSE - InputData%c_obj%momenty_Len = SIZE(InputData%momenty) - IF (InputData%c_obj%momenty_Len > 0) & - InputData%c_obj%momenty = C_LOC( InputData%momenty( LBOUND(InputData%momenty,1) ) ) - END IF - END IF - - ! -- momentz Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%momentz)) THEN - InputData%c_obj%momentz_Len = 0 - InputData%c_obj%momentz = C_NULL_PTR - ELSE - InputData%c_obj%momentz_Len = SIZE(InputData%momentz) - IF (InputData%c_obj%momentz_Len > 0) & - InputData%c_obj%momentz = C_LOC( InputData%momentz( LBOUND(InputData%momentz,1) ) ) - END IF - END IF - - ! -- forceNodesChord Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%forceNodesChord)) THEN - InputData%c_obj%forceNodesChord_Len = 0 - InputData%c_obj%forceNodesChord = C_NULL_PTR - ELSE - InputData%c_obj%forceNodesChord_Len = SIZE(InputData%forceNodesChord) - IF (InputData%c_obj%forceNodesChord_Len > 0) & - InputData%c_obj%forceNodesChord = C_LOC( InputData%forceNodesChord( LBOUND(InputData%forceNodesChord,1) ) ) - END IF - END IF - END SUBROUTINE OpFM_F2C_CopyInput - - SUBROUTINE OpFM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpFM_OutputType), INTENT(IN) :: SrcOutputData - TYPE(OpFM_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcOutputData%u)) THEN - i1_l = LBOUND(SrcOutputData%u,1) - i1_u = UBOUND(SrcOutputData%u,1) - IF (.NOT. ASSOCIATED(DstOutputData%u)) THEN - ALLOCATE(DstOutputData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%c_obj%u_Len = SIZE(DstOutputData%u) - IF (DstOutputData%c_obj%u_Len > 0) & - DstOutputData%c_obj%u = C_LOC( DstOutputData%u(i1_l) ) - END IF - DstOutputData%u = SrcOutputData%u -ENDIF -IF (ASSOCIATED(SrcOutputData%v)) THEN - i1_l = LBOUND(SrcOutputData%v,1) - i1_u = UBOUND(SrcOutputData%v,1) - IF (.NOT. ASSOCIATED(DstOutputData%v)) THEN - ALLOCATE(DstOutputData%v(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%v.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%c_obj%v_Len = SIZE(DstOutputData%v) - IF (DstOutputData%c_obj%v_Len > 0) & - DstOutputData%c_obj%v = C_LOC( DstOutputData%v(i1_l) ) - END IF - DstOutputData%v = SrcOutputData%v -ENDIF -IF (ASSOCIATED(SrcOutputData%w)) THEN - i1_l = LBOUND(SrcOutputData%w,1) - i1_u = UBOUND(SrcOutputData%w,1) - IF (.NOT. ASSOCIATED(DstOutputData%w)) THEN - ALLOCATE(DstOutputData%w(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%w.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%c_obj%w_Len = SIZE(DstOutputData%w) - IF (DstOutputData%c_obj%w_Len > 0) & - DstOutputData%c_obj%w = C_LOC( DstOutputData%w(i1_l) ) - END IF - DstOutputData%w = SrcOutputData%w -ENDIF -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - END SUBROUTINE OpFM_CopyOutput - - SUBROUTINE OpFM_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(OutputData%u)) THEN - DEALLOCATE(OutputData%u) - OutputData%u => NULL() - OutputData%C_obj%u = C_NULL_PTR - OutputData%C_obj%u_Len = 0 -ENDIF -IF (ASSOCIATED(OutputData%v)) THEN - DEALLOCATE(OutputData%v) - OutputData%v => NULL() - OutputData%C_obj%v = C_NULL_PTR - OutputData%C_obj%v_Len = 0 -ENDIF -IF (ASSOCIATED(OutputData%w)) THEN - DEALLOCATE(OutputData%w) - OutputData%w => NULL() - OutputData%C_obj%w = C_NULL_PTR - OutputData%C_obj%w_Len = 0 -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE OpFM_DestroyOutput - - SUBROUTINE OpFM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OpFM_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! u allocated yes/no - IF ( ASSOCIATED(InData%u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%u) ! u - END IF - Int_BufSz = Int_BufSz + 1 ! v allocated yes/no - IF ( ASSOCIATED(InData%v) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! v upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%v) ! v - END IF - Int_BufSz = Int_BufSz + 1 ! w allocated yes/no - IF ( ASSOCIATED(InData%w) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! w upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%w) ! w - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - ReKiBuf(Re_Xferred) = InData%u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%v) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%v,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%v,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%v,1), UBOUND(InData%v,1) - ReKiBuf(Re_Xferred) = InData%v(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%w) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%w,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%w,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%w,1), UBOUND(InData%w,1) - ReKiBuf(Re_Xferred) = InData%w(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE OpFM_PackOutput - - SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OpFM_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%u)) DEALLOCATE(OutData%u) - ALLOCATE(OutData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%u_Len = SIZE(OutData%u) - IF (OutData%c_obj%u_Len > 0) & - OutData%c_obj%u = C_LOC( OutData%u(i1_l) ) - DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) - OutData%u(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! v not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%v)) DEALLOCATE(OutData%v) - ALLOCATE(OutData%v(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%v.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%v_Len = SIZE(OutData%v) - IF (OutData%c_obj%v_Len > 0) & - OutData%c_obj%v = C_LOC( OutData%v(i1_l) ) - DO i1 = LBOUND(OutData%v,1), UBOUND(OutData%v,1) - OutData%v(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! w not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%w)) DEALLOCATE(OutData%w) - ALLOCATE(OutData%w(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%w.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%w_Len = SIZE(OutData%w) - IF (OutData%c_obj%w_Len > 0) & - OutData%c_obj%w = C_LOC( OutData%w(i1_l) ) - DO i1 = LBOUND(OutData%w,1), UBOUND(OutData%w,1) - OutData%w(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE OpFM_UnPackOutput - - SUBROUTINE OpFM_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- u Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%u ) ) THEN - NULLIFY( OutputData%u ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%u, OutputData%u, (/OutputData%C_obj%u_Len/)) - END IF - END IF - - ! -- v Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%v ) ) THEN - NULLIFY( OutputData%v ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%v, OutputData%v, (/OutputData%C_obj%v_Len/)) - END IF - END IF - - ! -- w Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%w ) ) THEN - NULLIFY( OutputData%w ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%w, OutputData%w, (/OutputData%C_obj%w_Len/)) - END IF - END IF - END SUBROUTINE OpFM_C2Fary_CopyOutput - - SUBROUTINE OpFM_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- u Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%u)) THEN - OutputData%c_obj%u_Len = 0 - OutputData%c_obj%u = C_NULL_PTR - ELSE - OutputData%c_obj%u_Len = SIZE(OutputData%u) - IF (OutputData%c_obj%u_Len > 0) & - OutputData%c_obj%u = C_LOC( OutputData%u( LBOUND(OutputData%u,1) ) ) - END IF - END IF - - ! -- v Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%v)) THEN - OutputData%c_obj%v_Len = 0 - OutputData%c_obj%v = C_NULL_PTR - ELSE - OutputData%c_obj%v_Len = SIZE(OutputData%v) - IF (OutputData%c_obj%v_Len > 0) & - OutputData%c_obj%v = C_LOC( OutputData%v( LBOUND(OutputData%v,1) ) ) - END IF - END IF - - ! -- w Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%w)) THEN - OutputData%c_obj%w_Len = 0 - OutputData%c_obj%w = C_NULL_PTR - ELSE - OutputData%c_obj%w_Len = SIZE(OutputData%w) - IF (OutputData%c_obj%w_Len > 0) & - OutputData%c_obj%w = C_LOC( OutputData%w( LBOUND(OutputData%w,1) ) ) - END IF - END IF - END SUBROUTINE OpFM_F2C_CopyOutput - - - SUBROUTINE OpFM_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(OpFM_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(OpFM_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL OpFM_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL OpFM_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL OpFM_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE OpFM_Input_ExtrapInterp - - - SUBROUTINE OpFM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = u1, f(t2) = u2 -! -!.................................................................................................................................. - - TYPE(OpFM_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(OpFM_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(OpFM_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) -IF (ASSOCIATED(u_out%pxVel) .AND. ASSOCIATED(u1%pxVel)) THEN - DO i1 = LBOUND(u_out%pxVel,1),UBOUND(u_out%pxVel,1) - b = -(u1%pxVel(i1) - u2%pxVel(i1)) - u_out%pxVel(i1) = u1%pxVel(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pyVel) .AND. ASSOCIATED(u1%pyVel)) THEN - DO i1 = LBOUND(u_out%pyVel,1),UBOUND(u_out%pyVel,1) - b = -(u1%pyVel(i1) - u2%pyVel(i1)) - u_out%pyVel(i1) = u1%pyVel(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pzVel) .AND. ASSOCIATED(u1%pzVel)) THEN - DO i1 = LBOUND(u_out%pzVel,1),UBOUND(u_out%pzVel,1) - b = -(u1%pzVel(i1) - u2%pzVel(i1)) - u_out%pzVel(i1) = u1%pzVel(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pxForce) .AND. ASSOCIATED(u1%pxForce)) THEN - DO i1 = LBOUND(u_out%pxForce,1),UBOUND(u_out%pxForce,1) - b = -(u1%pxForce(i1) - u2%pxForce(i1)) - u_out%pxForce(i1) = u1%pxForce(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pyForce) .AND. ASSOCIATED(u1%pyForce)) THEN - DO i1 = LBOUND(u_out%pyForce,1),UBOUND(u_out%pyForce,1) - b = -(u1%pyForce(i1) - u2%pyForce(i1)) - u_out%pyForce(i1) = u1%pyForce(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pzForce) .AND. ASSOCIATED(u1%pzForce)) THEN - DO i1 = LBOUND(u_out%pzForce,1),UBOUND(u_out%pzForce,1) - b = -(u1%pzForce(i1) - u2%pzForce(i1)) - u_out%pzForce(i1) = u1%pzForce(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%xdotForce) .AND. ASSOCIATED(u1%xdotForce)) THEN - DO i1 = LBOUND(u_out%xdotForce,1),UBOUND(u_out%xdotForce,1) - b = -(u1%xdotForce(i1) - u2%xdotForce(i1)) - u_out%xdotForce(i1) = u1%xdotForce(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%ydotForce) .AND. ASSOCIATED(u1%ydotForce)) THEN - DO i1 = LBOUND(u_out%ydotForce,1),UBOUND(u_out%ydotForce,1) - b = -(u1%ydotForce(i1) - u2%ydotForce(i1)) - u_out%ydotForce(i1) = u1%ydotForce(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%zdotForce) .AND. ASSOCIATED(u1%zdotForce)) THEN - DO i1 = LBOUND(u_out%zdotForce,1),UBOUND(u_out%zdotForce,1) - b = -(u1%zdotForce(i1) - u2%zdotForce(i1)) - u_out%zdotForce(i1) = u1%zdotForce(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pOrientation) .AND. ASSOCIATED(u1%pOrientation)) THEN - DO i1 = LBOUND(u_out%pOrientation,1),UBOUND(u_out%pOrientation,1) - b = -(u1%pOrientation(i1) - u2%pOrientation(i1)) - u_out%pOrientation(i1) = u1%pOrientation(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%fx) .AND. ASSOCIATED(u1%fx)) THEN - DO i1 = LBOUND(u_out%fx,1),UBOUND(u_out%fx,1) - b = -(u1%fx(i1) - u2%fx(i1)) - u_out%fx(i1) = u1%fx(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%fy) .AND. ASSOCIATED(u1%fy)) THEN - DO i1 = LBOUND(u_out%fy,1),UBOUND(u_out%fy,1) - b = -(u1%fy(i1) - u2%fy(i1)) - u_out%fy(i1) = u1%fy(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%fz) .AND. ASSOCIATED(u1%fz)) THEN - DO i1 = LBOUND(u_out%fz,1),UBOUND(u_out%fz,1) - b = -(u1%fz(i1) - u2%fz(i1)) - u_out%fz(i1) = u1%fz(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%momentx) .AND. ASSOCIATED(u1%momentx)) THEN - DO i1 = LBOUND(u_out%momentx,1),UBOUND(u_out%momentx,1) - b = -(u1%momentx(i1) - u2%momentx(i1)) - u_out%momentx(i1) = u1%momentx(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%momenty) .AND. ASSOCIATED(u1%momenty)) THEN - DO i1 = LBOUND(u_out%momenty,1),UBOUND(u_out%momenty,1) - b = -(u1%momenty(i1) - u2%momenty(i1)) - u_out%momenty(i1) = u1%momenty(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%momentz) .AND. ASSOCIATED(u1%momentz)) THEN - DO i1 = LBOUND(u_out%momentz,1),UBOUND(u_out%momentz,1) - b = -(u1%momentz(i1) - u2%momentz(i1)) - u_out%momentz(i1) = u1%momentz(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%forceNodesChord) .AND. ASSOCIATED(u1%forceNodesChord)) THEN - DO i1 = LBOUND(u_out%forceNodesChord,1),UBOUND(u_out%forceNodesChord,1) - b = -(u1%forceNodesChord(i1) - u2%forceNodesChord(i1)) - u_out%forceNodesChord(i1) = u1%forceNodesChord(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE OpFM_Input_ExtrapInterp1 - - - SUBROUTINE OpFM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 -! -!.................................................................................................................................. - - TYPE(OpFM_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(OpFM_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(OpFM_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(OpFM_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ASSOCIATED(u_out%pxVel) .AND. ASSOCIATED(u1%pxVel)) THEN - DO i1 = LBOUND(u_out%pxVel,1),UBOUND(u_out%pxVel,1) - b = (t(3)**2*(u1%pxVel(i1) - u2%pxVel(i1)) + t(2)**2*(-u1%pxVel(i1) + u3%pxVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%pxVel(i1) + t(3)*u2%pxVel(i1) - t(2)*u3%pxVel(i1) ) * scaleFactor - u_out%pxVel(i1) = u1%pxVel(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pyVel) .AND. ASSOCIATED(u1%pyVel)) THEN - DO i1 = LBOUND(u_out%pyVel,1),UBOUND(u_out%pyVel,1) - b = (t(3)**2*(u1%pyVel(i1) - u2%pyVel(i1)) + t(2)**2*(-u1%pyVel(i1) + u3%pyVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%pyVel(i1) + t(3)*u2%pyVel(i1) - t(2)*u3%pyVel(i1) ) * scaleFactor - u_out%pyVel(i1) = u1%pyVel(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pzVel) .AND. ASSOCIATED(u1%pzVel)) THEN - DO i1 = LBOUND(u_out%pzVel,1),UBOUND(u_out%pzVel,1) - b = (t(3)**2*(u1%pzVel(i1) - u2%pzVel(i1)) + t(2)**2*(-u1%pzVel(i1) + u3%pzVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%pzVel(i1) + t(3)*u2%pzVel(i1) - t(2)*u3%pzVel(i1) ) * scaleFactor - u_out%pzVel(i1) = u1%pzVel(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pxForce) .AND. ASSOCIATED(u1%pxForce)) THEN - DO i1 = LBOUND(u_out%pxForce,1),UBOUND(u_out%pxForce,1) - b = (t(3)**2*(u1%pxForce(i1) - u2%pxForce(i1)) + t(2)**2*(-u1%pxForce(i1) + u3%pxForce(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%pxForce(i1) + t(3)*u2%pxForce(i1) - t(2)*u3%pxForce(i1) ) * scaleFactor - u_out%pxForce(i1) = u1%pxForce(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pyForce) .AND. ASSOCIATED(u1%pyForce)) THEN - DO i1 = LBOUND(u_out%pyForce,1),UBOUND(u_out%pyForce,1) - b = (t(3)**2*(u1%pyForce(i1) - u2%pyForce(i1)) + t(2)**2*(-u1%pyForce(i1) + u3%pyForce(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%pyForce(i1) + t(3)*u2%pyForce(i1) - t(2)*u3%pyForce(i1) ) * scaleFactor - u_out%pyForce(i1) = u1%pyForce(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pzForce) .AND. ASSOCIATED(u1%pzForce)) THEN - DO i1 = LBOUND(u_out%pzForce,1),UBOUND(u_out%pzForce,1) - b = (t(3)**2*(u1%pzForce(i1) - u2%pzForce(i1)) + t(2)**2*(-u1%pzForce(i1) + u3%pzForce(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%pzForce(i1) + t(3)*u2%pzForce(i1) - t(2)*u3%pzForce(i1) ) * scaleFactor - u_out%pzForce(i1) = u1%pzForce(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%xdotForce) .AND. ASSOCIATED(u1%xdotForce)) THEN - DO i1 = LBOUND(u_out%xdotForce,1),UBOUND(u_out%xdotForce,1) - b = (t(3)**2*(u1%xdotForce(i1) - u2%xdotForce(i1)) + t(2)**2*(-u1%xdotForce(i1) + u3%xdotForce(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%xdotForce(i1) + t(3)*u2%xdotForce(i1) - t(2)*u3%xdotForce(i1) ) * scaleFactor - u_out%xdotForce(i1) = u1%xdotForce(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%ydotForce) .AND. ASSOCIATED(u1%ydotForce)) THEN - DO i1 = LBOUND(u_out%ydotForce,1),UBOUND(u_out%ydotForce,1) - b = (t(3)**2*(u1%ydotForce(i1) - u2%ydotForce(i1)) + t(2)**2*(-u1%ydotForce(i1) + u3%ydotForce(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%ydotForce(i1) + t(3)*u2%ydotForce(i1) - t(2)*u3%ydotForce(i1) ) * scaleFactor - u_out%ydotForce(i1) = u1%ydotForce(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%zdotForce) .AND. ASSOCIATED(u1%zdotForce)) THEN - DO i1 = LBOUND(u_out%zdotForce,1),UBOUND(u_out%zdotForce,1) - b = (t(3)**2*(u1%zdotForce(i1) - u2%zdotForce(i1)) + t(2)**2*(-u1%zdotForce(i1) + u3%zdotForce(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%zdotForce(i1) + t(3)*u2%zdotForce(i1) - t(2)*u3%zdotForce(i1) ) * scaleFactor - u_out%zdotForce(i1) = u1%zdotForce(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pOrientation) .AND. ASSOCIATED(u1%pOrientation)) THEN - DO i1 = LBOUND(u_out%pOrientation,1),UBOUND(u_out%pOrientation,1) - b = (t(3)**2*(u1%pOrientation(i1) - u2%pOrientation(i1)) + t(2)**2*(-u1%pOrientation(i1) + u3%pOrientation(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%pOrientation(i1) + t(3)*u2%pOrientation(i1) - t(2)*u3%pOrientation(i1) ) * scaleFactor - u_out%pOrientation(i1) = u1%pOrientation(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%fx) .AND. ASSOCIATED(u1%fx)) THEN - DO i1 = LBOUND(u_out%fx,1),UBOUND(u_out%fx,1) - b = (t(3)**2*(u1%fx(i1) - u2%fx(i1)) + t(2)**2*(-u1%fx(i1) + u3%fx(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%fx(i1) + t(3)*u2%fx(i1) - t(2)*u3%fx(i1) ) * scaleFactor - u_out%fx(i1) = u1%fx(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%fy) .AND. ASSOCIATED(u1%fy)) THEN - DO i1 = LBOUND(u_out%fy,1),UBOUND(u_out%fy,1) - b = (t(3)**2*(u1%fy(i1) - u2%fy(i1)) + t(2)**2*(-u1%fy(i1) + u3%fy(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%fy(i1) + t(3)*u2%fy(i1) - t(2)*u3%fy(i1) ) * scaleFactor - u_out%fy(i1) = u1%fy(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%fz) .AND. ASSOCIATED(u1%fz)) THEN - DO i1 = LBOUND(u_out%fz,1),UBOUND(u_out%fz,1) - b = (t(3)**2*(u1%fz(i1) - u2%fz(i1)) + t(2)**2*(-u1%fz(i1) + u3%fz(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%fz(i1) + t(3)*u2%fz(i1) - t(2)*u3%fz(i1) ) * scaleFactor - u_out%fz(i1) = u1%fz(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%momentx) .AND. ASSOCIATED(u1%momentx)) THEN - DO i1 = LBOUND(u_out%momentx,1),UBOUND(u_out%momentx,1) - b = (t(3)**2*(u1%momentx(i1) - u2%momentx(i1)) + t(2)**2*(-u1%momentx(i1) + u3%momentx(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%momentx(i1) + t(3)*u2%momentx(i1) - t(2)*u3%momentx(i1) ) * scaleFactor - u_out%momentx(i1) = u1%momentx(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%momenty) .AND. ASSOCIATED(u1%momenty)) THEN - DO i1 = LBOUND(u_out%momenty,1),UBOUND(u_out%momenty,1) - b = (t(3)**2*(u1%momenty(i1) - u2%momenty(i1)) + t(2)**2*(-u1%momenty(i1) + u3%momenty(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%momenty(i1) + t(3)*u2%momenty(i1) - t(2)*u3%momenty(i1) ) * scaleFactor - u_out%momenty(i1) = u1%momenty(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%momentz) .AND. ASSOCIATED(u1%momentz)) THEN - DO i1 = LBOUND(u_out%momentz,1),UBOUND(u_out%momentz,1) - b = (t(3)**2*(u1%momentz(i1) - u2%momentz(i1)) + t(2)**2*(-u1%momentz(i1) + u3%momentz(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%momentz(i1) + t(3)*u2%momentz(i1) - t(2)*u3%momentz(i1) ) * scaleFactor - u_out%momentz(i1) = u1%momentz(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%forceNodesChord) .AND. ASSOCIATED(u1%forceNodesChord)) THEN - DO i1 = LBOUND(u_out%forceNodesChord,1),UBOUND(u_out%forceNodesChord,1) - b = (t(3)**2*(u1%forceNodesChord(i1) - u2%forceNodesChord(i1)) + t(2)**2*(-u1%forceNodesChord(i1) + u3%forceNodesChord(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%forceNodesChord(i1) + t(3)*u2%forceNodesChord(i1) - t(2)*u3%forceNodesChord(i1) ) * scaleFactor - u_out%forceNodesChord(i1) = u1%forceNodesChord(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE OpFM_Input_ExtrapInterp2 - - - SUBROUTINE OpFM_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(OpFM_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(OpFM_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL OpFM_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL OpFM_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL OpFM_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE OpFM_Output_ExtrapInterp - - - SUBROUTINE OpFM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = y1, f(t2) = y2 -! -!.................................................................................................................................. - - TYPE(OpFM_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(OpFM_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(OpFM_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) -IF (ASSOCIATED(y_out%u) .AND. ASSOCIATED(y1%u)) THEN - DO i1 = LBOUND(y_out%u,1),UBOUND(y_out%u,1) - b = -(y1%u(i1) - y2%u(i1)) - y_out%u(i1) = y1%u(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%v) .AND. ASSOCIATED(y1%v)) THEN - DO i1 = LBOUND(y_out%v,1),UBOUND(y_out%v,1) - b = -(y1%v(i1) - y2%v(i1)) - y_out%v(i1) = y1%v(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%w) .AND. ASSOCIATED(y1%w)) THEN - DO i1 = LBOUND(y_out%w,1),UBOUND(y_out%w,1) - b = -(y1%w(i1) - y2%w(i1)) - y_out%w(i1) = y1%w(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE OpFM_Output_ExtrapInterp1 - - - SUBROUTINE OpFM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 -! -!.................................................................................................................................. - - TYPE(OpFM_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(OpFM_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(OpFM_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(OpFM_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ASSOCIATED(y_out%u) .AND. ASSOCIATED(y1%u)) THEN - DO i1 = LBOUND(y_out%u,1),UBOUND(y_out%u,1) - b = (t(3)**2*(y1%u(i1) - y2%u(i1)) + t(2)**2*(-y1%u(i1) + y3%u(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%u(i1) + t(3)*y2%u(i1) - t(2)*y3%u(i1) ) * scaleFactor - y_out%u(i1) = y1%u(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%v) .AND. ASSOCIATED(y1%v)) THEN - DO i1 = LBOUND(y_out%v,1),UBOUND(y_out%v,1) - b = (t(3)**2*(y1%v(i1) - y2%v(i1)) + t(2)**2*(-y1%v(i1) + y3%v(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%v(i1) + t(3)*y2%v(i1) - t(2)*y3%v(i1) ) * scaleFactor - y_out%v(i1) = y1%v(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%w) .AND. ASSOCIATED(y1%w)) THEN - DO i1 = LBOUND(y_out%w,1),UBOUND(y_out%w,1) - b = (t(3)**2*(y1%w(i1) - y2%w(i1)) + t(2)**2*(-y1%w(i1) + y3%w(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%w(i1) + t(3)*y2%w(i1) - t(2)*y3%w(i1) ) * scaleFactor - y_out%w(i1) = y1%w(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE OpFM_Output_ExtrapInterp2 - -END MODULE OpenFOAM_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/OpenFAST/modules/openfoam/src/OpenFOAM_Types.h b/OpenFAST/modules/openfoam/src/OpenFOAM_Types.h deleted file mode 100644 index a66d6e905..000000000 --- a/OpenFAST/modules/openfoam/src/OpenFOAM_Types.h +++ /dev/null @@ -1,104 +0,0 @@ -//!STARTOFREGISTRYGENERATEDFILE 'OpenFOAM_Types.h' -//! -//! WARNING This file is generated automatically by the FAST registry. -//! Do not edit. Your changes to this file will be lost. -//! - -#ifndef _OpenFOAM_TYPES_H -#define _OpenFOAM_TYPES_H - - -#ifdef _WIN32 //define something for Windows (32-bit) -# include "stdbool.h" -# define CALL __declspec( dllexport ) -#elif _WIN64 //define something for Windows (64-bit) -# include "stdbool.h" -# define CALL __declspec( dllexport ) -#else -# include -# define CALL -#endif - - - typedef struct OpFM_InitInputType { - void * object ; - int NumActForcePtsBlade ; - int NumActForcePtsTower ; - float * StructBldRNodes ; int StructBldRNodes_Len ; - float * StructTwrHNodes ; int StructTwrHNodes_Len ; - float BladeLength ; - float TowerHeight ; - float TowerBaseHeight ; - } OpFM_InitInputType_t ; - typedef struct OpFM_InitOutputType { - void * object ; - char * WriteOutputHdr ; int WriteOutputHdr_Len ; - char * WriteOutputUnt ; int WriteOutputUnt_Len ; - - } OpFM_InitOutputType_t ; - typedef struct OpFM_MiscVarType { - void * object ; - - - - - - - - - } OpFM_MiscVarType_t ; - typedef struct OpFM_ParameterType { - void * object ; - float AirDens ; - int NumBl ; - int NMappings ; - int NnodesVel ; - int NnodesForce ; - int NnodesForceBlade ; - int NnodesForceTower ; - float * forceBldRnodes ; int forceBldRnodes_Len ; - float * forceTwrHnodes ; int forceTwrHnodes_Len ; - float BladeLength ; - float TowerHeight ; - float TowerBaseHeight ; - } OpFM_ParameterType_t ; - typedef struct OpFM_InputType { - void * object ; - float * pxVel ; int pxVel_Len ; - float * pyVel ; int pyVel_Len ; - float * pzVel ; int pzVel_Len ; - float * pxForce ; int pxForce_Len ; - float * pyForce ; int pyForce_Len ; - float * pzForce ; int pzForce_Len ; - float * xdotForce ; int xdotForce_Len ; - float * ydotForce ; int ydotForce_Len ; - float * zdotForce ; int zdotForce_Len ; - float * pOrientation ; int pOrientation_Len ; - float * fx ; int fx_Len ; - float * fy ; int fy_Len ; - float * fz ; int fz_Len ; - float * momentx ; int momentx_Len ; - float * momenty ; int momenty_Len ; - float * momentz ; int momentz_Len ; - float * forceNodesChord ; int forceNodesChord_Len ; - } OpFM_InputType_t ; - typedef struct OpFM_OutputType { - void * object ; - float * u ; int u_Len ; - float * v ; int v_Len ; - float * w ; int w_Len ; - float * WriteOutput ; int WriteOutput_Len ; - } OpFM_OutputType_t ; - typedef struct OpFM_UserData { - OpFM_InitInputType_t OpFM_InitInput ; - OpFM_InitOutputType_t OpFM_InitOutput ; - OpFM_MiscVarType_t OpFM_Misc ; - OpFM_ParameterType_t OpFM_Param ; - OpFM_InputType_t OpFM_Input ; - OpFM_OutputType_t OpFM_Output ; - } OpFM_t ; - -#endif // _OpenFOAM_TYPES_H - - -//!ENDOFREGISTRYGENERATEDFILE diff --git a/OpenFAST/modules/orcaflex-interface/CMakeLists.txt b/OpenFAST/modules/orcaflex-interface/CMakeLists.txt deleted file mode 100644 index fb6da14c5..000000000 --- a/OpenFAST/modules/orcaflex-interface/CMakeLists.txt +++ /dev/null @@ -1,43 +0,0 @@ -# -# Copyright 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. -# - -if (GENERATE_TYPES) - generate_f90_types(src/OrcaFlexInterface.txt ${CMAKE_CURRENT_LIST_DIR}/src/OrcaFlexInterface_Types.f90) -endif() - -if (ORCA_DLL_LOAD) - add_definitions(-DLibLoad) -else (ORCA_DLL_LOAD) - add_definitions(-DNO_LibLoad) -endif (ORCA_DLL_LOAD) - -add_library(orcaflexlib - src/OrcaFlexInterface.f90 - src/OrcaFlexInterface_Types.f90 -) -target_link_libraries(orcaflexlib nwtclibs) - -add_executable(orca_driver - src/OrcaDriver_Subs.f90 - src/OrcaDriver_Types.f90 - src/OrcaDriver.f90) -target_link_libraries(orca_driver orcaflexlib) - -install(TARGETS orcaflexlib orca_driver - EXPORT "${CMAKE_PROJECT_NAME}Libraries" - RUNTIME DESTINATION bin - LIBRARY DESTINATION lib - ARCHIVE DESTINATION lib) diff --git a/OpenFAST/modules/orcaflex-interface/README.md b/OpenFAST/modules/orcaflex-interface/README.md deleted file mode 100644 index ccf27b6cd..000000000 --- a/OpenFAST/modules/orcaflex-interface/README.md +++ /dev/null @@ -1,28 +0,0 @@ -# OrcaFlex Interface Module -The legacy version of this module and additional documentation are available -the [NWTC Software Portal](https://nwtc.nrel.gov/OrcaFlexInterface/). - -## Overview -OrcaFlex is a commercial software package developed by Orcina for the design -and analysis of marine systems. When the OrcaFlexInterface module is used in -OpenFAST, all hydrodynamic and mooring loads will be computed using OrcaFlex, -while the turbine, tower, and floating platform structural dynamics; -aerodynamics; and control and electrical-drive dynamics will be computed by -OpenFAST. - -To use this module with OpenFAST, you will need the following: -- OpenFAST for Windows® -- A valid OrcaFlex license -- FASTlinkDLL.dll; This DLL is compiled by Orcina and is called by OpenFAST - during the simulation to compute the loads on the platform by OrcaFlex. - Both 32- and 64-bit versions of FASTlinkDLL.dll, which are compatible with - the 32- and 64-bit Windows executable versions of OpenFAST, are available - at https://orcina.com/Support/FASTlink.zip. - -## Sample Models -Sample models for OpenFAST and OrcaFlexInterface can be downloaded -[here](https://nwtc.nrel.gov/enduser). - -This self-extracting archive for Windows contains documentation on using the -OpenFAST-OrcaFlex interface as well as several sample models set to call -FASTlinkDLL. diff --git a/OpenFAST/modules/orcaflex-interface/src/OrcaDriver.f90 b/OpenFAST/modules/orcaflex-interface/src/OrcaDriver.f90 deleted file mode 100644 index 667e588cd..000000000 --- a/OpenFAST/modules/orcaflex-interface/src/OrcaDriver.f90 +++ /dev/null @@ -1,655 +0,0 @@ -!**************************************************************************** -! -! PROGRAM: OrcaDriver - This program tests the OrcaFlex calling. -! -!**************************************************************************** -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2015 National Renewable Energy Laboratory -! -! This file is part of Orca. -! -! 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. -! -!********************************************************************************************************************************** -! File last committed: $Date: 2014-07-29 13:30:04 -0600 (Tue, 29 Jul 2014) $ -! (File) Revision #: $Rev: 173 $ -! URL: $HeadURL: https://wind-dev.nrel.gov/svn/OrcaFlexInterface/Trunk/Source/Driver/OrcaDriver.f90 $ -!********************************************************************************************************************************** - -PROGRAM OrcaDriver - - USE NWTC_Library - USE OrcaDriver_Types - USE OrcaDriver_Subs - USE OrcaFlexInterface - - IMPLICIT NONE - - ! Info on this code - TYPE( ProgDesc ), PARAMETER :: ProgInfo = ProgDesc("Orca_Driver","","") - INTEGER(IntKi) :: OrcaDriver_Verbose = 5 ! Verbose level. 0 = none, 5 = some, 10 = lots - - ! Types needed here (from Orca module) - TYPE(Orca_InitInputType) :: Orca_InitInp ! Data for initialization -- this is where the input info goes - TYPE(Orca_InputType) :: Orca_u ! input -- contains xyz coords of interest -- set 1 - TYPE(Orca_ParameterType) :: Orca_p ! Parameters - TYPE(Orca_ContinuousStateType) :: Orca_x ! Continous State Data (not used here) - TYPE(Orca_DiscreteStateType) :: Orca_xd ! Discrete State Data (not used here) - TYPE(Orca_ConstraintStateType) :: Orca_z ! Constraint State Data (not used here) - TYPE(Orca_OtherStateType) :: Orca_OtherState ! Other State Data - TYPE(Orca_MiscVarType) :: Orca_m ! Misc/optimization data - TYPE(Orca_OutputType) :: Orca_y ! Output Data -- contains the velocities at xyz -- set 1 - TYPE(Orca_InitOutputType) :: Orca_InitOut ! Output Data -- contains the names and units - - - ! Local variables for this code - TYPE(OrcaDriver_Flags) :: CLSettingsFlags ! Flags indicating which command line arguments were specified - TYPE(OrcaDriver_Settings) :: CLSettings ! Command line arguments passed in - TYPE(OrcaDriver_Flags) :: SettingsFlags ! Flags indicating which settings were specified (includes CL and ipt file) - TYPE(OrcaDriver_Settings) :: Settings ! Driver settings - REAL(DbKi) :: Timer(1:2) ! Keep track of how long this takes to run - REAL(DbKi) :: TimeNow ! The current time - INTEGER(IntKi) :: NumTotalPoints ! Number of points for this iteration - LOGICAL :: TempFileExist ! Flag for inquiring file existence - CHARACTER(11) :: TmpNumString ! Temporary string for holding a number - REAL(ReKi) :: CosineMatrix(3,3) ! Cosine matrix for rotations in the mesh - - - ! Local variables for storing the arrays - REAL(ReKi),ALLOCATABLE :: TimeList(:) !< Timestamp data - REAL(ReKi),ALLOCATABLE :: PointsList(:,:) !< (X,Y,Z,R1,R2,R3) coordinates read from Points input file. - REAL(ReKi),ALLOCATABLE :: VelocList(:,:) !< Translational and rotational time derivatives at each point in PointsList - REAL(ReKi),ALLOCATABLE :: AccelList(:,:) !< Translational and rotational 2nd time derivatives at each point in PointsList - INTEGER(IntKi) :: I,J,K,Counter !< Generic counters/indices - - ! Temporary variables - CHARACTER(1024) :: TmpChar ! Temporary character variable - LOGICAL :: TmpFlag ! Temporary flag - INTEGER(IntKi) :: TmpUnit ! Temporary unit for quick I/O operation - INTEGER(IntKi) :: debug_print_unit - - ! Local Error Handling - INTEGER(IntKi) :: ErrStat - CHARACTER(1024) :: ErrMsg - INTEGER(IntKi) :: ErrStatTmp - CHARACTER(2048) :: ErrMsgTmp - INTEGER(IntKi) :: LenErrMsgTmp ! Length of ErrMsgTmp - - - !-------------------------------------------------------------------------- - !-=-=- Initialize the Library -=-=- - !-------------------------------------------------------------------------- - - CALL NWTC_Init - CALL DispNVD(ProgInfo) - -! Beep = .FALSE. - - - - !-------------------------------------------------------------------------------------------------------------------------------- - !-=-=- Setup the program -=-=- - !-------------------------------------------------------------------------------------------------------------------------------- - - ! Start the timer - CALL CPU_TIME( Timer(1) ) - - - ! Set some CLSettings to null/default values - CLSettings%DvrIptFileName = "" ! No input name name until set - CLSettings%OrcaIptFileName = "" ! No Orca input file name until set - CLSettings%AddedMassFileName = "" ! No summary file name until set - CLSettings%DT = 0.0_DbKi - CLSettings%PtfmCoord = 0.0_ReKi ! Set to origin - CLSettings%PtfmVeloc = 0.0_ReKi ! Set to origin - CLSettings%PtfmAccel = 0.0_ReKi ! Set to origin - CLSettings%PointsFileName = "" ! No points file name until set - CLSettings%PointsOutputName = "" ! No points file name until set - CLSettings%PointsOutputUnit = -1_IntKi ! No Points file output unit set - CLSettings%ProgInfo = ProgInfo ! Driver info - - ! Set some CLSettingsFlags to null/default values - CLSettingsFlags%DvrIptFile = .FALSE. ! Driver input filename given as command line argument - CLSettingsFlags%OrcaIptFile = .FALSE. ! Orca input filename given as command line argument - CLSettingsFlags%AddedMass = .FALSE. ! create a summary at command line? (data extents in the wind file) - CLSettingsFlags%Degrees = .FALSE. ! Angles specified in degrees for PtfmCoord and PtfmVeloc - CLSettingsFlags%PointsDegrees = .FALSE. ! Angles specified in degrees in the points file - CLSettingsFlags%AddedMassFile = .FALSE. ! create a summary file of the output? - CLSettingsFlags%DT = .FALSE. ! specified a resolution in time - CLSettingsFlags%DTDefault = .FALSE. ! specified 'DEFAULT' for resolution in time - CLSettingsFlags%PtfmCoord = .FALSE. ! PtfmCoord specified - CLSettingsFlags%PtfmVeloc = .FALSE. ! PtfmVeloc specified - CLSettingsFlags%PtfmAccel = .FALSE. ! PtfmAccel specified - CLSettingsFlags%PointsFile = .FALSE. ! points filename to read in -- command line option only - CLSettingsFlags%PointsOutputInit = .FALSE. ! Points output file not started - CLSettingsFlags%Verbose = .FALSE. ! Turn on verbose error reporting? - CLSettingsFlags%VVerbose = .FALSE. ! Turn on very verbose error reporting? - - - ! Initialize the driver settings to their default values (same as the CL -- command line -- values) - Settings = CLSettings - SettingsFlags = CLSettingsFlags - - - !-------------------------------------------------------------------------------------------------------------------------------- - !-=-=- Parse the command line inputs -=-=- - !-------------------------------------------------------------------------------------------------------------------------------- - CALL RetrieveArgs( CLSettings, CLSettingsFlags, ErrStat, ErrMsg ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL ProgAbort( ErrMsg ) - ELSEIF ( ErrStat /= 0 ) THEN - CALL WrScr( NewLine//ErrMsg ) - ErrStat = ErrID_None - ErrMsg = '' - ENDIF - - - ! Check if we are doing verbose error reporting - IF ( CLSettingsFlags%VVerbose ) THEN - OrcaDriver_Verbose = 10_IntKi - ENDIF - IF ( CLSettingsFlags%Verbose ) THEN - OrcaDriver_Verbose = 7_IntKi - ENDIF - - - - ! Verbose error reporting - IF ( OrcaDriver_Verbose >= 10_IntKi ) THEN - CALL WrScr('--- Settings from the command line: ---') - CALL printSettings( CLSettingsFlags, CLSettings ) - CALL WrSCr(NewLine) - ENDIF - - - ! Verbose error reporting - IF ( OrcaDriver_Verbose >= 10_IntKi ) THEN - CALL WrScr('--- Driver settings (before reading driver ipt file): ---') - CALL printSettings( SettingsFlags, Settings ) - CALL WrScr(NewLine) - ENDIF - - - - - ! Copy the input file information from the CLSettings to the Settings. - ! At this point only one input file type can be set. - IF ( CLSettingsFlags%DvrIptFile ) THEN - SettingsFlags%DvrIptFile = CLSettingsFlags%DvrIptFile - Settings%DvrIptFileName = CLSettings%DvrIptFileName - ELSE - SettingsFlags%OrcaIptFile = CLSettingsFlags%OrcaIptFile - Settings%OrcaIptFileName = CLSettings%OrcaIptFileName - ENDIF - - - ! If the filename given was not the Orca input file (-ifw option), then it is treated - ! as the driver input file (flag should be set correctly by RetrieveArgs). So, we must - ! open this. - IF ( SettingsFlags%DvrIptFile ) THEN - - ! Read the driver input file - CALL ReadDvrIptFile( CLSettings%DvrIptFileName, SettingsFlags, Settings, ProgInfo, ErrStat, ErrMsg ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL ProgAbort( ErrMsg ) - ELSEIF ( ErrStat /= 0 ) THEN - CALL WrScr( NewLine//ErrMsg ) - ErrStat = ErrID_None - ErrMsg = '' - ENDIF - - - ! VVerbose error reporting - IF ( OrcaDriver_Verbose >= 10_IntKi ) THEN - CALL WrScr(NewLine//'--- Driver settings after reading the driver ipt file: ---') - CALL printSettings( SettingsFlags, Settings ) - CALL WrScr(NewLine) - ENDIF - - - ! VVerbose error reporting - IF ( OrcaDriver_Verbose >= 10_IntKi ) CALL WrScr('Updating driver settings with command line arguments') - - - ! Now that we have read in the driver input settings, we need to override these with any - ! values from the command line arguments. The .TRUE. indicates that a driver input file - ! was read. - CALL UpdateSettingsWithCL( SettingsFlags, Settings, CLSettingsFlags, CLSettings, .TRUE., ErrStat, ErrMsg ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL ProgAbort( ErrMsg ) - ELSEIF ( ErrStat /= ErrID_None ) THEN - CALL WrScr( NewLine//ErrMsg ) - ErrStat = ErrID_None - ErrMsg = '' - ENDIF - - ! Verbose error reporting - IF ( OrcaDriver_Verbose >= 10_IntKi ) THEN - CALL WrSCr(NewLine//'--- Driver settings after copying over CL settings: ---') - CALL printSettings( SettingsFlags, Settings ) - CALL WrScr(NewLine) - ENDIF - - - ELSE - - - ! VVerbose error reporting - IF ( OrcaDriver_Verbose >= 10_IntKi ) CALL WrScr('No driver input file used. Updating driver settings with command line arguments') - - - ! Since there were no settings picked up from the driver input file, we need to copy over all - ! the CLSettings into the regular Settings. The .FALSE. is a flag indicating that the driver - ! input file was not read. - CALL UpdateSettingsWithCL( SettingsFlags, Settings, CLSettingsFlags, CLSettings, .FALSE., ErrStat, ErrMsg ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL ProgAbort( ErrMsg ) - ELSEIF ( ErrStat /= ErrID_None ) THEN - CALL WrScr( NewLine//ErrMsg ) - ErrStat = ErrID_None - ErrMsg = '' - ENDIF - - ! Verbose error reporting - IF ( OrcaDriver_Verbose >= 10_IntKi ) THEN - CALL WrScr(NewLine//'--- Driver settings after copying over CL settings: ---') - CALL printSettings( SettingsFlags, Settings ) - CALL WrScr(NewLine) - ENDIF - - ENDIF - - - - ! Sanity check: if an input points file is specified, make sure it actually exists. Open it if specified - - IF ( SettingsFlags%PointsFile ) THEN - INQUIRE( file=TRIM(Settings%PointsFileName), exist=TempFileExist ) - IF ( TempFileExist .eqv. .FALSE. ) CALL ProgAbort( "Cannot find the points file "//TRIM(Settings%PointsFileName)) - - ! Now read the file in and save the points - CALL ReadPointsFile( Settings%PointsFileName, SettingsFlags%PointsDegrees, TimeList, PointsList, VelocList, AccelList, ErrStat,ErrMsg ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL ProgAbort( ErrMsg ) - ELSEIF ( ErrStat /= 0 ) THEN - CALL WrScr( NewLine//ErrMsg ) - ErrStat = ErrID_None - ErrMsg = '' - ENDIF - - ! Make name for output - CALL GetRoot( Settings%PointsFileName, Settings%PointsOutputName ) - Settings%PointsOutputName = TRIM(Settings%PointsOutputName)//'.Forces.dat' - - CALL WrScr(NewLine//"Read "//TRIM(Num2LStr(SIZE(PointsList,DIM=2)))//" points from '"//TRIM(Settings%PointsFileName)// & - "'. Results output to '"//TRIM(Settings%PointsOutputName)//"'.") - - ! If the output file already exists, warn that it will be overwritten - INQUIRE( file=TRIM(Settings%PointsOutputName), exist=TempFileExist ) - IF ( TempFileExist .eqv. .TRUE. ) CALL ProgWarn( "Overwriting file "//TRIM(Settings%PointsOutputName)) - - ENDIF - - - - ! AddedMass file output - IF ( SettingsFlags%AddedMassFile ) THEN - - ! Create AddedMassFile output name - IF ( SettingsFlags%DvrIptFile ) THEN - CALL GetRoot( Settings%DvrIptFileName, Settings%AddedMassFileName ) - ELSE - CALL GetRoot( Settings%OrcaIptFileName, Settings%AddedMassFileName ) - ENDIF - - Settings%AddedMassFileName = TRIM(Settings%AddedMassFileName)//'.am' - - IF ( OrcaDriver_Verbose >= 10_IntKi ) CALL WrScr('Driver summary output file: '//TRIM(Settings%AddedMassFileName)) - - ENDIF - - - ! Give status update of the driver flags, if verbose - IF ( OrcaDriver_Verbose >= 7_IntKi ) THEN - CALL WrScr(NewLine//'--- Driver settings after finalizing: ---') - CALL printSettings( SettingsFlags, Settings ) - CALL WrScr(NewLine) - ENDIF - - - ! Set the TMax value (this is a made up number just so that we have something we can pass to OrcaFlex - IF ( SettingsFlags%PointsFile ) THEN - Settings%TMax = SIZE(PointsList,DIM=2)*Settings%DT - ELSE - Settings%TMax=100_ReKi - ENDIF - - !-------------------------------------------------------------------------------------------------------------------------------- - !-=-=- Initialize the Module -=-=- - !-------------------------------------------------------------------------------------------------------------------------------- - ! Initialize the Orca module --> it will initialize the DLL. - - - ! Some initialization settings - Orca_InitInp%InputFile = Settings%OrcaIptFileName - CALL GetRoot( Orca_InitInp%InputFile, Orca_InitInp%RootName ) - Orca_InitInp%TMax = Settings%TMax - - - IF ( OrcaDriver_Verbose >= 5_IntKi ) CALL WrScr('Calling Orca_Init...') - - - CALL Orca_Init( Orca_InitInp, Orca_u, Orca_p, & - Orca_x, Orca_xd, Orca_z, Orca_OtherState, & - Orca_y, Orca_m, Settings%DT, Orca_InitOut, ErrStat, ErrMsg ) - - - ! Make sure no errors occured that give us reason to terminate now. - IF ( ErrStat >= AbortErrLev ) THEN - CALL DriverCleanup() - CALL ProgAbort( ErrMsg ) - ELSEIF ( ( ErrStat /= ErrID_None ) .AND. ( OrcaDriver_Verbose >= 7_IntKi ) ) THEN - CALL WrScr(NewLine//' Orca_Init returned: ErrStat: '//TRIM(Num2LStr(ErrStat))// & - NewLine//' ErrMsg: '//TRIM(ErrMsg)//NewLine) - ErrStat = ErrID_None - ErrMsg = '' - ELSEIF ( ( ErrStat /= ErrID_None ) .AND. ( OrcaDriver_Verbose < 7_IntKi ) ) THEN - CALL ProgWarn( ErrMsg ) - ErrStat = ErrID_None - ErrMsg = '' - ENDIF - - - - ! Let user know we returned from the Orca code if verbose - IF ( OrcaDriver_Verbose >= 5_IntKi ) CALL WrScr(NewLine//'Orca_Init CALL returned without errors.'//NewLine) - - - - - !-------------------------------------------------------------------------------------------------------------------------------- - !-=-=- Other Setup -=-=- - !-------------------------------------------------------------------------------------------------------------------------------- - ! Setup any additional things - - - ! Timestep -- The timestep for the calling Orca_CalcOutput may need to be changed to what is in the file if the - ! DT = DEFAULT option was used in the driver input file. This does not need to be changed in the Orca_Parameters - ! since Orca doesn't care what the timestep is. - - IF ( SettingsFlags%DTDefault ) THEN - - Settings%DT = 0.025_ReKi - - IF ( OrcaDriver_Verbose >= 5 ) CALL WrScr(' DEFAULT requested for DT. Setting to 0.025 for arbitrary reasons (the developer picked some random number here).') - - ENDIF - - - - - !-------------------------------------------------------------------------------------------------------------------------------- - !-=-=- Time stepping loop -=-=- - !-------------------------------------------------------------------------------------------------------------------------------- - - - IF ( OrcaDriver_Verbose >= 5_IntKi ) CALL WrScr(NewLine//'Calling Orca_CalcOutput...'//NewLine) - - - IF ( SettingsFlags%PointsFile ) THEN - DO I=1,SIZE(PointsList,DIM=2) - - ! Setup the mesh coordinates (columns 1-6) - Orca_u%PtfmMesh%TranslationDisp(:,1) = PointsList(1:3,I) - - ! Compute direction cosine matrix from the rotation angles - CALL SmllRotTrans( 'InputRotation', PointsList(4,I), PointsList(5,I), PointsList(6,I), CosineMatrix, 'CosineMatrix calc', ErrStat, ErrMsg ) - Orca_u%PtfmMesh%Orientation(:,:,1) = CosineMatrix - - - ! Setup the velocity terms of the mesh (columns 7:12) - Orca_u%PtfmMesh%TranslationVel(:,1) = VelocList(1:3,I) - Orca_u%PtfmMesh%RotationVel(:,1) = VelocList(4:6,I) - - - ! Setup the Acceleration terms of the mesh (columns 13:18) - Orca_u%PtfmMesh%TranslationAcc(:,1) = AccelList(1:3,I) - Orca_u%PtfmMesh%RotationAcc(:,1) = AccelList(4:6,I) - - - TimeNow = TimeList(I) - - - - - - - ! Get results for Points data from Orca - CALL Orca_CalcOutput( TimeNow, Orca_u, Orca_p, & - Orca_x, Orca_xd, Orca_z, Orca_OtherState, & - Orca_y, Orca_m, ErrStat, ErrMsg) - -!debug_print_unit = 80 -!call WrNumAryFileNR(debug_print_unit,(/TimeNow/), "1x,ES15.5E3", ErrStat, ErrMsg ) -!call WrNumAryFileNR(debug_print_unit,Orca_y%WriteOutput, "1x,ES15.5E3", ErrStat, ErrMsg ) -!write(debug_print_unit,'()') - - - - ! Make sure no errors occured that give us reason to terminate now. - IF ( ErrStat >= AbortErrLev ) THEN - CALL DriverCleanup() - CALL ProgAbort( ErrMsg ) - ELSEIF ( ( ErrStat /= ErrID_None ) .AND. ( OrcaDriver_Verbose >= 7_IntKi ) ) THEN - CALL WrScr(NewLine//' Orca_Calc returned: ErrStat: '//TRIM(Num2LStr(ErrStat))// & - NewLine//' ErrMsg: '//TRIM(ErrMsg)//NewLine) - ErrStat = ErrID_None - ErrMsg = '' - ELSEIF ( ( ErrStat /= ErrID_None ) .AND. ( OrcaDriver_Verbose < 7_IntKi ) ) THEN - CALL ProgWarn( ErrMsg ) - ErrStat = ErrID_None - ErrMsg = '' - ENDIF - - - ! Output the Points results for this timestep - CALL PointsForce_OutputWrite( Settings%ProgInfo, Settings%PointsOutputUnit, Settings%PointsOutputName, Settings%PointsFileName, & - SettingsFlags%PointsOutputInit, SettingsFlags%PointsDegrees, SIZE(PointsList,DIM=2), & - TimeNow, Orca_InitOut, Orca_p, Orca_u, Orca_y, ErrStat, ErrMsg ) - - IF ( ErrStat >= AbortErrLev ) THEN - CALL DriverCleanup() - CALL ProgAbort( ErrMsg ) - ENDIF - - - ENDDO - ENDIF - - - IF ( SettingsFlags%PtfmCoord ) THEN - - ! Setup the mesh coordinates (columns 1-6) for the coordinate specified - Orca_u%PtfmMesh%TranslationDisp(:,1) = Settings%PtfmCoord(1:3) - - ! Compute direction cosine matrix from the rotation angles - CALL SmllRotTrans( 'InputRotation', Settings%PtfmCoord(4), Settings%PtfmCoord(5), Settings%PtfmCoord(6), CosineMatrix, 'CosineMatrix calc', ErrStat, ErrMsg ) - Orca_u%PtfmMesh%Orientation(:,:,1) = CosineMatrix - - - ! Setup the velocity terms of the mesh (columns 7:12) - Orca_u%PtfmMesh%TranslationVel(:,1) = Settings%PtfmVeloc(1:3) - Orca_u%PtfmMesh%RotationVel(:,1) = Settings%PtfmVeloc(4:6) - - - ! Setup the Acceleration terms of the mesh (columns 13:18) - Orca_u%PtfmMesh%TranslationAcc(:,1) = Settings%PtfmAccel(1:3) - Orca_u%PtfmMesh%RotationAcc(:,1) = Settings%PtfmAccel(4:6) - - TimeNow = Settings%DT - - ! Get results for Points data from Orca - CALL Orca_CalcOutput( TimeNow, Orca_u, Orca_p, & - Orca_x, Orca_xd, Orca_z, Orca_OtherState, & - Orca_y, Orca_m, ErrStat, ErrMsg) - - - ! Make sure no errors occured that give us reason to terminate now. - IF ( ErrStat >= AbortErrLev ) THEN - CALL DriverCleanup() - CALL ProgAbort( ErrMsg ) - ELSEIF ( ( ErrStat /= ErrID_None ) .AND. ( OrcaDriver_Verbose >= 7_IntKi ) ) THEN - CALL WrScr(NewLine//' Orca_Calc returned: ErrStat: '//TRIM(Num2LStr(ErrStat))// & - NewLine//' ErrMsg: '//TRIM(ErrMsg)//NewLine) - ErrStat = ErrID_None - ErrMsg = '' - ELSEIF ( ( ErrStat /= ErrID_None ) .AND. ( OrcaDriver_Verbose < 7_IntKi ) ) THEN - CALL ProgWarn( ErrMsg ) - ErrStat = ErrID_None - ErrMsg = '' - ENDIF - - - - - - ! write the output file. This is a bit of a hack here to use the same routine as used for the points file output - TmpFlag = .FALSE. ! Tell the subroutine that it has not initialized the file before - TmpUnit = -1 ! Temporary unit number to pass - CALL GetRoot( Settings%DvrIptFileName, TmpChar ) ! Get the root name - TmpChar=TRIM(TmpChar)//'.out' - - ! Call routine to write the output file for this one point - CALL PointsForce_OutputWrite( Settings%ProgInfo, TmpUnit, TmpChar, TmpChar, TmpFlag, SettingsFlags%Degrees, 0, & - TimeNow, Orca_InitOut, Orca_p, Orca_u, Orca_y, ErrStat, ErrMsg ) - CLOSE(TmpUnit) - - ! Make sure no errors occured that give us reason to terminate now. - IF ( ErrStat >= AbortErrLev ) THEN - CALL DriverCleanup() - CALL ProgAbort( ErrMsg ) - ELSEIF ( ( ErrStat /= ErrID_None ) .AND. ( OrcaDriver_Verbose >= 7_IntKi ) ) THEN - CALL WrScr(NewLine//' PointsForce_OutputWrite: ErrStat: '//TRIM(Num2LStr(ErrStat))// & - NewLine//' ErrMsg: '//TRIM(ErrMsg)//NewLine) - ErrStat = ErrID_None - ErrMsg = '' - ELSEIF ( ( ErrStat /= ErrID_None ) .AND. ( OrcaDriver_Verbose < 7_IntKi ) ) THEN - CALL ProgWarn( ErrMsg ) - ErrStat = ErrID_None - ErrMsg = '' - ENDIF - - ENDIF - - ! Verbose error reporting - IF ( OrcaDriver_Verbose >= 10_IntKi ) THEN - CALL WrScr(NewLine//'--- Driver settings after CalcOutput call: ---') - CALL printSettings( SettingsFlags, Settings ) - CALL WrScr(NewLine) - ENDIF - - - !-------------------------------------------------------------------------------------------------------------------------------- - !-=-=- Calculate OtherStates -=-=- - !-------------------------------------------------------------------------------------------------------------------------------- - ! - ! None - - - - !-------------------------------------------------------------------------------------------------------------------------------- - !-=-=- Output results -=-=- - !-------------------------------------------------------------------------------------------------------------------------------- - - - ! AddedMass output to command line - IF ( SettingsFlags%AddedMass ) THEN - CALL AddedMassMessage( Orca_m%PtfmAM, .FALSE., ErrMsgTmp, LenErrMsgTmp ) ! .FALSE. for no comment characters. ErrMsgTmp holds the message. - CALL WrScr(NewLine//TRIM(ErrMsgTmp)//NewLine) - ENDIF - - ! AddedMass output to file - IF ( SettingsFlags%AddedMassFile ) THEN - CALL AddedMass_OutputWrite( Settings, SettingsFlags%AddedMassOutputInit, & - Orca_m%PtfmAM, ErrStat, ErrMsg ) - ! Make sure no errors occured that give us reason to terminate now. - IF ( ErrStat >= AbortErrLev ) THEN - CALL DriverCleanup() - CALL ProgAbort( ErrMsg ) - ELSEIF ( ( ErrStat /= ErrID_None ) .AND. ( OrcaDriver_Verbose >= 7_IntKi ) ) THEN - CALL WrScr(NewLine//' AddedMass_OutputWrite ErrStat: '//TRIM(Num2LStr(ErrStat))// & - NewLine//' ErrMsg: '//TRIM(ErrMsg)//NewLine) - ErrStat = ErrID_None - ErrMsg = '' - ELSEIF ( ( ErrStat /= ErrID_None ) .AND. ( OrcaDriver_Verbose < 7_IntKi ) ) THEN - CALL ProgWarn( ErrMsg ) - ErrStat = ErrID_None - ErrMsg = '' - ENDIF - ENDIF - - - - !-------------------------------------------------------------------------------------------------------------------------------- - !-=-=- We are done, so close everything down -=-=- - !-------------------------------------------------------------------------------------------------------------------------------- - - CALL Orca_DestroyInitOutput( Orca_InitOut, ErrStat, ErrMsg ) - - CALL Orca_End( Orca_u, Orca_p, & - Orca_x, Orca_xd, Orca_z, Orca_OtherState, & - Orca_y, Orca_m, ErrStat, ErrMsg ) - - ! Make sure no errors occured that give us reason to terminate now. - IF ( ErrStat >= AbortErrLev ) THEN - CALL DriverCleanup() - CALL ProgAbort( ErrMsg ) - ELSEIF ( ( ErrStat /= ErrID_None ) .AND. ( OrcaDriver_Verbose >= 7_IntKi ) ) THEN - CALL WrScr(NewLine//' Orca_End returned: ErrStat: '//TRIM(Num2LStr(ErrStat))// & - NewLine//' ErrMsg: '//TRIM(ErrMsg)//NewLine) - ErrStat = ErrID_None - ErrMsg = '' - ELSEIF ( ( ErrStat /= ErrID_None ) .AND. ( OrcaDriver_Verbose < 7_IntKi ) ) THEN - CALL ProgWarn( ErrMsg ) - ErrStat = ErrID_None - ErrMsg = '' - ELSEIF ( OrcaDriver_Verbose >= 7_IntKi ) THEN - CALL WrScr(NewLine//' Orca_End call: ok') - ENDIF - - - CALL DriverCleanup() - -CONTAINS - - SUBROUTINE DriverCleanup() - - - CLOSE( Settings%AddedMassOutputUnit ) - CLOSE( Settings%PointsOutputUnit ) - - - ! Find out how long this actually took - CALL CPU_TIME( Timer(2) ) - CALL WrScr(NewLine//'Elapsed time: '//TRIM(Num2LStr(Timer(2)-Timer(1)))//' seconds') - - - END SUBROUTINE DriverCleanup - - -END PROGRAM OrcaDriver - - - - diff --git a/OpenFAST/modules/orcaflex-interface/src/OrcaDriver_Subs.f90 b/OpenFAST/modules/orcaflex-interface/src/OrcaDriver_Subs.f90 deleted file mode 100644 index e07b6105c..000000000 --- a/OpenFAST/modules/orcaflex-interface/src/OrcaDriver_Subs.f90 +++ /dev/null @@ -1,2088 +0,0 @@ -!********************************************************************************************************************************** -! -! MODULE: OrcaDriver_Subs - This module contains subroutines used by the OrcaFlexInterface Driver program -! -!********************************************************************************************************************************** -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2015 National Renewable Energy Laboratory -! -! This file is part of OrcaFlexInterface. -! -! 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. -! -!********************************************************************************************************************************** -! File last committed: $Date: 2014-07-29 13:30:04 -0600 (Tue, 29 Jul 2014) $ -! (File) Revision #: $Rev: 169 $ -! URL: $HeadURL: https://wind-dev.nrel.gov/svn/OrcaFlexInterface/Trunk/Source/Driver/OrcaDriver_Subs.f90 $ -!********************************************************************************************************************************** -MODULE OrcaDriver_Subs - - USE NWTC_Library - USE OrcaDriver_Types - IMPLICIT NONE - - -CONTAINS -!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- -!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- -SUBROUTINE DispHelpText( ErrStat, ErrMsg ) - !-=-=-=-=-=-=-=-=-=-=-=-=-=-=-! - ! Print out help information ! - !-=-=-=-=-=-=-=-=-=-=-=-=-=-=-! - - USE NWTC_Library - - IMPLICIT NONE - - ! Error Handling - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - ErrStat = ErrID_None - ErrMsg = '' - - - ! Statement about usage - CALL WrScr("") - CALL WrScr(" Syntax: InlowWind_Driver [options]") - CALL WrScr("") - CALL WrScr(" where: -- Name of driver input file to use") - CALL WrScr("") - CALL WrScr(" The following options will overwrite values in the driver input file:") - CALL WrScr(" "//SwChar//"DT[#] -- timestep ") - CALL WrScr(" "//SwChar//"degrees -- input angles specified in degrees ") - CALL WrScr(" "//SwChar//"pointsdegrees -- input angles in points filespecified in degrees ") - CALL WrScr(" "//SwChar//"Coord[X,Y,Z,R1,R2,R3] ") - CALL WrScr(" -- platform origin centered at [X,Y,Z] ") - CALL WrScr(" with Roll / Pitch / Yaw of [R1,R2,R3] ") - CALL WrScr(" "//SwChar//"points[FILE] -- calculates at a given position specified in a ") - CALL WrScr(" comma delimited FILE.") - CALL WrScr(" "//SwChar//"v -- increase verbose level to 7 ") - CALL WrScr(" "//SwChar//"vv -- increase verbose level to 10 ") - CALL WrScr(" "//SwChar//"help -- print this help menu and exit") - CALL WrScr("") - CALL WrScr(" Notes:") - CALL WrScr(" -- Options are not case sensitive.") - CALL WrScr(" -- If no coordinates are specified, assumed to be at (0,0,0) with no rotation") - CALL WrScr("") - - -END SUBROUTINE DispHelpText - - -!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- -!> This subroutine retrieves the command line arguments and passes them to the -!! ::ParseArg routine for processing. -SUBROUTINE RetrieveArgs( CLSettings, CLFlags, ErrStat, ErrMsg ) - - USE NWTC_Library - USE OrcaDriver_Types - - IMPLICIT NONE - - ! Storing the arguments - TYPE( OrcaDriver_Flags ), INTENT( OUT) :: CLFlags !< Flags indicating which command line arguments were specified - TYPE( OrcaDriver_Settings ), INTENT( OUT) :: CLSettings !< Command line arguments passed in - - ! Error Handling - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - ! Local variable - INTEGER(IntKi) :: i !< Generic counter - CHARACTER(1024) :: Arg !< argument given - CHARACTER(1024) :: ArgUC !< Upper case argument to check - INTEGER(IntKi) :: NumInputArgs !< Number of argements passed in from command line - LOGICAL :: ifwFlag !< The -ifw flag was set - CHARACTER(1024) :: FileName !< Filename from the command line. - LOGICAL :: FileNameGiven !< Flag indicating if a filename was given. - - INTEGER(IntKi) :: ErrStatTmp !< Temporary error status (for calls) - CHARACTER(1024) :: ErrMsgTmp !< Temporary error message (for calls) - CHARACTER(*), PARAMETER :: RoutineName = 'RetrieveArgs' - - - ! initialize some things - ErrStat = ErrID_None - ErrStatTmp = ErrID_None - ErrMsg = '' - ErrMsgTmp = '' - FileNameGiven = .FALSE. - FileName = '' - - - ! Check how many arguments are passed in - NumInputArgs = COMMAND_ARGUMENT_COUNT() - - ! exit if we don't have enough - IF (NumInputArgs == 0) THEN - CALL SetErrStat(ErrID_Fatal," Insufficient Arguments. Use option "//SwChar//"help for help menu.", & - ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - - - ! Loop through all the arguments, and store them - DO i=1,NumInputArgs - ! get the ith argument - CALL get_command_argument(i, Arg) - ArgUC = Arg - - ! convert to uppercase - CALL Conv2UC( ArgUC ) - - - ! Check to see if it is a control parameter or the filename - IF ( INDEX( SwChar, ArgUC(1:1) ) > 0 ) THEN - - ! check to see if we asked for help - IF ( ArgUC(2:5) == "HELP" ) THEN - CALL DispHelpText( ErrStat, ErrMsg ) - CALL ProgExit(0) - ENDIF - - - ! Check the argument and put it where it belongs - ! chop the SwChar off before passing the argument - CALL ParseArg( CLSettings, CLFlags, ArgUC(2:), Arg(2:), ifwFlag, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - IF (ErrStat>AbortErrLev) RETURN - - ELSE - - ! since there is no switch character, assume it is the filename, unless we already set one - IF ( FileNameGiven ) THEN - CALL SetErrStat(ErrID_Fatal," Multiple driver input filenames given: "//TRIM(FileName)//", "//TRIM(Arg), & - ErrStat,ErrMsg,RoutineName) - RETURN - ELSE - FileName = TRIM(Arg) - FileNameGiven = .TRUE. - ENDIF - - ENDIF - END DO - - - ! Was a filename given? - IF ( .NOT. FileNameGiven ) THEN - CALL SetErrStat( ErrID_Fatal, " No filename given.", ErrStat, ErrMsg, RoutineName ) - RETURN - ELSE - CLSettings%DvrIptFileName = TRIM(FileName) - CLFlags%DvrIptFile = .TRUE. - ENDIF - - - - - !------------------------------------------------------------------------------- - !------------------------------------------------------------------------------- - CONTAINS - - - !------------------------------------------------------------------------------- - FUNCTION StringToReal( StringIn, ErrStat ) - !-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-! - ! Convert a string to a real number ! - !-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-! - - IMPLICIT NONE - - ! Error Handling - INTEGER(IntKi), INTENT( OUT) :: ErrStat - - ! Input - CHARACTER(*), INTENT(IN ) :: StringIn - - ! Returned value - REAL(ReKi) :: StringToReal - - ! Local Variables - INTEGER(IntKi) :: ErrStatTmp ! Temporary variable to hold the error status - - read( StringIn, *, iostat=ErrStatTmp) StringToReal - - ! If that isn't a number, only warn since we can continue by skipping this value - IF ( ErrStatTmp .ne. 0 ) ErrStat = ErrID_Warn - - END FUNCTION StringToReal - - - - !------------------------------------------------------------------------------- - SUBROUTINE ParseArg( CLSettings, CLFlags, ThisArgUC, ThisArg, ifwFlagSet, ErrStat, ErrMsg ) - !-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-! - ! Parse and store the input argument ! - !-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-! - - USE NWTC_Library - USE OrcaDriver_Types - USE OrcaFlexInterface_Types - - IMPLICIT NONE - - ! Storing the arguments - TYPE( OrcaDriver_Flags ), INTENT(INOUT) :: CLFlags ! Flags indicating which arguments were specified - TYPE( OrcaDriver_Settings ), INTENT(INOUT) :: CLSettings ! Arguments passed in - - CHARACTER(*), INTENT(IN ) :: ThisArgUC ! The current argument (upper case for testing) - CHARACTER(*), INTENT(IN ) :: ThisArg ! The current argument (as passed in for error messages) - LOGICAL, INTENT(INOUT) :: ifwFlagSet ! Was the -ifw flag given? - - ! Error Handling - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - - ! local variables - INTEGER(IntKi) :: Delim1 ! where the [ is - INTEGER(IntKi) :: Delim2 ! where the ] is - INTEGER(IntKi) :: DelimSep ! where the : is - INTEGER(IntKi) :: DelimSep2 ! where the : is - INTEGER(IntKi) :: DelimSep3 ! where the : is - INTEGER(IntKi) :: DelimSep4 ! where the : is - INTEGER(IntKi) :: DelimSep5 ! where the : is - REAL(ReKi) :: TempReal ! temp variable to hold a real - - INTEGER(IntKi) :: ErrStatTmp ! Temporary error status for calls - CHARACTER(*), PARAMETER :: RoutineName = 'ParseArg' - - - - ! Initialize some things - ErrStat = ErrID_None - ErrStatTmp = ErrID_None - ErrMsg = '' - - ! Get the delimiters -- returns 0 if there isn't one - Delim1 = INDEX(ThisArgUC,'[') - Delim2 = INDEX(ThisArgUC,']') - DelimSep = INDEX(ThisArgUC,':') - - - ! check that if there is an opening bracket, then there is a closing one - IF ( (Delim1 > 0_IntKi ) .and. (Delim2 < Delim1) ) THEN - CALL SetErrStat(ErrID_Warn," Syntax error in option: '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - - ! check that if there is a colon, then there are brackets - IF ( (DelimSep > 0_IntKi) .and. (Delim1 == 0_IntKi) ) THEN - CALL SetErrStat(ErrID_Warn," Syntax error in option: '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - - - ! If no delimeters were given, than this option is simply a flag - IF ( Delim1 == 0_IntKi ) THEN - ! check to see if the filename is the name of the Orca input file - IF ( ThisArgUC(1:13)== "POINTSDEGREES" ) THEN - CLFlags%PointsDegrees = .TRUE. - RETURN - ELSEIF ( ThisArgUC(1:13)== "AddedMassFile" ) THEN - CLFlags%AddedMassFile = .TRUE. - RETURN - ELSEIF ( ThisArgUC(1:9) == "AddedMass" ) THEN - CLFlags%AddedMass = .TRUE. - RETURN - ELSEIF ( ThisArgUC(1:7) == "DEGREES" ) THEN - CLFlags%Degrees = .TRUE. - RETURN - ELSEIF ( ThisArgUC(1:2) == "VV" ) THEN - CLFlags%VVerbose = .TRUE. - RETURN - ELSEIF ( ThisArgUC(1:1) == "V" ) THEN - CLFlags%Verbose = .TRUE. - RETURN - ELSE - CALL SetErrStat( ErrID_Warn," Unrecognized option '"//SwChar//TRIM(ThisArg)//"'. Ignoring. Use option "//SwChar//"help for list of options.", & - ErrStat,ErrMsg,RoutineName) - ENDIF - - ENDIF - - - - ! "Veloc[X,Y,Z,R1,R2,R3]" - IF ( ThisArgUC(1:Delim1) == "Veloc[" ) THEN - DelimSep = INDEX(ThisArgUC,',') - DelimSep2= INDEX(ThisArgUC(DelimSep+1:),',') + DelimSep - IF ( DelimSep2 <= DelimSep ) THEN - CALL SetErrStat(ErrID_Warn," Unrecognized coordinate in '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - DelimSep3= INDEX(ThisArgUC(DelimSep2+1:),',') + DelimSep - IF ( DelimSep3 <= DelimSep2 ) THEN - CALL SetErrStat(ErrID_Warn," Unrecognized coordinate in '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - DelimSep4= INDEX(ThisArgUC(DelimSep3+1:),',') + DelimSep - IF ( DelimSep4 <= DelimSep3 ) THEN - CALL SetErrStat(ErrID_Warn," Unrecognized coordinate in '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - DelimSep5= INDEX(ThisArgUC(DelimSep4+1:),',') + DelimSep - IF ( DelimSep5 <= DelimSep4 ) THEN - CALL SetErrStat(ErrID_Warn," Unrecognized coordinate in '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - DelimSep5= INDEX(ThisArgUC(DelimSep5+1:),',') + DelimSep - IF ( DelimSep5 <= DelimSep5 ) THEN - CALL SetErrStat(ErrID_Warn," Unrecognized coordinate in '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - - ! First Value - TempReal = StringToReal( ThisArgUC(Delim1+1:DelimSep-1), ErrStatTmp ) - IF ( ErrStatTmp == ErrID_None ) THEN - CLFlags%PtfmVeloc = .TRUE. - CLSettings%PtfmVeloc(1) = TempReal - ELSE - CLFlags%PtfmVeloc = .FALSE. - IF ( ErrStatTmp == ErrID_Warn ) THEN - CALL SetErrStat(ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat, ErrMsg, RoutineName) - ELSE - CALL SetErrStat(ErrID_FATAL," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & - ErrStat, ErrMsg, RoutineName) - ENDIF - RETURN - ENDIF - - ! Second Value - TempReal = StringToReal( ThisArgUC(DelimSep+1:DelimSep2-1), ErrStatTmp ) - IF ( ErrStatTmp == ErrID_None ) THEN - CLFlags%PtfmVeloc = .TRUE. - CLSettings%PtfmVeloc(2) = TempReal - ELSE - CLFlags%PtfmVeloc = .FALSE. - IF ( ErrStatTmp == ErrID_Warn ) THEN - CALL SetErrStat(ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat, ErrMsg, RoutineName) - ELSE - CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & - ErrStat, ErrMsg, RoutineName) - ENDIF - RETURN - ENDIF - - ! Third Value - TempReal = StringToReal( ThisArgUC(DelimSep2+1:DelimSep3-1), ErrStatTmp ) - IF ( ErrStatTmp == ErrID_None ) THEN - CLFlags%PtfmVeloc = .TRUE. - CLSettings%PtfmVeloc(3) = TempReal - ELSE - CLFlags%PtfmVeloc = .FALSE. - IF ( ErrStatTmp == ErrID_Warn ) THEN - CALL SetErrStat( ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat, ErrMsg, RoutineName) - ELSE - CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & - ErrStat, ErrMsg, RoutineName) - ENDIF - RETURN - ENDIF - - ! Fourth Value - TempReal = StringToReal( ThisArgUC(DelimSep3+1:DelimSep4-1), ErrStatTmp ) - IF ( ErrStatTmp == ErrID_None ) THEN - CLFlags%PtfmVeloc = .TRUE. - CLSettings%PtfmVeloc(4) = TempReal - ELSE - CLFlags%PtfmVeloc = .FALSE. - IF ( ErrStatTmp == ErrID_Warn ) THEN - CALL SetErrStat( ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat, ErrMsg, RoutineName) - ELSE - CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & - ErrStat, ErrMsg, RoutineName) - ENDIF - RETURN - ENDIF - - ! Fifth Value - TempReal = StringToReal( ThisArgUC(DelimSep4+1:DelimSep5-1), ErrStatTmp ) - IF ( ErrStatTmp == ErrID_None ) THEN - CLFlags%PtfmVeloc = .TRUE. - CLSettings%PtfmVeloc(5) = TempReal - ELSE - CLFlags%PtfmVeloc = .FALSE. - IF ( ErrStatTmp == ErrID_Warn ) THEN - CALL SetErrStat( ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat, ErrMsg, RoutineName) - ELSE - CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & - ErrStat, ErrMsg, RoutineName) - ENDIF - RETURN - ENDIF - - ! Sixth Value - TempReal = StringToReal( ThisArgUC(DelimSep5+1:Delim2-1), ErrStatTmp ) - IF ( ErrStatTmp == ErrID_None ) THEN - CLFlags%PtfmVeloc = .TRUE. - CLSettings%PtfmVeloc(6) = TempReal - ELSE - CLFlags%PtfmVeloc = .FALSE. - IF ( ErrStatTmp == ErrID_Warn ) THEN - CALL SetErrStat( ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat, ErrMsg, RoutineName) - ELSE - CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & - ErrStat, ErrMsg, RoutineName) - ENDIF - RETURN - ENDIF - - - - ! "Accel[X,Y,Z,R1,R2,R3]" - ELSEIF ( ThisArgUC(1:Delim1) == "Accel[" ) THEN - DelimSep = INDEX(ThisArgUC,',') - DelimSep2= INDEX(ThisArgUC(DelimSep+1:),',') + DelimSep - IF ( DelimSep2 <= DelimSep ) THEN - CALL SetErrStat(ErrID_Warn," Unrecognized coordinate in '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - DelimSep3= INDEX(ThisArgUC(DelimSep2+1:),',') + DelimSep - IF ( DelimSep3 <= DelimSep2 ) THEN - CALL SetErrStat(ErrID_Warn," Unrecognized coordinate in '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - DelimSep4= INDEX(ThisArgUC(DelimSep3+1:),',') + DelimSep - IF ( DelimSep4 <= DelimSep3 ) THEN - CALL SetErrStat(ErrID_Warn," Unrecognized coordinate in '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - DelimSep5= INDEX(ThisArgUC(DelimSep4+1:),',') + DelimSep - IF ( DelimSep5 <= DelimSep4 ) THEN - CALL SetErrStat(ErrID_Warn," Unrecognized coordinate in '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - DelimSep5= INDEX(ThisArgUC(DelimSep5+1:),',') + DelimSep - IF ( DelimSep5 <= DelimSep5 ) THEN - CALL SetErrStat(ErrID_Warn," Unrecognized coordinate in '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - - ! First Value - TempReal = StringToReal( ThisArgUC(Delim1+1:DelimSep-1), ErrStatTmp ) - IF ( ErrStatTmp == ErrID_None ) THEN - CLFlags%PtfmAccel = .TRUE. - CLSettings%PtfmAccel(1) = TempReal - ELSE - CLFlags%PtfmAccel = .FALSE. - IF ( ErrStatTmp == ErrID_Warn ) THEN - CALL SetErrStat(ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat, ErrMsg, RoutineName) - ELSE - CALL SetErrStat(ErrID_FATAL," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & - ErrStat, ErrMsg, RoutineName) - ENDIF - RETURN - ENDIF - - ! Second Value - TempReal = StringToReal( ThisArgUC(DelimSep+1:DelimSep2-1), ErrStatTmp ) - IF ( ErrStatTmp == ErrID_None ) THEN - CLFlags%PtfmAccel = .TRUE. - CLSettings%PtfmAccel(2) = TempReal - ELSE - CLFlags%PtfmAccel = .FALSE. - IF ( ErrStatTmp == ErrID_Warn ) THEN - CALL SetErrStat(ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat, ErrMsg, RoutineName) - ELSE - CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & - ErrStat, ErrMsg, RoutineName) - ENDIF - RETURN - ENDIF - - ! Third Value - TempReal = StringToReal( ThisArgUC(DelimSep2+1:DelimSep3-1), ErrStatTmp ) - IF ( ErrStatTmp == ErrID_None ) THEN - CLFlags%PtfmAccel = .TRUE. - CLSettings%PtfmAccel(3) = TempReal - ELSE - CLFlags%PtfmAccel = .FALSE. - IF ( ErrStatTmp == ErrID_Warn ) THEN - CALL SetErrStat( ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat, ErrMsg, RoutineName) - ELSE - CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & - ErrStat, ErrMsg, RoutineName) - ENDIF - RETURN - ENDIF - - ! Fourth Value - TempReal = StringToReal( ThisArgUC(DelimSep3+1:DelimSep4-1), ErrStatTmp ) - IF ( ErrStatTmp == ErrID_None ) THEN - CLFlags%PtfmAccel = .TRUE. - CLSettings%PtfmAccel(4) = TempReal - ELSE - CLFlags%PtfmAccel = .FALSE. - IF ( ErrStatTmp == ErrID_Warn ) THEN - CALL SetErrStat( ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat, ErrMsg, RoutineName) - ELSE - CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & - ErrStat, ErrMsg, RoutineName) - ENDIF - RETURN - ENDIF - - ! Fifth Value - TempReal = StringToReal( ThisArgUC(DelimSep4+1:DelimSep5-1), ErrStatTmp ) - IF ( ErrStatTmp == ErrID_None ) THEN - CLFlags%PtfmAccel = .TRUE. - CLSettings%PtfmAccel(5) = TempReal - ELSE - CLFlags%PtfmAccel = .FALSE. - IF ( ErrStatTmp == ErrID_Warn ) THEN - CALL SetErrStat( ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat, ErrMsg, RoutineName) - ELSE - CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & - ErrStat, ErrMsg, RoutineName) - ENDIF - RETURN - ENDIF - - ! Sixth Value - TempReal = StringToReal( ThisArgUC(DelimSep5+1:Delim2-1), ErrStatTmp ) - IF ( ErrStatTmp == ErrID_None ) THEN - CLFlags%PtfmAccel = .TRUE. - CLSettings%PtfmAccel(6) = TempReal - ELSE - CLFlags%PtfmAccel = .FALSE. - IF ( ErrStatTmp == ErrID_Warn ) THEN - CALL SetErrStat( ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat, ErrMsg, RoutineName) - ELSE - CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & - ErrStat, ErrMsg, RoutineName) - ENDIF - RETURN - ENDIF - - ! "Coord[X,Y,Z,R1,R2,R3]" - ELSEIF ( ThisArgUC(1:Delim1) == "Coord[" ) THEN - DelimSep = INDEX(ThisArgUC,',') - DelimSep2= INDEX(ThisArgUC(DelimSep+1:),',') + DelimSep - IF ( DelimSep2 <= DelimSep ) THEN - CALL SetErrStat(ErrID_Warn," Unrecognized coordinate in '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - DelimSep3= INDEX(ThisArgUC(DelimSep2+1:),',') + DelimSep - IF ( DelimSep3 <= DelimSep2 ) THEN - CALL SetErrStat(ErrID_Warn," Unrecognized coordinate in '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - DelimSep4= INDEX(ThisArgUC(DelimSep3+1:),',') + DelimSep - IF ( DelimSep4 <= DelimSep3 ) THEN - CALL SetErrStat(ErrID_Warn," Unrecognized coordinate in '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - DelimSep5= INDEX(ThisArgUC(DelimSep4+1:),',') + DelimSep - IF ( DelimSep5 <= DelimSep4 ) THEN - CALL SetErrStat(ErrID_Warn," Unrecognized coordinate in '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - DelimSep5= INDEX(ThisArgUC(DelimSep5+1:),',') + DelimSep - IF ( DelimSep5 <= DelimSep5 ) THEN - CALL SetErrStat(ErrID_Warn," Unrecognized coordinate in '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - - ! First Value - TempReal = StringToReal( ThisArgUC(Delim1+1:DelimSep-1), ErrStatTmp ) - IF ( ErrStatTmp == ErrID_None ) THEN - CLFlags%PtfmCoord = .TRUE. - CLSettings%PtfmCoord(1) = TempReal - ELSE - CLFlags%PtfmCoord = .FALSE. - IF ( ErrStatTmp == ErrID_Warn ) THEN - CALL SetErrStat(ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat, ErrMsg, RoutineName) - ELSE - CALL SetErrStat(ErrID_FATAL," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & - ErrStat, ErrMsg, RoutineName) - ENDIF - RETURN - ENDIF - - ! Second Value - TempReal = StringToReal( ThisArgUC(DelimSep+1:DelimSep2-1), ErrStatTmp ) - IF ( ErrStatTmp == ErrID_None ) THEN - CLFlags%PtfmCoord = .TRUE. - CLSettings%PtfmCoord(2) = TempReal - ELSE - CLFlags%PtfmCoord = .FALSE. - IF ( ErrStatTmp == ErrID_Warn ) THEN - CALL SetErrStat(ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat, ErrMsg, RoutineName) - ELSE - CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & - ErrStat, ErrMsg, RoutineName) - ENDIF - RETURN - ENDIF - - ! Third Value - TempReal = StringToReal( ThisArgUC(DelimSep2+1:DelimSep3-1), ErrStatTmp ) - IF ( ErrStatTmp == ErrID_None ) THEN - CLFlags%PtfmCoord = .TRUE. - CLSettings%PtfmCoord(3) = TempReal - ELSE - CLFlags%PtfmCoord = .FALSE. - IF ( ErrStatTmp == ErrID_Warn ) THEN - CALL SetErrStat( ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat, ErrMsg, RoutineName) - ELSE - CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & - ErrStat, ErrMsg, RoutineName) - ENDIF - RETURN - ENDIF - - ! Fourth Value - TempReal = StringToReal( ThisArgUC(DelimSep3+1:DelimSep4-1), ErrStatTmp ) - IF ( ErrStatTmp == ErrID_None ) THEN - CLFlags%PtfmCoord = .TRUE. - CLSettings%PtfmCoord(4) = TempReal - ELSE - CLFlags%PtfmCoord = .FALSE. - IF ( ErrStatTmp == ErrID_Warn ) THEN - CALL SetErrStat( ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat, ErrMsg, RoutineName) - ELSE - CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & - ErrStat, ErrMsg, RoutineName) - ENDIF - RETURN - ENDIF - - ! Fifth Value - TempReal = StringToReal( ThisArgUC(DelimSep4+1:DelimSep5-1), ErrStatTmp ) - IF ( ErrStatTmp == ErrID_None ) THEN - CLFlags%PtfmCoord = .TRUE. - CLSettings%PtfmCoord(5) = TempReal - ELSE - CLFlags%PtfmCoord = .FALSE. - IF ( ErrStatTmp == ErrID_Warn ) THEN - CALL SetErrStat( ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat, ErrMsg, RoutineName) - ELSE - CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & - ErrStat, ErrMsg, RoutineName) - ENDIF - RETURN - ENDIF - - ! Sixth Value - TempReal = StringToReal( ThisArgUC(DelimSep5+1:Delim2-1), ErrStatTmp ) - IF ( ErrStatTmp == ErrID_None ) THEN - CLFlags%PtfmCoord = .TRUE. - CLSettings%PtfmCoord(6) = TempReal - ELSE - CLFlags%PtfmCoord = .FALSE. - IF ( ErrStatTmp == ErrID_Warn ) THEN - CALL SetErrStat( ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & - ErrStat, ErrMsg, RoutineName) - ELSE - CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & - ErrStat, ErrMsg, RoutineName) - ENDIF - RETURN - ENDIF - - - ! "POINTS[FILE]" - ELSEIF( ThisArgUC(1:Delim1) == "POINTS[" ) THEN - CLFlags%PointsFile = .TRUE. - CLSettings%PointsFileName = ThisArg(Delim1+1:Delim2-1) - ELSE - ErrMsg = " Unrecognized option: '"//SwChar//TRIM(ThisArg)//"'. Ignoring. Use option "//SwChar//"help for list of options." - ErrStat = ErrID_Warn - ENDIF - - END SUBROUTINE ParseArg - !------------------------------------------------------------------------------- - - - -END SUBROUTINE RetrieveArgs - - -!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- -!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- -!> This subroutine reads the driver input file and sets up the flags and settings -!! for the driver code. Any settings from the command line options will override -!! this. -SUBROUTINE ReadDvrIptFile( DvrFileName, DvrFlags, DvrSettings, ProgInfo, ErrStat, ErrMsg ) - - CHARACTER(1024), INTENT(IN ) :: DvrFileName - TYPE(OrcaDriver_Flags), INTENT(INOUT) :: DvrFlags - TYPE(OrcaDriver_Settings), INTENT(INOUT) :: DvrSettings - TYPE(ProgDesc), INTENT(IN ) :: ProgInfo - INTEGER(IntKi), 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(IntKi) :: UnIn ! Unit number for the driver input file - CHARACTER(1024) :: FileName ! Name of OrcaFlexInterface driver input file - - ! Input file echoing - LOGICAL :: EchoFileContents ! Do we echo the driver file out or not? - INTEGER(IntKi) :: UnEchoLocal ! The local unit number for this module's echo file - CHARACTER(1024) :: EchoFileName ! Name of OrcaFlexInterface driver echo file - - ! Time steps - CHARACTER(1024) :: DTChr ! Character string for timesteps size (to handle DEFAULT value) - - ! Local error handling - INTEGER(IntKi) :: ErrStatTmp !< Temporary error status for calls - INTEGER(IntKi) :: ErrStatTmp2 !< Temporary error status for IO checks - CHARACTER(1024) :: ErrMsgTmp !< Temporary error messages for calls - CHARACTER(*), PARAMETER :: RoutineName = 'ReadDvrIptFile' - - ! Initialize the echo file unit to -1 which is the default to prevent echoing, we will alter this based on user input - UnEchoLocal = -1 - - FileName = TRIM(DvrFileName) - - CALL GetNewUnit( UnIn ) - CALL OpenFInpFile( UnIn, FileName, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - IF ( ErrStatTmp >= AbortErrLev ) THEN - CLOSE( UnIn ) - RETURN - ENDIF - - - CALL WrScr( 'Opening OrcaFlexInterface Driver input file: '//FileName ) - - - !------------------------------------------------------------------------------------------------- - ! File header - !------------------------------------------------------------------------------------------------- - - CALL ReadCom( UnIn, FileName,' OrcaFlexInterface Driver input file header line 1', ErrStatTmp, ErrMsgTmp ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CLOSE( UnIn ) - RETURN - ENDIF - - - CALL ReadCom( UnIn, FileName, 'OrcaFlexInterface Driver input file header line 2', ErrStatTmp, ErrMsgTmp ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CLOSE( UnIn ) - RETURN - ENDIF - - - ! Echo Input Files. - CALL ReadVar ( UnIn, FileName, EchoFileContents, 'Echo', 'Echo Input', ErrStatTmp, ErrMsgTmp ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CLOSE( UnIn ) - RETURN - ENDIF - - - ! If we are Echoing the input then we should re-read the first three lines so that we can echo them - ! using the NWTC_Library routines. The echoing is done inside those routines via a global variable - ! which we must store, set, and then replace on error or completion. - - IF ( EchoFileContents ) THEN - - EchoFileName = TRIM(FileName)//'.ech' - CALL GetNewUnit( UnEchoLocal ) - CALL OpenEcho ( UnEchoLocal, EchoFileName, ErrStatTmp, ErrMsgTmp, ProgInfo ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CLOSE( UnIn ) - RETURN - ENDIF - - - REWIND(UnIn) - - - ! Reread and echo - CALL ReadCom( UnIn, FileName,' OrcaFlexInterface Driver input file header line 1', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - - - CALL ReadCom( UnIn, FileName, 'OrcaFlexInterface Driver input file header line 2', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - - - ! Echo Input Files. - CALL ReadVar ( UnIn, FileName, EchoFileContents, 'Echo', 'Echo Input', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - - - - ENDIF - - - !------------------------------------------------------------------------------------------------- - ! OrcaFlexInterface setup section - !------------------------------------------------------------------------------------------------- - - ! Header - CALL ReadCom( UnIn, FileName,' OrcaFlexInterface setup section, comment line', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - - - ! DT -- Timestep size for the driver to take (or DEFAULT for what the file contains) - CALL ReadVar( UnIn, FileName,DTChr,'DTChr',' Character string for Timestep size for the driver to take (or DEFAULT for what the file contains).', & - ErrStatTmp,ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - - ! Check if we asked for the DEFAULT (use what is in the file) - CALL Conv2UC( DTChr ) - IF ( TRIM(DTChr) == 'DEFAULT' ) THEN ! we asked for the default value - DvrFlags%DT = .TRUE. - DvrFlags%DTDefault = .TRUE. ! This flag tells us to use the inflow wind file values - ELSE - ! We probably have a number if it isn't 'DEFAULT', so do an internal read and check to - ! make sure that it was appropriately interpretted. - READ (DTChr,*,IOSTAT=ErrStatTmp2) DvrSettings%DT - IF ( ErrStatTmp /= ErrID_None ) THEN ! problem in the read, so parse the error. - CALL CheckIOS ( ErrStatTmp2, '', 'DT',NumType, ErrStatTmp, ErrMsgTmp, .TRUE. ) - RETURN - ELSE ! Was ok, so set the flags - DvrFlags%DT = .TRUE. - DvrFlags%DTDefault = .FALSE. - ENDIF - ENDIF - - - ! OrcaFlexInterface input file - CALL ReadVar( UnIn, FileName,DvrSettings%OrcaIptFileName,'OrcaIptFileName',' OrcaFlexInterface input filename', & - ErrStatTmp,ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ELSE - DvrFlags%OrcaIptFile = .TRUE. - ENDIF - - - - !------------------------------------------------------------------------------------------------- - ! PtfmCoordinates - !------------------------------------------------------------------------------------------------- - - ! Header - CALL ReadCom( UnIn, FileName,' Coordinates, comment line', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - - - ! PtfmCoord -- PtfmCoord of the windfield needed. - CALL ReadVar( UnIn, FileName,DvrFlags%PtfmCoord,'PtfmCoord',' Use a set of coordinates?', & - ErrStatTmp,ErrMsgTmp, UnEchoLocal ) - DvrFlags%PtfmVeloc = DvrFlags%PtfmCoord - DvrFlags%PtfmAccel = DvrFlags%PtfmCoord - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - - - ! Read the coordinates if the flag is set, otherwise skip the line - IF ( DvrFlags%PtfmCoord ) THEN - - ! Degrees -- PtfmCoord of the windfield needed. - CALL ReadVar( UnIn, FileName,DvrFlags%Degrees,'Degrees',' Angles specified in degrees?', & - ErrStatTmp,ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - - ! PtfmCoord -- The coordinates to pass to the DLL - CALL ReadAry ( UnIn, FileName, DvrSettings%PtfmCoord(1:6), 6, 'PtfmCoord(1:6)', & - 'platform coordinate', ErrStatTmp, ErrMsgTmp, UnEchoLocal) - IF ( ErrStat /= ErrID_None ) THEN - CALL SetErrStat( ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - - ! PtfmVeloc -- The coordinates to pass to the DLL - CALL ReadAry ( UnIn, FileName, DvrSettings%PtfmVeloc(1:6), 6, 'PtfmVeloc(1:6)', & - 'platform coordinate', ErrStatTmp, ErrMsgTmp, UnEchoLocal) - IF ( ErrStat /= ErrID_None ) THEN - CALL SetErrStat( ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - - ! PtfmAccel -- The coordinates to pass to the DLL - CALL ReadAry ( UnIn, FileName, DvrSettings%PtfmAccel(1:6), 6, 'PtfmAccel(1:6)', & - 'platform coordinate', ErrStatTmp, ErrMsgTmp, UnEchoLocal) - IF ( ErrStat /= ErrID_None ) THEN - CALL SetErrStat( ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - - ! Write the added mass matrix to the screen - CALL ReadVar( UnIn, FileName,DvrFlags%AddedMass,'AddedMass',' Write table of added mass to screen.', & - ErrStatTmp,ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ELSE - DvrFlags%AddedMass = .TRUE. - ENDIF - - ! Write the added mass matrix to a file - CALL ReadVar( UnIn, FileName,DvrFlags%AddedMassFile,'AddedMassFile',' Write added Mass matrix to file.', & - ErrStatTmp,ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ELSE - DvrFlags%AddedMassFile = .TRUE. - ENDIF - - ELSE - CALL ReadCom( UnIn, FileName,' Skipping the degrees flag since not calculating anything.', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - CALL ReadCom( UnIn, FileName,' Skipping the platform coordinate since not calculating anything.', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - CALL ReadCom( UnIn, FileName,' Skipping the platform velocity since not calculating anything.', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - CALL ReadCom( UnIn, FileName,' Skipping the platform acceleration since not calculating anything.', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - CALL ReadCom( UnIn, FileName,' Skipping the Added mass matrix output since not calculating anything.', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - CALL ReadCom( UnIn, FileName,' Skipping the added mass matrix file output since not calculating anything.', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - ENDIF - - - - - !------------------------------------------------------------------------------------------------- - ! points file input - !------------------------------------------------------------------------------------------------- - - ! Header line - CALL ReadCom( UnIn, FileName,' Points file input, comment line', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - - - ! PointsFile -- Read a points file - CALL ReadVar( UnIn, FileName,DvrFlags%PointsFile,'PointsFile',' Read a points file?', & - ErrStatTmp,ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - - - IF ( DvrFlags%PointsFile ) THEN - ! Points file in degrees - CALL ReadVar( UnIn, FileName,DvrFlags%PointsDegrees,'PointsDegrees',' Angles in points file given in degrees?', & - ErrStatTmp,ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - ! Points input file - CALL ReadVar( UnIn, FileName,DvrSettings%PointsFileName,'PointsFileName',' Points file input filename', & - ErrStatTmp,ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - ELSE - ! Skip the next entry points file section. - CALL ReadCom( UnIn, FileName,' Skipping the degreespoints flag since not using it.', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - ! Skip the next entry points file section. - CALL ReadCom( UnIn, FileName,' Skipping the points filename since not using it.', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - ENDIF - - - ! Close the echo and input file - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - - -CONTAINS - - !---------------------------------------------------------------------------------------------------- - !> The routine cleans up the module echo file and resets the NWTC_Library, reattaching it to - !! any existing echo information - SUBROUTINE CleanupEchoFile( EchoFlag, UnEcho) - LOGICAL, INTENT(IN ) :: EchoFlag ! local version of echo flag - INTEGER(IntKi), INTENT(IN ) :: UnEcho ! echo unit number - - ! Close this module's echo file - IF ( EchoFlag ) THEN - CLOSE(UnEcho) - ENDIF - END SUBROUTINE CleanupEchoFile - - - -END SUBROUTINE ReadDvrIptFile - - -!> This subroutine copies an command line (CL) settings over to the program settings. Warnings are -!! issued if anything is changed from what the driver input file requested. -SUBROUTINE UpdateSettingsWithCL( DvrFlags, DvrSettings, CLFlags, CLSettings, DVRIPT, ErrStat, ErrMsg ) - - TYPE(OrcaDriver_Flags), INTENT(INOUT) :: DvrFlags - TYPE(OrcaDriver_Settings), INTENT(INOUT) :: DvrSettings - TYPE(OrcaDriver_Flags), INTENT(IN ) :: CLFlags - TYPE(OrcaDriver_Settings), INTENT(IN ) :: CLSettings - LOGICAL, INTENT(IN ) :: DVRIPT - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - - ! Local variables - INTEGER(IntKi) :: ErrStatTmp !< Temporary error status for calls - CHARACTER(1024) :: ErrMsgTmp !< Temporary error status for calls - CHARACTER(*), PARAMETER :: RoutineName = 'UpdateSettingsWithCL' - LOGICAL :: WindGridModify !< Did we modify any of the WindGrid related settings? - - INTEGER(IntKi) :: I !< local counter - - ! Initialization - WindGridModify = .FALSE. - - ! Initialize the error handling - ErrStat = ErrID_None - ErrMsg = '' - ErrStatTmp = ErrID_None - ErrMsgTmp = '' - - - !-------------------------------------------- - ! Did we change any time information? - !-------------------------------------------- - - - ! Check DT - IF ( CLFlags%DT ) THEN - IF ( DvrFlags%DT .AND. ( .NOT. EqualRealNos(DvrSettings%DT, CLSettings%DT) ) ) THEN - CALL SetErrStat( ErrID_Warn, ' Overriding driver input value for DT with '//TRIM(Num2LStr(CLSettings%DT))//'.', & - ErrStat,ErrMsg,RoutineName) - ELSE - DvrFlags%DT = .TRUE. - ENDIF - DvrSettings%DT = CLSettings%DT - ENDIF - - - !-------------------------------------------- - ! Did we change the coordinate info? - !-------------------------------------------- - - IF ( CLFlags%PtfmCoord ) THEN - ! If we are overriding driver input file settings, tell user - IF ( DvrFlags%PtfmCoord ) THEN - CALL SetErrStat( ErrID_Warn,' Overriding driver input file settings for platform coordinate.', & - ErrStat,ErrMsg,RoutineName ) - ENDIF - DvrSettings%PtfmCoord = CLSettings%PtfmCoord - DvrFlags%PtfmCoord = .TRUE. - ENDIF - - IF ( CLFlags%PtfmVeloc ) THEN - ! If we are overriding driver input file settings, tell user - IF ( DvrFlags%PtfmVeloc ) THEN - CALL SetErrStat( ErrID_Warn,' Overriding driver input file settings for platform velocities.', & - ErrStat,ErrMsg,RoutineName ) - ENDIF - DvrSettings%PtfmVeloc = CLSettings%PtfmVeloc - DvrFlags%PtfmVeloc = .TRUE. - ENDIF - - IF ( CLFlags%PtfmAccel ) THEN - ! If we are overriding driver input file settings, tell user - IF ( DvrFlags%PtfmAccel ) THEN - CALL SetErrStat( ErrID_Warn,' Overriding driver input file settings for platform velocities.', & - ErrStat,ErrMsg,RoutineName ) - ENDIF - DvrSettings%PtfmAccel = CLSettings%PtfmAccel - DvrFlags%PtfmAccel = .TRUE. - ENDIF - - ! If only one of the PtfmCoord, PtfmVeloc, or PtfmAccel flags is set to true, the other should be set also - IF ( DvrFlags%PtfmCoord .OR. DvrFlags%PtfmVeloc .OR. DvrFlags%PtfmAccel ) THEN - DvrFlags%PtfmCoord = .TRUE. - DvrFlags%PtfmVeloc = .TRUE. - DvrFlags%PtfmAccel = .TRUE. - ENDIF - - - !-------------------------------------------- - ! Are PtfmCoord angles in degrees? - !-------------------------------------------- - - IF ( CLFlags%Degrees ) THEN - ! No need to tell the user. They likely only specified this flag with command line coords. - ! The logic needed to check if it is a status change otherwise is not worth the effort. - DvrFlags%Degrees = .TRUE. - ENDIF - - - !-------------------------------------------- - ! Did we request Added Mass matrix results? - !-------------------------------------------- - - IF ( CLFlags%AddedMass ) THEN - IF ( DvrFlags%PtfmCoord .AND. DvrFlags%PtfmVeloc .AND. DvrFlags%PtfmAccel ) THEN - DvrFlags%AddedMass = .TRUE. - ELSE ! give a warning and set the flags. The coordinate is already initialized to (0,0,0,0,0,0) - CALL SetErrStat( ErrID_Warn,' Added mass matrix requested, but no platform location specified. Setting location to (0,0,0,0,0,0).', & - ErrStat,ErrMsg,RoutineName) - DvrFlags%AddedMass = .FALSE. - DvrFlags%PtfmCoord = .TRUE. - DvrFlags%PtfmVeloc = .TRUE. - DvrFlags%PtfmAccel = .TRUE. - ENDIF - ENDIF - - IF ( CLFlags%AddedMassFile ) THEN - IF ( DvrFlags%PtfmCoord .AND. DvrFlags%PtfmVeloc .AND. DvrFlags%PtfmAccel ) THEN - DvrFlags%AddedMassFile = .TRUE. - ELSE ! give a warning and set the flags. The coordinate is already initialized to (0,0,0,0,0,0) - CALL SetErrStat( ErrID_Warn,' Added mass matrix file requested, but no platform location specified. Setting location to (0,0,0,0,0,0).', & - ErrStat,ErrMsg,RoutineName) - DvrFlags%AddedMassFile = .TRUE. - DvrFlags%PtfmCoord = .TRUE. - DvrFlags%PtfmVeloc = .TRUE. - DvrFlags%PtfmAccel = .TRUE. - ENDIF - ENDIF - - - - !-------------------------------------------- - ! Did we request a different Points file? - !-------------------------------------------- - - IF ( CLFlags%PointsFile ) THEN - ! If a name was given in the driver input file, then warn the user. - IF ( DvrFlags%PointsFile ) THEN - CALL SetErrStat( ErrID_Warn,' Overriding driver input file settings for Points file.', & - ErrStat,ErrMsg,RoutineName ) - ENDIF - DvrFlags%PointsFile = .TRUE. - DvrSettings%PointsFileName = CLSettings%PointsFileName - IF ( CLFlags%PointsDegrees ) THEN - DvrFLags%PointsDegrees = .TRUE. - ENDIF - ELSE - IF ( CLFlags%PointsDegrees ) THEN - DvrFlags%PointsDegrees = .TRUE. - CALL SetErrStat( ErrID_Warn,' Overriding driver input file points file angles in degrees.', & - ErrStat,ErrMsg,RoutineName ) - ENDIF - ENDIF - - - ! If no DT value has been set (DEFAULT requested), we need to set a default to pass into Orca - IF ( .NOT. DvrFlags%DT ) THEN - DvrSettings%DT = 0.025_DbKi ! This value gets passed into the Orca_Init routine, so something must be set. - DvrFlags%DT = .TRUE. - ENDIF - - - ! If the angles for PtfmCoord, PtfmVeloc, and PtfmAccel are in degrees, then convert them into radians now - IF ( DvrFlags%Degrees ) THEN - DO I=4,6 - DvrSettings%PtfmCoord(I) = DvrSettings%PtfmCoord(I) * D2R ! D2R is from the library - DvrSettings%PtfmVeloc(I) = DvrSettings%PtfmVeloc(I) * D2R ! D2R is from the library - DvrSettings%PtfmAccel(I) = DvrSettings%PtfmAccel(I) * D2R ! D2R is from the library - ENDDO - ENDIF - - -END SUBROUTINE UpdateSettingsWithCL - - -SUBROUTINE ReadPointsFile( PointsFileName, AnglesInDegrees, TimeList, CoordList, VelocList, AccelList, ErrStat, ErrMsg ) - - CHARACTER(1024), INTENT(IN ) :: PointsFileName !< Name of the points file to read - LOGICAL, INTENT(IN ) :: AnglesInDegrees !< Are the angles specified in degrees? - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: TimeList(:) !< TimeStamps - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: CoordList(:,:) !< The coordinates we read in - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: VelocList(:,:) !< The velocities we read in - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: AccelList(:,:) !< The accelerations we read in - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< The error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< The message for the status - - ! Local variables - CHARACTER(1024) :: ErrMsgTmp !< Temporary error message for calls - INTEGER(IntKi) :: ErrStatTmp !< Temporary error status for calls - CHARACTER(*), PARAMETER :: RoutineName = 'ReadPointsFile' - INTEGER(IntKi) :: FiUnitPoints !< Unit number for points file to open - - INTEGER(IntKi) :: NumDataColumns !< Number of data columns - INTEGER(IntKi) :: NumDataPoints !< Number of lines of data (one point per line) - INTEGER(IntKi) :: NumHeaderLines !< Number of header lines to ignore - - INTEGER(IntKi) :: I !< Generic counter - - REAL(ReKi) :: TmpArray(19) !< Temporary array to hold one line of data from the points file - REAL(ReKi) :: ConvToRadians !< Conversion to radians multiplier - - ! Initialization of subroutine - ErrMsg = '' - ErrMsgTmp = '' - ErrStat = ErrID_None - ErrStatTmp = ErrID_None - - ! Set the ConvToRadians multiplier - IF ( AnglesInDegrees) THEN - ConvToRadians = D2R ! Set to the library constant - ELSE - ConvToRadians = 1.0_ReKi - ENDIF - - - - ! Now open file - CALL GetNewUnit( FiUnitPoints ) - CALL OpenFInpFile( FiUnitPoints, TRIM(PointsFileName), ErrStatTmp, ErrMsgTmp ) ! Unformatted input file - IF ( ErrStatTmp >= AbortErrLev ) THEN - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) - CLOSE( FiUnitPoints ) - RETURN - ENDIF - - ! Find out how long the file is - CALL GetFileLength( FiUnitPoints, PointsFileName, NumDataColumns, NumDataPoints, NumHeaderLines, ErrMsgTmp, ErrStatTmp ) - IF ( ErrStatTmp >= AbortErrLev ) THEN - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) - CLOSE( FiUnitPoints ) - RETURN - ENDIF - IF ( NumDataColumns /= 19 ) THEN - CALL SetErrStat( ErrID_Fatal,' Expecting 19 columns in '//TRIM(PointsFileName)//' corresponding to '// & - 'timestamp, 3 translation coordinates, 3 rotation angles, 3 translational velocities, 3 rotational velocities, and '// & - '3 translational velocities, 3 rotational velocities. '//& - 'Instead found '//TRIM(Num2LStr(NumDataColumns))//' columns.', & - ErrStat, ErrMsg, RoutineName) - CLOSE( FiUnitPoints ) - RETURN - ENDIF - - - ! Allocate the storage for the data - CALL AllocAry( TimeList, NumDataPoints, "Array of timestamp data", ErrStatTmp, ErrMsgTmp ) - IF ( ErrStatTmp >= AbortErrLev ) THEN - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) - CLOSE( FiUnitPoints ) - RETURN - ENDIF - - - ! Allocate the storage for the data - CALL AllocAry( CoordList, 6, NumDataPoints, "Array of Points and rotation data", ErrStatTmp, ErrMsgTmp ) - IF ( ErrStatTmp >= AbortErrLev ) THEN - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) - CLOSE( FiUnitPoints ) - RETURN - ENDIF - - - ! Read in the headers and throw them away - ! Allocate the storage for the data - CALL AllocAry( VelocList, 6, NumDataPoints, "Array of translation and rotation derivative data", ErrStatTmp, ErrMsgTmp ) - IF ( ErrStatTmp >= AbortErrLev ) THEN - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) - CLOSE( FiUnitPoints ) - RETURN - ENDIF - - - ! Read in the headers and throw them away - ! Allocate the storage for the data - CALL AllocAry( AccelList, 6, NumDataPoints, "Array of translation and rotation 2nd derivative data", ErrStatTmp, ErrMsgTmp ) - IF ( ErrStatTmp >= AbortErrLev ) THEN - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) - CLOSE( FiUnitPoints ) - RETURN - ENDIF - - - ! Read in the headers and throw them away - DO I=1,NumHeaderLines - CALL ReadCom( FiUnitPoints, PointsFileName,' Points file header line', ErrStatTmp, ErrMsgTmp ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CLOSE( FiUnitPoints ) - RETURN - ENDIF - ENDDO - - ! Read in the datapoints - DO I=1,NumDataPoints - CALL ReadAry ( FiUnitPoints, PointsFileName, TmpArray(:), 19, 'Temporary coordinate', & - 'Coordinate point from Points file', ErrStatTmp, ErrMsgTmp) - IF ( ErrStat /= ErrID_None ) THEN - CALL SetErrStat( ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CLOSE( FiUnitPoints ) - RETURN - ENDIF - TimeList(I) = TmpArray(1) - CoordList(1:3,I) = TmpArray(2:4) - CoordList(4:6,I) = TmpArray(5:7) * ConvToRadians - VelocList(1:3,I) = TmpArray(8:10) - VelocList(4:6,I) = TmpArray(11:13) * ConvToRadians - AccelList(1:3,I) = TmpArray(14:16) - AccelList(4:6,I) = TmpArray(17:19) * ConvToRadians - ENDDO - - CLOSE( FiUnitPoints ) - -CONTAINS - - !------------------------------------------------------------------------------------------------------------------------------- - !> This subroutine looks at a file that has been opened and finds out how many header lines there are, how many columns there - !! are, and how many lines of data there are in the file. - !! - !! A few things are assumed about the file: - !! 1. Any header lines are the first thing in the file. - !! 2. No text appears anyplace other than in first part of the file - !! 3. The datalines only contain numbers that can be read in as reals. - !! - !! Limitations: - !! 1. only handles up to 20 words (columns) on a line - !! 2. empty lines are considered text lines - !! 3. All data rows must contain the same number of columns - !! - !! - SUBROUTINE GetFileLength(UnitDataFile, DataFileName, NumDataColumns, NumDataLines, NumHeaderLines, ErrMsg, ErrStat) - - IMPLICIT NONE - - ! Passed variables - INTEGER(IntKi), INTENT(IN ) :: UnitDataFile !< Unit number of the file we are looking at. - CHARACTER(*), INTENT(IN ) :: DataFileName !< The name of the file we are looking at. - INTEGER(IntKi), INTENT( OUT) :: NumDataColumns !< The number of columns in the data file. - INTEGER(IntKi), INTENT( OUT) :: NumDataLines !< Number of lines containing data - INTEGER(IntKi), INTENT( OUT) :: NumHeaderLines !< Number of header lines at the start of the file - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error Message to return (empty if all good) - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Status flag if there were any problems (ErrID_None if all good) - - ! Local Variables - CHARACTER(2048) :: ErrMsgTmp !< Temporary message variable. Used in calls. - INTEGER(IntKi) :: ErrStatTmp !< Temporary error status. Used in calls. - CHARACTER(*), PARAMETER :: RoutineName = 'GetFileLength' - INTEGER(IntKi) :: LclErrStat !< Temporary error status. Used locally to indicate when we have reached the end of the file. - INTEGER(IntKi) :: TmpIOErrStat !< Temporary error status for the internal read of the first word to a real number - LOGICAL :: IsRealNum !< Flag indicating if the first word on the line was a real number - - CHARACTER(1024) :: TextLine !< One line of text read from the file - INTEGER(IntKi) :: LineLen !< The length of the line read in - CHARACTER(1024) :: StrRead !< String containing the first word read in - REAL(ReKi) :: RealRead !< Returns value of the number (if there was one), or NaN (as set by NWTC_Num) if there wasn't - CHARACTER(1024) :: VarName !< Name of the variable we are trying to read from the file - CHARACTER(24) :: Words(20) !< Array of words we extract from a line. We shouldn't have more than 20. - INTEGER(IntKi) :: i,j,k !< simple integer counters - INTEGER(IntKi) :: LineNumber !< the line I am on - LOGICAL :: LineHasText !< Flag indicating if the line I just read has text. If so, it is a header line. - LOGICAL :: HaveReadData !< Flag indicating if I have started reading data. - INTEGER(IntKi) :: NumWords !< Number of words on a line - INTEGER(IntKi) :: FirstDataLineNum !< Line number of the first row of data in the file - - - ! Initialize the error handling - ErrStat = ErrID_None - ErrStatTmp = ErrID_None - LclErrStat = ErrID_None - ErrMsg = '' - ErrMsgTmp = '' - - - ! Set some of the flags and counters - HaveReadData = .FALSE. - NumDataColumns = 0 - NumHeaderLines = 0 - NumDataLines = 0 - LineNumber = 0 - - - ! Just in case we were handed a file that we are part way through reading (should never be true), rewind to the start - - REWIND( UnitDataFile ) - - - !------------------------------------ - !> The variable LclErrStat is used to indicate when we have reached the end of the file or had an error from - !! ReadLine. Until that occurs, we read each line, and decide if it contained any non-numeric data. The - !! first group of lines containing non-numeric data is considered the header. The first line of all numeric - !! data is considered the start of the data section. Any non-numeric containing found within the data section - !! will be considered as an invalid file format at which point we will return a fatal error from this routine. - - DO WHILE ( LclErrStat == ErrID_None ) - - !> Reset the indicator flag for the non-numeric content - LineHasText = .FALSE. - - !> Read in a single line from the file - CALL ReadLine( UnitDataFile, '', TextLine, LineLen, LclErrStat ) - - !> If there was an error in reading the file, then exit. - !! Possible causes: reading beyond end of file in which case we are done so don't process it. - IF ( LclErrStat /= ErrID_None ) EXIT - - !> Increment the line counter. - LineNumber = LineNumber + 1 - - !> Read all the words on the line into the array called 'Words'. Only the first words will be encountered - !! will be stored. The others are empty (i.e. only three words on the line, so the remaining 17 are empty). - CALL GetWords( TextLine, Words, 20 ) - - !> Cycle through and count how many are not empty. Once an empty value is encountered, all the rest should - !! be empty if GetWords worked correctly. The index of the last non-empty value is stored. - DO i=1,20 - IF (TRIM(Words(i)) .ne. '') NumWords=i - ENDDO - - - !> Now cycle through the first 'NumWords' of non-empty values stored in 'Words'. Words should contain - !! everything that is one the line. The subroutine ReadRealNumberFromString will set a flag 'IsRealNum' - !! when the value in Words(i) can be read as a real(ReKi). 'StrRead' will contain the string equivalent. - DO i=1,NumWords - CALL ReadRealNumberFromString( Words(i), RealRead, StrRead, IsRealNum, ErrStatTmp, ErrMsgTmp, TmpIOErrStat ) - IF ( .NOT. IsRealNum) THEN - LineHasText = .TRUE. - ENDIF - ENDDO - - !> If all the words on that line had no text in them, then it must have been a line of data. - !! If not, then we have either a header line, which is ok, or a line containing text in the middle of the - !! the data section, which is not good (the flag HaveReadData tells us which case this is). - IF ( LineHasText ) THEN - IF ( HaveReadData ) THEN ! Uh oh, we have already read a line of data before now, so there is a problem - CALL SetErrStat( ErrID_Fatal, ' Found text on line '//TRIM(Num2LStr(LineNumber))//' of '//TRIM(DataFileName)// & - ' when real numbers were expected. There may be a problem with format of the file: '// & - TRIM(DataFileName)//'.', ErrStat, ErrMsg, RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - RETURN - ENDIF - ELSE - NumHeaderLines = NumHeaderLines + 1 - ENDIF - ELSE ! No text, must be data line - NumDataLines = NumDataLines + 1 - ! If this is the first row of data, then store the number of words that were on the line - IF ( .NOT. HaveReadData ) THEN - ! If this is the first line of data, keep some relevant info about it and the number of columns in it - HaveReadData = .TRUE. - FirstDataLineNum = LineNumber ! Keep the line number of the first row of data (for error reporting) - NumDataColumns = NumWords - ELSE - ! Make sure that the number columns on the row matches the number of columnns on the first row of data. - IF ( NumWords /= NumDataColumns ) THEN - CALL SetErrStat( ErrID_Fatal, ' Error in file: '//TRIM(DataFileName)//'.'// & - ' The number of data columns on line '//TRIM(Num2LStr(LineNumber))// & - '('//TRIM(Num2LStr(NumWords))//' columns) is different than the number of columns on first row of data '// & - ' (line: '//TRIM(Num2LStr(FirstDataLineNum))//', '//TRIM(Num2LStr(NumDataColumns))//' columns).', & - ErrStat, ErrMsg, RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - RETURN - ENDIF - ENDIF - ENDIF - ENDIF - - ENDDO - - - REWIND( UnitDataFile ) - - END SUBROUTINE GetFileLength - - !------------------------------------------------------------------------------- - !> This subroutine takes a line of text that is passed in and reads the first - !! word to see if it is a number. An internal read is used to do this. If - !! it is a number, it is started in ValueRead and returned. The flag IsRealNum - !! is set to true. Otherwise, ValueRead is set to NaN (value from the NWTC_Num) - !! and the flag is set to false. - !! - !! The IsRealNum flag is set to indicate if we actually have a real number or - !! not. After calling this routine, a simple if statement can be used: - !! - !! @code - !! IF (IsRealNum) THEN - !! ! do something - !! ELSE - !! ! do something else - !! ENDIF - !! @endcode - !! - !------------------------------------------------------------------------------- - SUBROUTINE ReadRealNumberFromString(StringToParse, ValueRead, StrRead, IsRealNum, ErrStat, ErrMsg, IOErrStat) - - CHARACTER(*), INTENT(IN ) :: StringToParse !< The string we were handed. - REAL(ReKi), INTENT( OUT) :: ValueRead !< The variable being read. Returns as NaN (library defined) if not a Real. - CHARACTER(*), INTENT( OUT) :: StrRead !< A string containing what was read from the ReadNum routine. - LOGICAL, INTENT( OUT) :: IsRealNum !< Flag indicating if we successfully read a Real - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< ErrID level returned from ReadNum - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message including message from ReadNum - INTEGER(IntKi), INTENT( OUT) :: IOErrStat !< Error status from the internal read. Useful for diagnostics. - - - - ! Initialize some things - ErrStat = ErrID_None - ErrMsg = '' - - - ! ReadNum returns a string contained in StrRead. So, we now try to do an internal read to VarRead and then trap errors. - read(StringToParse,*,IOSTAT=IOErrStat) StrRead - read(StringToParse,*,IOSTAT=IOErrStat) ValueRead - - - ! If IOErrStat==0, then we have a real number, anything else is a problem. - if (IOErrStat==0) then - IsRealNum = .TRUE. - else - IsRealNum = .FALSE. - ValueRead = NaN ! This is NaN as defined in the NWTC_Num. - ErrMsg = 'Not a real number. '//TRIM(ErrMsgTmp)//NewLine - ErrSTat = ErrID_Severe - endif - - - - RETURN - END SUBROUTINE ReadRealNumberFromString - - - !------------------------------------------------------------------------------------------------------------------------------- - !------------------------------------------------------------------------------- - !> This subroutine works with the ReadNum routine from the library. ReadNum is - !! called to read a word from the input file. An internal read is then done to - !! convert the string to a number that is stored in VarRead and returned. - !! - !! The IsRealNum flag is set to indicate if we actually have a real number or - !! not. After calling this routine, a simple if statement can be used: - !! - !! @code - !! IF (ISRealNum) THEN - !! ! do something - !! ELSE - !! ! do something else - !! ENDIF - !! @endcode - !! - !------------------------------------------------------------------------------- - SUBROUTINE ReadRealNumber(UnitNum, FileName, VarName, VarRead, StrRead, IsRealNum, ErrStat, ErrMsg, IOErrStat) - - INTEGER(IntKi), INTENT(IN ) :: UnitNum !< The unit number of the file being read - CHARACTER(*), INTENT(IN ) :: FileName !< The name of the file being read. Used in the ErrMsg from ReadNum (Library routine). - CHARACTER(*), INTENT(IN ) :: VarName !< The variable we are reading. Used in the ErrMsg from ReadNum (Library routine)'. - REAL(ReKi), INTENT( OUT) :: VarRead !< The variable being read. Returns as NaN (library defined) if not a Real. - CHARACTER(*), INTENT( OUT) :: StrRead !< A string containing what was read from the ReadNum routine. - LOGICAL, INTENT( OUT) :: IsRealNum !< Flag indicating if we successfully read a Real - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< ErrID level returned from ReadNum - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message including message from ReadNum - INTEGER(IntKi), INTENT( OUT) :: IOErrStat !< Error status from the internal read. Useful for diagnostics. - - ! Local vars - INTEGER(IntKi) :: ErrStatTmp - CHARACTER(2048) :: ErrMsgTmp - - - - ! Initialize some things - ErrStat = ErrID_None - ErrMsg = '' - - - ! Now call the ReadNum routine to get the number - ! If it is a word that does not start with T or F, then ReadNum won't give any errors. - CALL ReadNum( UnitNum, FileName, StrRead, VarName, ErrStatTmp, ErrMsgTmp) - - - ! ReadNum returns a string contained in StrRead. So, we now try to do an internal read to VarRead and then trap errors. - read(StrRead,*,IOSTAT=IOErrStat) VarRead - - - ! If IOErrStat==0, then we have a real number, anything else is a problem. - if (IOErrStat==0) then - IsRealNum = .TRUE. - else - IsRealNum = .FALSE. - VarRead = NaN ! This is NaN as defined in the NWTC_Num. - ErrMsg = 'Not a real number. '//TRIM(ErrMsgTmp)//NewLine - ErrStat = ErrStatTmp ! The ErrStatTmp returned by the ReadNum routine is an ErrID level. - endif - - - - RETURN - END SUBROUTINE ReadRealNumber - - -END SUBROUTINE ReadPointsFile - - - -SUBROUTINE AddedMassMessage( AM, ToFile, Msg, MsgLen ) - - REAL(ReKi), INTENT(IN ) :: AM(6,6) !< Added mass matrix - LOGICAL, INTENT(IN ) :: ToFile !< Prepend comment character - CHARACTER(2048), INTENT( OUT) :: Msg - INTEGER(IntKi), INTENT( OUT) :: MsgLen - - ! Local Variables - CHARACTER(15) :: TmpNumString - INTEGER(IntKi) :: ErrStatTmp - INTEGER(IntKi) :: I !< Simple counter - - Msg = '' - - IF ( ToFile ) THEN - Msg='# Added Mass Values (kg, kg-m, kg-m^2):'//NewLine//NewLine - ELSE - Msg="Added Mass values (kg, kg-m, kg-m^2):"//NewLine//NewLine - ENDIF - - ! Header info: - Msg = TRIM(Msg) - IF ( ToFile ) Msg=TRIM(Msg)//'#' - Msg = TRIM(Msg)//" Dim TDxi TDyi TDzi RDxi RDyi RDzi "//NewLine - IF ( ToFile ) Msg=TRIM(Msg)//'#' - Msg = TRIM(Msg)//" ------------------------------------------------------------------------------"//NewLine - - MsgLen= LEN_TRIM(Msg)-1 ! Not sure why an extra count exists here. - - - CALL printDirection(" TDxi",1) - CALL printDirection(" TDyi",2) - CALL printDirection(" TDzi",3) - CALL printDirection(" RDxi",4) - CALL printDirection(" RDyi",5) - CALL printDirection(" RDzi",6) - - - - RETURN - - CONTAINS - SUBROUTINE printDirection( NameIn, IndexNum) - - CHARACTER(*), INTENT(IN ) :: NameIn - INTEGER(IntKi), INTENT(IN ) :: IndexNum - - IF ( ToFile ) THEN - Msg= TRIM(Msg)//"#"//TRIM(NameIn) - ELSE - Msg= TRIM(Msg)//" "//TRIM(NameIn) - ENDIF - MsgLen= MsgLen+8 - Msg = Msg(1:MsgLen)//" " - MsgLen= MsgLen+1 - DO I=1,6 - WRITE(TmpNumString,'(ES10.3E2)',IOSTAT=ErrStatTmp) AM(IndexNum,I) - Msg = Msg(1:MsgLen)//TmpNumString(1:10) - MsgLen= MsgLen+2+10 - ENDDO - Msg = Msg(1:MsgLen)//NewLine - - - - RETURN - - END SUBROUTINE printDirection - -END SUBROUTINE AddedMassMessage - - -!> This subroutine writes the Added Mass matrix to a file -SUBROUTINE AddedMass_OutputWrite (DvrSettings, Initialized, PtfmAM, ErrStat, ErrMsg) - - TYPE( OrcaDriver_Settings ), INTENT(INOUT) :: DvrSettings !< Stored settings - LOGICAL, INTENT(INOUT) :: Initialized !< Was this file started before? - REAL(ReKi), INTENT(IN ) :: PtfmAM(6,6) !< The added mass matrix - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< returns a non-zero value when an error occurs - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Temporary local variables - INTEGER(IntKi) :: ErrStatTmp !< Temporary variable for the status of error message - CHARACTER(2048) :: ErrMsgTmp !< Temporary variable for the error message - CHARACTER(*), PARAMETER :: RoutineName = 'AddedMass_OutputWrite' - INTEGER(IntKi) :: LenErrMsgTmp !< Length of ErrMsgTmp (for getting WindGrid info) - - CHARACTER(25) :: AMfmt !< Format specifier for the output file for wave elevation series - INTEGER(IntKi) :: I !< generic counter - - - AMfmt = "(ES10.3E2,5(3x,ES10.3E2))" - - ErrMsg = '' - ErrStat = ErrID_None - ErrMsgTmp = '' - ErrStatTmp = ErrID_None - - - ! If it hasn't been initially written to, do this then exit. Otherwise set a few things and continue. - IF ( .NOT. Initialized ) THEN - - CALL GetNewUnit( DvrSettings%AddedMassOutputUnit ) - CALL OpenFOutFile( DvrSettings%AddedMassOutputUnit, TRIM(DvrSettings%AddedMassFileName), ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - Initialized = .TRUE. - - ! Write header section - WRITE( DvrSettings%AddedMassOutputUnit,'(A)', IOSTAT=ErrStatTmp ) '## This file was generated by '//TRIM(GetNVD(DvrSettings%ProgInfo))// & - ' on '//CurDate()//' at '//CurTime()//'.' - WRITE( DvrSettings%AddedMassOutputUnit,'(A)', IOSTAT=ErrStatTmp ) '## This file contains the added mass matrix that is returned from OrcaFlex' - WRITE (DvrSettings%AddedMassOutputUnit,'(A)', IOSTAT=ErrStatTmp ) '## It is arranged in a 6x6 matrix' - WRITE (DvrSettings%AddedMassOutputUnit,'(A)', IOSTAT=ErrStatTmp ) '# ' - CALL AddedMassMessage( PtfmAM, .FALSE., ErrMsgTmp, LenErrMsgTmp ) - WRITE (DvrSettings%AddedMassOutputUnit,'(A)', IOSTAT=ErrStatTmp ) ErrMsgTmp(1:LenErrMsgTmp) - ELSE - ! keep this as a placeholder in case we decide to write out at each timestep. - ENDIF - - -END SUBROUTINE AddedMass_OutputWrite - - -SUBROUTINE PointsForce_OutputWrite(ProgInfo, OutUnit, OutFileName, InputFileName, Initialized, AnglesInDegrees, TotalPoints, & - Time, InitOutData, p, u, y, ErrStat, ErrMsg) - - TYPE(ProgDesc), INTENT(IN ) :: ProgInfo !< Program info - INTEGER(IntKi), INTENT(INOUT) :: OutUnit !< Output Unit number - CHARACTER(1024), INTENT(IN ) :: OutFileName !< Name of the file to write to - CHARACTER(1024), INTENT(IN ) :: InputFileName !< Name of the file the points came from - LOGICAL, INTENT(INOUT) :: Initialized !< Is the file initialized - LOGICAL, INTENT(IN ) :: AnglesInDegrees !< The angles are in degrees. - INTEGER(IntKi), INTENT(IN ) :: TotalPoints !< The total number of points in the points file - REAL(DbKi), INTENT(IN ) :: Time !< Current time - TYPE(Orca_InitOutputType), INTENT(IN ) :: InitOutData !< InitOutData -- need the header info - TYPE(Orca_ParameterType), INTENT(IN ) :: p !< p - TYPE(Orca_InputType), INTENT(IN ) :: u !< u - TYPE(Orca_OutputType), INTENT(IN ) :: y !< y - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< returns a non-zero value when an error occurs - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Temporary local variables - INTEGER(IntKi) :: ErrStatTmp !< Temporary variable for the status of error message - CHARACTER(*), PARAMETER :: RoutineName = 'PointsForce_OutputWrite' - CHARACTER(2048) :: ErrMsgTmp !< Temporary variable for the error message - INTEGER(IntKi) :: LenErrMsgTmp !< Length of ErrMsgTmp (for getting WindGrid info) - REAL(ReKi) :: rotdisp(3) !< Rotational displacement (euler angles) - INTEGER(IntKi) :: I !< Generic counter - REAL(ReKi) :: outputArray(13) - - CHARACTER(47) :: PointsOutputFmt !< Format specifier for the output file for wave elevation series - CHARACTER(3) :: AngleUnit !< Units for the angle - - PointsOutputFmt = "(ES10.3E2,18(3x,ES10.3E2))" - - ErrMsg = '' - ErrStat = ErrID_None - ErrMsgTmp = '' - ErrStatTmp = ErrID_None - - - ! If it hasn't been initially written to, do this then exit. Otherwise set a few things and continue. - IF ( .NOT. Initialized ) THEN - - IF ( AnglesInDegrees ) THEN - AngleUnit = "deg" - ELSE - AngleUnit = "rad" - ENDIF - - CALL GetNewUnit( OutUnit ) - CALL OpenFOutFile( OutUnit, TRIM(OutFileName), ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - Initialized = .TRUE. - - ! Write header section - WRITE( OutUnit,'(A)', IOSTAT=ErrStatTmp ) '## This file was generated by '//TRIM(GetNVD(ProgInfo))// & - ' on '//CurDate()//' at '//CurTime()//'.' - IF ( TotalPoints >= 1_IntKi ) THEN - WRITE( OutUnit,'(A)', IOSTAT=ErrStatTmp ) '## This file contains the resulting forces and moments for the '// & - TRIM(Num2LStr(TotalPoints))//' points specified in the '// & - 'file '//TRIM(InputFileName)//'.' - ENDIF - WRITE (OutUnit,'(A)', IOSTAT=ErrStatTmp ) '# ' - CALL WrFileNR( OutUnit, '# Time '// & - ' TDxi TDyi TDzi ' // & - ' RDxi RDyi RDzi ' // & - ' TVxi TVyi TVzi ' // & - ' RVxi RVyi RVzi ' ) - DO I=1,SIZE(InitOutData%WriteOutputHdr) - CALL WrFileNR ( OutUnit, ' '//InitOutData%WriteOutputHdr(I) ) - ENDDO ! I - WRITE (OutUnit,'(A)', IOSTAT=ErrStatTmp ) '' - - - - CALL WrFileNR( OutUnit, '# (s) '// & - ' (m) (m) (m) ' // & - ' ('//AngleUnit//') ('//AngleUnit//') ('//AngleUnit//') '// & - ' (m/s) (m/s) (m/s) ' // & - ' ('//AngleUnit//'/s) ('//AngleUnit//'/s) ('//AngleUnit//'/s) ' ) - DO I=1,SIZE(InitOutData%WriteOutputHdr) - CALL WrFileNR ( OutUnit, ' '//InitOutData%WriteOutputUnt(I) ) - ENDDO ! I - WRITE (OutUnit,'(A)', IOSTAT=ErrStatTmp ) '' - ENDIF - - rotdisp = GetSmllRotAngs ( u%PtfmMesh%Orientation(:,:,1), ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) - - IF ( AnglesInDegrees ) THEN - outputArray = (/ REAL(Time, ReKi), & - REAL(u%PtfmMesh%TranslationDisp(1,1), ReKi), & - REAL(u%PtfmMesh%TranslationDisp(2,1), ReKi), & - REAL(u%PtfmMesh%TranslationDisp(3,1), ReKi), & - rotdisp(1)*R2D, rotdisp(2)*R2D, rotdisp(3)*R2D, & - u%PtfmMesh%TranslationVel(1,1), u%PtfmMesh%TranslationVel(2,1), u%PtfmMesh%TranslationVel(3,1), & - u%PtfmMesh%RotationVel(1,1)*R2D, u%PtfmMesh%RotationVel(2,1)*R2D, u%PtfmMesh%RotationVel(3,1)*R2D /) - ELSE - outputArray = (/ REAL(Time, ReKi), & - REAL(u%PtfmMesh%TranslationDisp(1,1), ReKi), & - REAL(u%PtfmMesh%TranslationDisp(2,1), ReKi), & - REAL(u%PtfmMesh%TranslationDisp(3,1), ReKi), & - rotdisp(1), rotdisp(2), rotdisp(3), & - u%PtfmMesh%TranslationVel(1,1), u%PtfmMesh%TranslationVel(2,1), u%PtfmMesh%TranslationVel(3,1), & - u%PtfmMesh%RotationVel(1,1), u%PtfmMesh%RotationVel(2,1), u%PtfmMesh%RotationVel(3,1) /) - ENDIF - - CALL WrNumAryFileNR( OutUnit, outputArray, '3x,ES10.3E2', ErrStatTmp, ErrMsgTmp ) - CALL WrNumAryFileNR( OutUnit, y%WriteOutput, '3x,ES10.3E2', ErrStatTmp, ErrMsgTmp ) - WRITE (OutUnit,'(A)', IOSTAT=ErrStatTmp ) '' - -END SUBROUTINE PointsForce_OutputWrite - - - - -!> This routine exists only to support the development of the module. It will not be needed after the module is complete. -SUBROUTINE printSettings( DvrFlags, DvrSettings ) - ! The arguments - TYPE( OrcaDriver_Flags ), INTENT(IN ) :: DvrFlags !< Flags indicating which settings were set - TYPE( OrcaDriver_Settings ), INTENT(IN ) :: DvrSettings !< Stored settings - - CALL WrsCr(TRIM(GetNVD(DvrSettings%ProgInfo))) - CALL WrScr(' DvrIptFile: '//FLAG(DvrFlags%DvrIptFile)// ' '//TRIM(DvrSettings%DvrIptFileName)) - CALL WrScr(' OrcaIptFile: '//FLAG(DvrFlags%OrcaIptFile)// ' '//TRIM(DvrSettings%OrcaIptFileName)) -! CALL WrScr(' DLLPathFileName: '//FLAG(DvrFlags%DLLPathFileName)// ' '//TRIM(DvrSettings%DLLPathFileName)) - CALL WrScr(' PointsFile: '//FLAG(DvrFlags%PointsFile)// ' '//TRIM(DvrSettings%PointsFileName)) - CALL WrScr(' AddedMass: '//FLAG(DvrFlags%AddedMass)) - CALL WrScr(' AddedMassFile: '//FLAG(DvrFlags%AddedMassFile)// ' '//TRIM(DvrSettings%AddedMassFileName)) - IF ( DvrFlags%DTDefault) THEN - CALL WrScr(' DT: '//FLAG(DvrFlags%DT)// ' DEFAULT') - ELSE - CALL WrScr(' DT: '//FLAG(DvrFlags%DT)// ' '//TRIM(Num2LStr(DvrSettings%DT))) - ENDIF - IF ( DvrFlags%Degrees ) THEN - CALL WrScr(' PtfmCoord: '//FLAG(DvrFlags%PtfmCoord)// ' ['//TRIM(Num2LStr(DvrSettings%PtfmCoord(1)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmCoord(2)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmCoord(3)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmCoord(4)*R2D))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmCoord(5)*R2D))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmCoord(6)*R2D))//']') - CALL WrScr(' PtfmVeloc: '//FLAG(DvrFlags%PtfmVeloc)// ' ['//TRIM(Num2LStr(DvrSettings%PtfmVeloc(1)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmVeloc(2)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmVeloc(3)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmVeloc(4)*R2D))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmVeloc(5)*R2D))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmVeloc(6)*R2D))//']') - CALL WrScr(' PtfmAccel: '//FLAG(DvrFlags%PtfmAccel)// ' ['//TRIM(Num2LStr(DvrSettings%PtfmAccel(1)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmAccel(2)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmAccel(3)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmAccel(4)*R2D))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmAccel(5)*R2D))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmAccel(6)*R2D))//']') - ELSE - CALL WrScr(' PtfmCoord: '//FLAG(DvrFlags%PtfmCoord)// ' ['//TRIM(Num2LStr(DvrSettings%PtfmCoord(1)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmCoord(2)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmCoord(3)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmCoord(4)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmCoord(5)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmCoord(6)))//']') - CALL WrScr(' PtfmVeloc: '//FLAG(DvrFlags%PtfmVeloc)// ' ['//TRIM(Num2LStr(DvrSettings%PtfmVeloc(1)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmVeloc(2)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmVeloc(3)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmVeloc(4)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmVeloc(5)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmVeloc(6)))//']') - CALL WrScr(' PtfmAccel: '//FLAG(DvrFlags%PtfmAccel)// ' ['//TRIM(Num2LStr(DvrSettings%PtfmAccel(1)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmAccel(2)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmAccel(3)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmAccel(4)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmAccel(5)))//', '& - //TRIM(Num2LStr(DvrSettings%PtfmAccel(6)))//']') - ENDIF - CALL WrScr(' Degrees: '//FLAG(DvrFlags%Degrees)// ' PtfmCoord, PtfmVeloc, and PtfmAccel angles in degrees') - CALL WrScr(' PointsDegrees: '//FLAG(DvrFlags%PointsDegrees)// ' PointsFile angles in degrees') - CALL WrScr(' PointsOutputInit: '//FLAG(DvrFlags%PointsOutputInit)// ' Unit #: '//TRIM(Num2LStr(DvrSettings%PointsOutputUnit))) - RETURN -END SUBROUTINE printSettings - - -!> This routine exists only to support the development of the module. It will not be kept after the module is complete. -!! This routine takes a flag setting (LOGICAL) and exports either 'T' or '-' for T/F (respectively) -FUNCTION FLAG(flagval) - LOGICAL, INTENT(IN ) :: flagval !< Value of the flag - CHARACTER(1) :: FLAG !< character interpretation (for prettiness when printing) - IF ( flagval ) THEN - FLAG = 'T' - ELSE - FLAG = '-' - ENDIF - RETURN -END FUNCTION FLAG - -!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- -!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- -!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- -!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- -!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- -END MODULE OrcaDriver_Subs diff --git a/OpenFAST/modules/orcaflex-interface/src/OrcaDriver_Types.f90 b/OpenFAST/modules/orcaflex-interface/src/OrcaDriver_Types.f90 deleted file mode 100644 index 78bbd7bf9..000000000 --- a/OpenFAST/modules/orcaflex-interface/src/OrcaDriver_Types.f90 +++ /dev/null @@ -1,94 +0,0 @@ -!********************************************************************************************************************************** -! -! MODULE: Orca_Driver_Types - This module contains types used by the OrcaFlexInterface Driver program to store arguments passed in -! -! The types listed here are used within the OrcaFlexInterface Driver program to store the settings. These settings are read in as -! command line arguments, then stored within these types. -! -!********************************************************************************************************************************** -! -!.................................................................................................................................. -! LICENSING -! Copyright (C) 2015 National Renewable Energy Laboratory -! -! This file is part of OrcaFlexInterface. -! -! OrcaFlexInterface is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as -! published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -! -! This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License along with OrcaFlexInterface. -! If not, see . -! -!********************************************************************************************************************************** -! File last committed: $Date: 2014-07-29 13:30:04 -0600 (Tue, 29 Jul 2014) $ -! (File) Revision #: $Rev: 169 $ -! URL: $HeadURL: https://windsvn.nrel.gov/OrcaFlexInterface/branches/modularization2/Source/Driver/OrcaDriver_Types.f90 $ -!********************************************************************************************************************************** - -MODULE OrcaDriver_Types - - USE NWTC_Library - USE OrcaFlexInterface_Types - - IMPLICIT NONE - - !> This contains flags to note if the settings were made. This same data structure is - !! used both during the driver input file and the command line options. - !! - !! NOTE: The WindFileType is only set if it is given as a command line option. Otherwise - !! it is handled internally by InflowWInd. - !! - !! NOTE: The wind direction is specified by the OrcaFlexInterface input file. - TYPE :: OrcaDriver_Flags - LOGICAL :: DvrIptFile = .FALSE. !< Was an input file name given on the command line? - LOGICAL :: OrcaIptFile = .FALSE. !< Was an OrcaFlexInterface input file requested? - LOGICAL :: AddedMass = .FALSE. !< create an added mass table at command line? - LOGICAL :: AddedMassFile = .FALSE. !< create an added mass file? - LOGICAL :: DT = .FALSE. !< specified a resolution in time - LOGICAL :: DTDefault = .FALSE. !< specified a 'DEFAULT' for the time resolution - - - LOGICAL :: Degrees = .FALSE. !< angles are specified in degrees - - LOGICAL :: PtfmCoord = .FALSE. !< (x,y,z,R1,R2,R3) coordinate specified - LOGICAL :: PtfmVeloc = .FALSE. !< (x,y,z,R1,R2,R3) coordinate specified - LOGICAL :: PtfmAccel = .FALSE. !< (x,y,z,R1,R2,R3) coordinate specified - - - LOGICAL :: PointsFile = .FALSE. !< points filename to read in - LOGICAL :: PointsDegrees = .FALSE. !< points in the pointsfile are specified in degrees - - LOGICAL :: AddedMassOutputInit = .FALSE. !< Is the WindGridOut file initialized - LOGICAL :: PointsOutputInit = .FALSE. !< Is the Points output file initialized - LOGICAL :: Verbose = .FALSE. !< Verbose error reporting - LOGICAL :: VVerbose = .FALSE. !< Very Verbose error reporting - END TYPE OrcaDriver_Flags - - - ! This contains all the settings (possible passed in arguments). - TYPE :: OrcaDriver_Settings - CHARACTER(1024) :: DvrIptFileName !< Driver input file name - CHARACTER(1024) :: OrcaIptFileName !< Filename of OrcaFlexInterface input file to read (if no driver input file) - CHARACTER(1024) :: AddedMassFileName !< Filename for the added mass matrix output - - CHARACTER(1024) :: PointsFileName !< Filename of points file to read in - CHARACTER(1024) :: PointsOutputName !< Filename for output from points read in from points file - INTEGER(IntKi) :: AddedMassOutputUnit !< Unit number for the output file for the AddedMass matrix - INTEGER(IntKi) :: PointsOutputUnit !< Unit number for the output file for the Points file output - REAL(DbKi) :: DT !< resolution of time - REAL(ReKi) :: TMax !< Maximum time (we calculate this based on the number of points and timestep) - - REAL(ReKi) :: PtfmCoord(1:6) !< (x,y,z,R1,R2,R3) coordinate and rotations to calculate at - REAL(ReKi) :: PtfmVeloc(1:6) !< instantaneous velocities corresponding to the PtfmCoord - REAL(ReKi) :: PtfmAccel(1:6) !< instantaneous velocities corresponding to the PtfmCoord - - TYPE(ProgDesc) :: ProgInfo !< Program info - TYPE(ProgDesc) :: OrcaProgInfo !< Program info for OrcaFlexInterface - - END TYPE OrcaDriver_Settings - - -END MODULE OrcaDriver_Types diff --git a/OpenFAST/modules/orcaflex-interface/src/OrcaFlexInterface.f90 b/OpenFAST/modules/orcaflex-interface/src/OrcaFlexInterface.f90 deleted file mode 100644 index 9dcbcbaf9..000000000 --- a/OpenFAST/modules/orcaflex-interface/src/OrcaFlexInterface.f90 +++ /dev/null @@ -1,1082 +0,0 @@ -!********************************************************************************************************************************** -! The OrcaFlexInterface.f90 and OrcaFlexInterface_Types.f90 make up the OrcaFlexInterface module of the -! FAST Modularization Framework. OrcaFlexInterface_Types is auto-generated based on FAST_Registry.txt. -!.................................................................................................................................. -! LICENSING -! Copyright (C) 2015-2016 National Renewable Energy Laboratory -! -! This file is part of OrcaFlexInterface. -! -! 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 contains definitions of compile-time PARAMETERS for the OrcaFlex Interface module. -!! Every variable defined here MUST have the PARAMETER attribute. -MODULE OrcaFlexInterface_Parameters - - USE NWTC_Library - - IMPLICIT NONE - - TYPE(ProgDesc), PARAMETER :: Orca_Ver = ProgDesc( 'OrcaFlexInterface', '', '' ) - CHARACTER(*), PARAMETER :: Orca_Nickname = 'Orca' - - -! =================================================================================================== -! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" -! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these -! lines should be modified in the Matlab script and/or Excel worksheet as necessary. -! =================================================================================================== -! This code was generated by Write_ChckOutLst.m at 01-Sep-2015 14:29:18. - - - ! Parameters related to output length (number of characters allowed in the output data headers): - - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 1 - - - ! Indices for computing output channels: - ! NOTES: - ! (1) These parameters are in the order stored in "OutListParameters.xlsx" - ! (2) Array AllOuts() must be dimensioned to the value of the largest output parameter - - ! Time: - - INTEGER(IntKi), PARAMETER :: Time = 0 - - - ! Platform forces: - - INTEGER(IntKi), PARAMETER :: OrcaFxi = 1 - INTEGER(IntKi), PARAMETER :: OrcaFyi = 2 - INTEGER(IntKi), PARAMETER :: OrcaFzi = 3 - INTEGER(IntKi), PARAMETER :: OrcaMxi = 4 - INTEGER(IntKi), PARAMETER :: OrcaMyi = 5 - INTEGER(IntKi), PARAMETER :: OrcaMzi = 6 - INTEGER(IntKi), PARAMETER :: OrcaHMFxi = 7 - INTEGER(IntKi), PARAMETER :: OrcaHMFyi = 8 - INTEGER(IntKi), PARAMETER :: OrcaHMFzi = 9 - INTEGER(IntKi), PARAMETER :: OrcaHMMxi = 10 - INTEGER(IntKi), PARAMETER :: OrcaHMMyi = 11 - INTEGER(IntKi), PARAMETER :: OrcaHMMzi = 12 - INTEGER(IntKi), PARAMETER :: OrcaAMFxi = 13 - INTEGER(IntKi), PARAMETER :: OrcaAMFyi = 14 - INTEGER(IntKi), PARAMETER :: OrcaAMFzi = 15 - INTEGER(IntKi), PARAMETER :: OrcaAMMxi = 16 - INTEGER(IntKi), PARAMETER :: OrcaAMMyi = 17 - INTEGER(IntKi), PARAMETER :: OrcaAMMzi = 18 - - - ! The maximum number of output channels which can be output by the code. - INTEGER(IntKi), PARAMETER :: MaxOutPts = 18 - -!End of code generated by Matlab script -! =================================================================================================== - -END MODULE OrcaFlexInterface_Parameters -!********************************************************************************************************************************** -!> This module is an interface between FAST and OrcaFlex, a commercial software package developed by Orcina. This interfaces calls -!! an OrcaFlex DLL once per time step, and is valid for loose coupling. Tight coupling is not supported. -MODULE OrcaFlexInterface - - USE NWTC_Library - USE NWTC_LAPACK - - USE OrcaFlexInterface_Parameters - USE OrcaFlexInterface_Types - - USE, INTRINSIC :: ISO_C_Binding - - - IMPLICIT NONE - - PRIVATE - - - INTERFACE ! These are interfaces to the DLL - -#ifdef __GFORTRAN__ - SUBROUTINE OrcaFlexUserPtfmLdInitialise(DT,TMax) BIND(C) -#else - SUBROUTINE OrcaFlexUserPtfmLdInitialise(DT,TMax) !!!BIND(C) -#endif - USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_FLOAT - !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'OrcaFlexUserPtfmLdInitialise'::OrcaFlexUserPtfmLdInitialise - !GCC$ ATTRIBUTES STDCALL :: OrcaFlexUserPtfmLdInitialise - REAL(C_FLOAT), INTENT(IN ) :: DT - REAL(C_FLOAT), INTENT(IN ) :: TMax - END SUBROUTINE OrcaFlexUserPtfmLdInitialise - - -#ifdef __GFORTRAN__ - SUBROUTINE OrcaFlexUserPtfmLd( X, XD, ZTime, DirRoot, PtfmAM, PtfmFt) BIND(C) -#else - SUBROUTINE OrcaFlexUserPtfmLd( X, XD, ZTime, DirRoot, PtfmAM, PtfmFt) !!!BIND(C) -#endif - USE, INTRINSIC :: ISO_C_Binding, ONLY: C_FLOAT, C_CHAR - !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'OrcaFlexUserPtfmLd'::OrcaFlexUserPtfmLd - !GCC$ ATTRIBUTES STDCALL :: OrcaFlexUserPtfmLd - CHARACTER(KIND=C_CHAR), INTENT(IN ) :: DirRoot - REAL(C_FLOAT), INTENT(IN ) :: X(6) !< Translational and rotational displacement (m, radians) relative to inertial frame. - REAL(C_FLOAT), INTENT(IN ) :: XD(6) !< Translational and rotational velocity (m/s, radians/s) relative to inertial frame. - REAL(C_FLOAT), INTENT(IN ) :: ZTime !< Current time in seconds - REAL(C_FLOAT), INTENT( OUT) :: PtfmAM(6,6) !< Added mass matrix (kg, kg-m, kg-m^2) - REAL(C_FLOAT), INTENT( OUT) :: PtfmFt(6) !< Platform forces -- [3 translation (N), 3 moments (N-m)] at reference point. - END SUBROUTINE OrcaFlexUserPtfmLd - - - -#ifdef __GFORTRAN__ - SUBROUTINE OrcaFlexUserPtfmLdFinalise() BIND(C) -#else - SUBROUTINE OrcaFlexUserPtfmLdFinalise() !!!BIND(C) -#endif - USE, INTRINSIC :: ISO_C_BINDING - !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS: 'OrcaFlexUserPtfmLdFinalise'::OrcaFlexUserPtfmLdFinalise - !GCC$ ATTRIBUTES STDCALL :: OrcaFlexUserPtfmLdFinalise - ! There is no data to pass. - END SUBROUTINE OrcaFlexUserPtfmLdFinalise - - END INTERFACE - - - ! ..... Public Subroutines ................................................................................................... - - PUBLIC :: Orca_Init ! Initialization routine - PUBLIC :: Orca_End ! Ending routine (includes clean up) - - PUBLIC :: Orca_UpdateStates ! Loose coupling routine for solving for constraint states, integrating - ! continuous states, and updating discrete states - PUBLIC :: Orca_CalcOutput ! Routine for computing outputs - -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 Orca_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) - - USE, INTRINSIC :: ISO_C_Binding - - TYPE(Orca_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine - TYPE(Orca_InputType), INTENT( OUT) :: u !< An initial guess for the input; input mesh must be defined - TYPE(Orca_ParameterType), INTENT( OUT) :: p !< Parameters - TYPE(Orca_ContinuousStateType), INTENT( OUT) :: x !< Initial continuous states - TYPE(Orca_DiscreteStateType), INTENT( OUT) :: xd !< Initial discrete states - TYPE(Orca_ConstraintStateType), INTENT( OUT) :: z !< Initial guess of the constraint states - TYPE(Orca_OtherStateType), INTENT( OUT) :: OtherState !< Initial other states - TYPE(Orca_OutputType), INTENT( OUT) :: y !< Initial system outputs (outputs are not calculated; - !! only the output mesh is initialized) - TYPE(Orca_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) - REAL(DbKi), INTENT(INOUT) :: Interval !< Coupling interval in seconds: the rate that - !! (1) Orca_UpdateStates() is called in loose coupling & - !! (2) Orca_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. - TYPE(Orca_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 - TYPE(Orca_InputFile) :: InputFileData ! Data stored in the module's input file - INTEGER(IntKi) :: ErrStatTmp ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsgTmp ! temporary Error message if ErrStat /= ErrID_None - CHARACTER(*), PARAMETER :: RoutineName='Orca_Init' - CHARACTER(ChanLen) :: TmpOutList(MaxOutPts) - - - REAL(C_FLOAT) :: DLL_DT - REAL(C_FLOAT) :: DLL_TMax - - - PROCEDURE(OrcaFlexUserPtfmLdInitialise),POINTER :: OrcaDLL_Init - - - - - ! Initialize variables for this routine - ErrStat = ErrID_None - ErrMsg = "" - - ! dummy variables for the FAST framework: - ! (initialized to prevent compiler warnings about INTENT(OUT) variables) - OtherState%DummyOtherState = 0 - z%DummyConstrState = 0.0_ReKi - xd%Dummy = 0.0_ReKi - x%Dummy = 0.0_ReKi - - - ! Set some things for the DLL - InputFileData%DLL_InitProcName = 'OrcaFlexUserPtfmLdInitialise' - InputFileData%DLL_CalcProcName = 'OrcaFlexUserPtfmLd' - InputFileData%DLL_EndProcName = 'OrcaFlexUserPtfmLdFinalise' - - - ! Display the module information - CALL DispNVD( Orca_Ver ) - - - CALL ReadPrimaryFile( InitInp%InputFile, InputFileData, TRIM(InitInp%RootName)//'.Orca', ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - - - ! We are going to output all the possible outlist variables, so pass in to SetOutParam the full list - TmpOutList = (/ & - "OrcaFxi ","OrcaFyi ","OrcaFzi ","OrcaMxi ","OrcaMyi ","OrcaMzi ", & ! Total forces / moments - "OrcaHMFxi","OrcaHMFyi","OrcaHMFzi","OrcaHMMxi","OrcaHMMyi","OrcaHMMzi", & ! hydrodynamic contributions - "OrcaAMFxi","OrcaAMFyi","OrcaAMFzi","OrcaAMMxi","OrcaAMMyi","OrcaAMMzi" & ! Added mass contributions - /) - p%NumOuts = MaxOutPts - CALL SetOutParam( TmpOutList, p, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat>= AbortErrLev ) RETURN - - - ! Allocate array for AllOuts - CALL AllocAry( m%AllOuts, p%NumOuts, 'AllOuts', ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat>= AbortErrLev ) RETURN - m%AllOuts = 0.0_ReKi - - - ! Allocate arrays for the WriteOutput - CALL AllocAry( y%WriteOutput, p%NumOuts, 'WriteOutput', ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat>= AbortErrLev ) THEN - CALL Cleanup() - RETURN - ENDIF - y%WriteOutput = 0.0_ReKi - - CALL AllocAry( InitOut%WriteOutputHdr, p%NumOuts, 'WriteOutputHdr', ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat>= AbortErrLev ) THEN - CALL Cleanup() - RETURN - ENDIF - - CALL AllocAry( InitOut%WriteOutputUnt, p%NumOuts, 'WriteOutputUnt', ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat>= AbortErrLev ) THEN - CALL Cleanup() - RETURN - ENDIF - - InitOut%WriteOutputHdr = p%OutParam(1:p%NumOuts)%Name - InitOut%WriteOutputUnt = p%OutParam(1:p%NumOuts)%Units - - - - - - - - - - ! Init routine load - p%DLL_Orca%FileName = InputFileData%DLL_FileName - p%DLL_Orca%ProcName(1) = InputFileData%DLL_InitProcName - p%DLL_Orca%ProcName(2) = InputFileData%DLL_CalcProcName - p%DLL_Orca%ProcName(3) = InputFileData%DLL_EndProcName - -#ifdef NO_LibLoad - CALL SetErrStat( ErrID_Warn,' --> Skipping LoadDynamicLib call for '//TRIM(p%DLL_Orca%FileName),ErrStat,ErrMsg,RoutineName ) -#else - CALL LoadDynamicLib ( p%DLL_Orca, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp - RETURN - END IF - - CALL C_F_PROCPOINTER( p%DLL_Orca%ProcAddr(1), OrcaDLL_Init ) -#endif - - - - - ! Set the values to pass to OrcaDLL_Init - DLL_DT = Interval - DLL_TMax = InitInp%TMax - -#ifdef NO_LibLoad - CALL SetErrStat( ErrID_Warn,' --> Skipping OrcaDLL_Init call',ErrStat,ErrMsg,RoutineName ) -#else - CALL OrcaDLL_Init ( DLL_DT, DLL_TMax ) - ! Unfortunately, we don't get any error reporting back from OrcaDLL_Init, so we can't really check anything. - !bjj: we should be warning people to use text output files instead of binary in case OrcaFlex crashes... -#endif - - - ! Copy relevant information into parameters. - p%SimNamePathLen = LEN_TRIM(InputFileData%DirRoot)+1 - p%SimNamePath = TRIM(InputFileData%DirRoot)//CHAR(0) - - - ! Create the input and output meshes associated with lumped loads - CALL MeshCreate( BlankMesh = u%PtfmMesh , & - IOS = COMPONENT_INPUT , & - Nnodes = 1 , & - ErrStat = ErrStatTmp , & - ErrMess = ErrMsgTmp , & - TranslationDisp = .TRUE. , & - Orientation = .TRUE. , & - TranslationVel = .TRUE. , & - RotationVel = .TRUE. , & - TranslationAcc = .TRUE. , & - RotationAcc = .TRUE.) - - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp - RETURN - END IF - - ! Create the node on the mesh - CALL MeshPositionNode (u%PtfmMesh, 1, (/0.0_ReKi, 0.0_ReKi, 0.0_ReKi/), ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) - - ! Create the mesh element - CALL MeshConstructElement ( u%PtfmMesh, ELEMENT_POINT, ErrStatTmp, ErrMsgTmp, 1 ) - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) - - CALL MeshCommit ( u%PtfmMesh, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp - RETURN - END IF - - - CALL MeshCopy( SrcMesh=u%PtfmMesh, DestMesh=y%PtfmMesh, CtrlCode=MESH_SIBLING, IOS=COMPONENT_OUTPUT, & - ErrStat=ErrStatTmp, ErrMess=ErrMsgTmp, Force=.TRUE., Moment=.TRUE. ) - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp - RETURN - END IF - - - u%PtfmMesh%RemapFlag = .TRUE. - y%PtfmMesh%RemapFlag = .TRUE. - - - - - ! Set zero values for the MiscVar arrays - m%PtfmAM = 0.0_ReKi - m%PtfmFt = 0.0_ReKi - m%LastTimeStep = -1.0_DbKi - - InitOut%Ver = Orca_Ver - - -CONTAINS - !------------------------------------------------------------------ - SUBROUTINE CleanUp() - - IF ( ErrStat >= AbortErrLev ) THEN - CALL Orca_DestroyInputFile(InputFileData, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - END IF - - END SUBROUTINE CleanUp - -END SUBROUTINE Orca_Init - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine reads in the primary OrcaFlex Interface input file and places the values it reads in the InputFileData structure. -!! It opens an echo file if requested. -SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, ErrStat, ErrMsg ) - - IMPLICIT NONE - - ! Passed variables - INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status - - CHARACTER(*), INTENT(IN) :: InputFile !< Name of the file containing the primary input data - CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message - CHARACTER(*), INTENT(IN) :: OutFileRoot !< The rootname of the echo file, possibly opened in this routine - - TYPE(Orca_InputFile), INTENT(INOUT) :: InputFileData !< All the data in the OrcaFlex Interface input file - - ! Local variables: - INTEGER(IntKi) :: I ! loop counter -! INTEGER(IntKi) :: NumOuts ! Number of output channel names read from the file - INTEGER(IntKi) :: UnEc ! I/O unit for echo file. If > 0, file is open for writing. - INTEGER(IntKi) :: UnIn ! Unit number for reading file - INTEGER(IntKi) :: IOS - INTEGER(IntKi) :: ErrStat2 ! 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) :: CWD ! Path name of the current working directory - CHARACTER(1024) :: FTitle ! "File Title": the 2nd line of the input file, which contains a description of its contents - CHARACTER(200) :: Line ! Temporary storage of a line from the input file (to compare with "default") - CHARACTER(*), PARAMETER :: RoutineName = 'ReadPrimaryFile' - - ! Initialize some variables: - Echo = .FALSE. - UnEc = -1 ! Echo file not opened, yet - CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - - ! OrcaFlex doesn't like relative path names, so we're going to make it absolute - IF ( PathIsRelative( PriPath ) ) THEN - CALL GET_CWD(CWD, ErrStat2) -! PriPath = TRIM(CWD)//PathSep//TRIM(PriPath) - PriPath = TRIM(CWD)//TRIM(PriPath(2:)) - END IF - - - ! Get an available unit number for the file. - - CALL GetNewUnit( UnIn, ErrStat, ErrMsg ) - IF ( ErrStat >= AbortErrLev ) RETURN - - - ! Open the Primary input file. - - CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - - !CALL AllocAry( InputFileData%OutList, MaxOutPts, "OrcaFlex Interface Input File's Outlist", ErrStat2, ErrMsg2 ) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! IF ( ErrStat >= AbortErrLev ) 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. - ! If Echo is TRUE, rewind and write on the second try. - - I = 1 ! the number of times we've read the file (used for the Echo variable) - DO - !-------------------------- HEADER --------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'File Header: Module Version (line 1)', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - CALL ReadStr( UnIn, InputFile, FTitle, 'FTitle', 'File Header: File Description (line 2)', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - !---------------------- SIMULATION DATA -------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Simulation Control', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - ! Echo - Echo input to ".ech". - - CALL ReadVar( UnIn, InputFile, Echo, 'Echo', 'Echo switch', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - - 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, Orca_Ver ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - IF ( UnEc > 0 ) WRITE (UnEc,'(/,A,/)') 'Data from '//TRIM(Orca_Ver%Name)//' primary input file "'//TRIM( InputFile )//'":' - - REWIND( UnIn, IOSTAT=ErrStat2 ) - IF (ErrStat2 /= 0_IntKi ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error rewinding file "'//TRIM(InputFile)//'".', ErrStat, ErrMsg, RoutineName ) - CALL Cleanup() - RETURN - END IF - - END DO - - IF (NWTC_VerboseLevel == NWTC_Verbose) THEN - CALL WrScr( ' Heading of the '//TRIM(Orca_Ver%Name)//' input file: ' ) - CALL WrScr( ' '//TRIM( FTitle ) ) - END IF - - - ! InputFileData%DirRoot - Name of the file containing OrcaFlex simulation inputs: - CALL ReadVar ( UnIn, InputFile, InputFileData%DirRoot, 'DirRoot', 'Name of the OrcaFlex simulation input file', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - IF ( PathIsRelative( InputFileData%DirRoot ) ) InputFileData%DirRoot = TRIM(PriPath)//TRIM(InputFileData%DirRoot) - - ! InputFileData%DLLPathFileName - Name of the file containing OrcaFlex simulation inputs: - CALL ReadVar ( UnIn, InputFile, InputFileData%DLL_FileName, 'DLL_FileName', 'Name of the OrcaFlex DLL', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - IF ( PathIsRelative( InputFileData%DLL_FileName ) ) InputFileData%DLL_FileName = TRIM(PriPath)//TRIM(InputFileData%DLL_FileName) - - - ! ! DT - Requested integration time for OrcaFlex (seconds): - !CALL ReadVar( UnIn, InputFile, Line, "DT", "Requested integration time for OrcaFlex (seconds)", ErrStat2, ErrMsg2, UnEc) - ! CALL CheckError( ErrStat2, ErrMsg2 ) - ! IF ( ErrStat >= AbortErrLev ) RETURN - ! CALL Conv2UC( Line ) - ! IF ( INDEX(Line, "DEFAULT" ) /= 1 ) THEN ! If it's not "default", read this variable; otherwise use the value already stored in InputFileData%DT - ! READ( Line, *, IOSTAT=IOS) InputFileData%DT - ! IF ( IOS /= 0 ) THEN - ! CALL CheckIOS ( IOS, InputFile, "DT", NumType, ErrStat2, ErrMsg2 ) - ! CALL CheckError( ErrStat2, ErrMsg2 ) - ! RETURN - ! END IF - ! END IF - - - !!---------------------- OUTLIST -------------------------------------------- - !CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! IF ( ErrStat >= AbortErrLev ) THEN - ! CALL Cleanup() - ! RETURN - ! END IF - ! - ! ! OutList - List of user-requested output channels (-): - !CALL ReadOutputList ( UnIn, InputFile, InputFileData%OutList, InputFileData%NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! IF ( ErrStat >= AbortErrLev ) THEN - ! CALL Cleanup() - ! RETURN - ! END IF - - !---------------------- END OF FILE ----------------------------------------- - - CALL Cleanup() - RETURN - -CONTAINS - SUBROUTINE Cleanup() - - CLOSE(UnIn) - IF (UnEc > 0) CLOSE(UnEc) - - END SUBROUTINE Cleanup -END SUBROUTINE ReadPrimaryFile -!---------------------------------------------------------------------------------------------------------------------------------- - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is called at the end of the simulation. -SUBROUTINE Orca_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) - - TYPE(Orca_InputType), INTENT(INOUT) :: u !< System inputs - TYPE(Orca_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(Orca_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states - TYPE(Orca_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states - TYPE(Orca_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states - TYPE(Orca_OtherStateType), INTENT(INOUT) :: OtherState !< Other states - TYPE(Orca_OutputType), INTENT(INOUT) :: y !< System outputs - TYPE(Orca_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - PROCEDURE(OrcaFlexUserPtfmLdFinalise), POINTER :: OrcaDLL_End - - ! Error Handling - INTEGER(IntKi) :: ErrStatTmp ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsgTmp ! temporary Error message if ErrStat /= ErrID_None - CHARACTER(*), PARAMETER :: RoutineName='Orca_End' - - - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ErrStatTmp = ErrID_None - ErrMsgTmp = "" - - - - -#ifdef NO_LibLoad - CALL SetErrStat( ErrID_Warn,' --> Skipping OrcaDLL_End call',ErrStat,ErrMsg,RoutineName ) -#else - ! Release the DLL - CALL C_F_PROCPOINTER( p%DLL_Orca%ProcAddr(3), OrcaDLL_End ) - CALL OrcaDLL_End ! No error handling here. Just have to assume it worked. - - - CALL FreeDynamicLib( p%DLL_Orca, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName ) -#endif - - - ! Destroy the input data: - CALL Orca_DestroyInput( u, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName ) - - - ! Destroy the parameter data: -#ifdef NO_LibLoad -#else - CALL Orca_DestroyParam( p, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName ) -#endif - - - ! Destroy the state data: - CALL Orca_DestroyContState( x, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName ) - CALL Orca_DestroyDiscState( xd, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName ) - CALL Orca_DestroyConstrState( z, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName ) - CALL Orca_DestroyOtherState( OtherState, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName ) - - ! Destroy misc variables: - CALL Orca_DestroyMisc( m, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName ) - - - ! Destroy the output data: - CALL Orca_DestroyOutput( y, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName ) - - -END SUBROUTINE Orca_End -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine for computing outputs, used in both loose and tight coupling. -!! This SUBROUTINE is used to compute the output channels (motions and loads) and place them in the WriteOutput() array. -!! NOTE: 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. -!! NOTE: no matter how many channels are selected for output, all of the outputs are calculated -!! 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. -SUBROUTINE Orca_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(Orca_InputType), INTENT(IN ) :: u !< Inputs at Time t - TYPE(Orca_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(Orca_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(Orca_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(Orca_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t - TYPE(Orca_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(Orca_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- - !! nectivity information does not have to be recalculated) - TYPE(Orca_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - PROCEDURE(OrcaFlexUserPtfmLd), POINTER :: OrcaDLL_Calc - - - ! Local variables copied from the mesh - REAL(ReKi) :: rotdisp(3) !< Rotation angles from the mesh - REAL(ReKi) :: q(6) !< Position from the mesh - REAL(ReKi) :: qdot(6) !< Time derivative of position (velocity) from mesh - REAL(ReKi) :: qdotdot(6) !< 2nd time derivative of position (acceleration) from mesh - - - ! Local variables for data manipulation - INTEGER(IntKi) :: I,J !< Generic counters - - - - ! Local variables for the getting the types correct to pass to the DLL - CHARACTER(LEN=p%SimNamePathLen) :: DLL_DirRootName !< Path and simulation name without extension - REAL(C_FLOAT) :: DLL_X(6) !< Translational and rotational displacement (m, radians) relative to inertial frame. - REAL(C_FLOAT) :: DLL_Xdot(6) !< Translational and rotational velocity (m/s, radians/s) relative to inertial frame. - REAL(C_FLOAT) :: DLL_ZTime !< Current time in seconds - REAL(C_FLOAT) :: DLL_PtfmAM(6,6) !< Added mass matrix (kg, kg-m, kg-m^2) - REAL(C_FLOAT) :: DLL_PtfmFt(6) !< Platform forces -- [3 translation (N), 3 moments (N-m)] at reference point. - - - ! Error Handling and data checking - INTEGER(IntKi) :: ErrStatTmp !< Temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsgTmp !< Temporary Error message if ErrStat /= ErrID_None - CHARACTER(*), PARAMETER :: RoutineName='Orca_Calc' - REAL(ReKi), PARAMETER :: SymmetryTol = 9.999E-4_ReKi !< Tolerance used to determine if the PtfmAM is symmetric - - - ! Copy over time and name to pass to OrcaFlex DLL - DLL_DirRootName = TRIM(p%SimNamePath)//C_NULL_CHAR ! Path and name of the simulation file without extension. Null character added to convert from Fortran string to C-type string. - DLL_ZTime = t ! Current time - - ! Determine the rotational angles from the direction-cosine matrix - rotdisp = GetSmllRotAngs ( u%PtfmMesh%Orientation(:,:,1), ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= ErrID_Fatal) RETURN - - q = reshape((/REAL(u%PtfmMesh%TranslationDisp(:,1),ReKi),rotdisp(:)/),(/6/)) - qdot = reshape((/u%PtfmMesh%TranslationVel(:,1),u%PtfmMesh%RotationVel(:,1)/),(/6/)) - qdotdot = reshape((/u%PtfmMesh%TranslationAcc(:,1),u%PtfmMesh%RotationAcc(:,1)/),(/6/)) - - - ! Copy position and motion information over to pass to the DLL - DO I=1,6 - DLL_X(I) = q(I) - DLL_Xdot(I) = qdot(I) - ENDDO - - - -#ifdef NO_LibLoad - CALL SetErrStat( ErrID_Warn,' --> Skipping OrcaDLL_Calc call',ErrStat,ErrMsg,RoutineName ) - DLL_PtfmAM = 0.0_C_FLOAT - DLL_PtfmFt = 0.0_C_FLOAT -#else - - ! We do not want to call OrcaDLL twice in one timestep. If _CalcOutput is called twice in a timestep, the second - ! call is different from the first only with the accelerations, which OrcaFlex does not do anything with. - IF ( t > m%LastTimeStep .and. .not. EqualRealNos(t,m%LastTimeStep) ) THEN - ! Setup the pointer to the DLL procedure - CALL C_F_PROCPOINTER( p%DLL_Orca%ProcAddr(2), OrcaDLL_Calc ) - ! Call OrcaFlex to run the calculation. There is no error trapping on the OrcaFlex side, so we will have to do some checks on what receive back - CALL OrcaDLL_Calc( DLL_X, DLL_Xdot, DLL_ZTime, DLL_DirRootName, DLL_PtfmAM, DLL_PtfmFt ) - m%LastTimeStep = t - - ! Copy data over from the DLL output to the m - DO I=1,6 - m%PtfmFT(I) = DLL_PtfmFT(I) - DO J=1,6 - m%PtfmAM(J,I) = DLL_PtfmAM(J,I) - ENDDO - ENDDO - - - !!! bjj: commented this out 11=Apr=2016 because it doesn't seem like this is necessary; per jmj - !!! ! Perform some quick QA/QC on the DLL results. There isn't much we can check, so just check that things are symmetric within some tolerance - !!!DO I = 1,5 ! Loop through the 1st 5 rows (columns) of PtfmAM - !!! DO J = (I+1),6 ! Loop through all columns (rows) passed I - !!! IF ( ABS( m%PtfmAM(I,J) - m%PtfmAM(J,I) ) > SymmetryTol ) & - !!! ErrStatTmp = ErrID_Fatal - !!! ErrMsgTmp = ' The platform added mass matrix returned from OrcaFlex is unsymmetric.'// & - !!! ' There may be issues with the OrcaFlex calculations.' - !!! ENDDO ! J - All columns (rows) passed I - !!!ENDDO ! I - The 1st 5 rows (columns) of PtfmAM - !!!CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) - !!!IF ( ErrStat >= ErrID_Fatal) RETURN - - ENDIF -#endif - - - ! Now calculate the forces with what OrcaFlex returned - m%F_PtfmAM = -matmul(m%PtfmAM, qdotdot) - - - - ! Update the Mesh with values from OrcaFlex - DO I=1,3 - y%PtfmMesh%Force(I,1) = m%F_PtfmAM(I) + m%PtfmFT(I) - y%PtfmMesh%Moment(I,1) = m%F_PtfmAM(I+3) + m%PtfmFT(I+3) - ENDDO - -!#ifdef NO_LibLoad -! y%PtfmMesh%Force = 6.0E6 -! y%PtfmMesh%Moment = 2.0E6 -!#endif - - - ! Set all the outputs - CALL SetAllOuts( p, y, m, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= ErrID_Fatal) RETURN - - - - RETURN - - -END SUBROUTINE Orca_CalcOutput -!---------------------------------------------------------------------------------------------------------------------------------- -!> This is a loose coupling routine for solving constraint states, integrating continuous states, and updating discrete and other -!! states. Continuous, constraint, discrete, and other states are updated to values at t + Interval. -SUBROUTINE Orca_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, 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(Orca_InputType), INTENT(INOUT) :: u(:) !< Inputs at utimes (out only for mesh record-keeping in ExtrapInterp routine) - REAL(DbKi), INTENT(IN ) :: utimes(:) !< Times associated with u(:), in seconds - TYPE(Orca_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(Orca_ContinuousStateType), INTENT(INOUT) :: x !< Input: Continuous states at t; - !! Output: Continuous states at t + Interval - TYPE(Orca_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t; - !! Output: Discrete states at t + Interval - TYPE(Orca_ConstraintStateType), INTENT(INOUT) :: z !< Input: Initial guess of constraint states at t+dt; - !! Output: Constraint states at t+dt - TYPE(Orca_OtherStateType), INTENT(INOUT) :: OtherState !< Other states: Other states at t; - !! Output: Other states at t + Interval - TYPE(Orca_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - -END SUBROUTINE Orca_UpdateStates -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - - -!********************************************************************************************************************************** -! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" -! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these -! lines should be modified in the Matlab script and/or Excel worksheet as necessary. -! This code was generated by Write_ChckOutLst.m at 01-Sep-2015 14:29:18. -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) -! This routine checks to see if any requested output channel names (stored in the OutList(:)) are invalid. It returns a -! warning if any of the channels are not available outputs from the module. -! It assigns the settings for OutParam(:) (i.e, the index, name, and units of the output channels, WriteOutput(:)). -! the sign is set to 0 if the channel is invalid. -! It sets assumes the value p%NumOuts has been set before this routine has been called, and it sets the values of p%OutParam here. -!.................................................................................................................................. - - IMPLICIT NONE - - ! Passed variables - - CHARACTER(ChanLen), INTENT(IN) :: OutList(:) ! The list out user-requested outputs - TYPE(Orca_ParameterType), INTENT(INOUT) :: p ! The module parameters - INTEGER(IntKi), INTENT(OUT) :: ErrStat ! The error status code - CHARACTER(*), INTENT(OUT) :: ErrMsg ! The error message, if an error occurred - - ! Local variables - - INTEGER :: ErrStat2 ! temporary (local) error status - INTEGER :: I ! Generic loop-counting index - INTEGER :: J ! Generic loop-counting index - INTEGER :: INDX ! Index for valid arrays - - LOGICAL :: CheckOutListAgain ! Flag used to determine if output parameter starting with "M" is valid (or the negative of another parameter) - LOGICAL :: InvalidOutput(0:MaxOutPts) ! This array determines if the output channel is valid for this configuration - CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I) - CHARACTER(*), PARAMETER :: RoutineName = "SetOutParam" - - CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(18) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically - "ORCAAMFXI","ORCAAMFYI","ORCAAMFZI", & - "ORCAAMMXI","ORCAAMMYI","ORCAAMMZI", & - "ORCAFXI ","ORCAFYI ","ORCAFZI ", & - "ORCAHMFXI","ORCAHMFYI","ORCAHMFZI", & - "ORCAHMMXI","ORCAHMMYI","ORCAHMMZI", & - "ORCAMXI ","ORCAMYI ","ORCAMZI "/) - INTEGER(IntKi), PARAMETER :: ParamIndxAry(18) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) - OrcaAMFxi , OrcaAMFyi , OrcaAMFzi , & - OrcaAMMxi , OrcaAMMyi , OrcaAMMzi , & - OrcaFxi , OrcaFyi , OrcaFzi , & - OrcaHMFxi , OrcaHMFyi , OrcaHMFzi , & - OrcaHMMxi , OrcaHMMyi , OrcaHMMzi , & - OrcaMxi , OrcaMyi , OrcaMzi /) - CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(18) = (/ & ! This lists the units corresponding to the allowed parameters - "(kN) ","(kN) ","(kN) ", & - "(kN m) ","(kN m) ","(kN m) ", & - "(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ", & - "(kN m) ","(kN m) ","(kN m) ", & - "(kN m) ","(kN m) ","(kN m) "/) - - - ! Initialize values - ErrStat = ErrID_None - ErrMsg = "" - InvalidOutput = .FALSE. - - -! ..... Developer must add checking for invalid inputs here: ..... - -! ................. End of validity checking ................. - - - !------------------------------------------------------------------------------------------------- - ! Allocate and set index, name, and units for the output channels - ! If a selected output channel is not available in this module, set error flag. - !------------------------------------------------------------------------------------------------- - - ALLOCATE ( p%OutParam(0:p%NumOuts) , STAT=ErrStat2 ) - IF ( ErrStat2 /= 0_IntKi ) THEN - CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the OrcaFlexInterface OutParam array.", ErrStat, ErrMsg, RoutineName ) - RETURN - ENDIF - - ! Set index, name, and units for the time output channel: - - p%OutParam(0)%Indx = Time - p%OutParam(0)%Name = "Time" ! OutParam(0) is the time channel by default. - p%OutParam(0)%Units = "(s)" - p%OutParam(0)%SignM = 1 - - - ! Set index, name, and units for all of the output channels. - ! If a selected output channel is not available by this module set ErrStat = ErrID_Warn. - - - DO I = 1,p%NumOuts - - p%OutParam(I)%Name = OutList(I) - OutListTmp = OutList(I) - - - ! Reverse the sign (+/-) of the output channel if the user prefixed the - ! channel name with a "-", "_", "m", or "M" character indicating "minus". - - - CheckOutListAgain = .FALSE. - - IF ( INDEX( "-_", OutListTmp(1:1) ) > 0 ) THEN - p%OutParam(I)%SignM = -1 ! ex, "-TipDxc1" causes the sign of TipDxc1 to be switched. - OutListTmp = OutListTmp(2:) - ELSE IF ( INDEX( "mM", OutListTmp(1:1) ) > 0 ) THEN ! We'll assume this is a variable name for now, (if not, we will check later if OutListTmp(2:) is also a variable name) - CheckOutListAgain = .TRUE. - p%OutParam(I)%SignM = 1 - ELSE - p%OutParam(I)%SignM = 1 - END IF - - CALL Conv2UC( OutListTmp ) ! Convert OutListTmp to upper case - - - Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) - - - ! If it started with an "M" (CheckOutListAgain) we didn't find the value in our list (Indx < 1) - - IF ( CheckOutListAgain .AND. Indx < 1 ) THEN ! Let's assume that "M" really meant "minus" and then test again - p%OutParam(I)%SignM = -1 ! ex, "MTipDxc1" causes the sign of TipDxc1 to be switched. - OutListTmp = OutListTmp(2:) - - Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) - END IF - - - IF ( Indx > 0 ) THEN ! we found the channel name - p%OutParam(I)%Indx = ParamIndxAry(Indx) - IF ( InvalidOutput( ParamIndxAry(Indx) ) ) THEN ! but, it isn't valid for these settings - p%OutParam(I)%Units = "INVALID" - p%OutParam(I)%SignM = 0 - ELSE - p%OutParam(I)%Units = ParamUnitsAry(Indx) ! it's a valid output - END IF - ELSE ! this channel isn't valid - p%OutParam(I)%Indx = Time ! pick any valid channel (I just picked "Time" here because it's universal) - p%OutParam(I)%Units = "INVALID" - p%OutParam(I)%SignM = 0 ! multiply all results by zero - - CALL SetErrStat(ErrID_Fatal, TRIM(p%OutParam(I)%Name)//" is not an available output channel.",ErrStat,ErrMsg,RoutineName) - END IF - - END DO - - RETURN -END SUBROUTINE SetOutParam -!---------------------------------------------------------------------------------------------------------------------------------- -!End of code generated by Matlab script -!********************************************************************************************************************************** - -SUBROUTINE SetAllOuts( ParamData, OutData, m, ErrStat, ErrMsg ) - - IMPLICIT NONE - - CHARACTER(*), PARAMETER :: RoutineName="SetAllOuts" - - - TYPE(Orca_ParameterType), INTENT(IN ) :: ParamData !< The parameters for Orca - TYPE(Orca_OutputType), INTENT(INOUT) :: OutData !< Outputs - TYPE(Orca_MiscVarType), INTENT(INOUT) :: m !< The MiscVars info for Orca - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status from this subroutine - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message from this subroutine - - - ! Local Variables - INTEGER(IntKi) :: I !< Generic counter - - - ! Initialization - ErrStat = ErrID_None - ErrMsg = '' - - - ! Set the values - m%AllOuts( OrcaFxi ) = OutData%PtfmMesh%Force(1,1)/1000_ReKi - m%AllOuts( OrcaFyi ) = OutData%PtfmMesh%Force(2,1)/1000_ReKi - m%AllOuts( OrcaFzi ) = OutData%PtfmMesh%Force(3,1)/1000_ReKi - m%AllOuts( OrcaMxi ) = OutData%PtfmMesh%Moment(1,1)/1000_ReKi - m%AllOuts( OrcaMyi ) = OutData%PtfmMesh%Moment(2,1)/1000_ReKi - m%AllOuts( OrcaMzi ) = OutData%PtfmMesh%Moment(3,1)/1000_ReKi - - m%AllOuts( OrcaHMFxi ) = m%PtfmFT(1)/1000_ReKi - m%AllOuts( OrcaHMFyi ) = m%PtfmFT(2)/1000_ReKi - m%AllOuts( OrcaHMFzi ) = m%PtfmFT(3)/1000_ReKi - m%AllOuts( OrcaHMMxi ) = m%PtfmFT(4)/1000_ReKi - m%AllOuts( OrcaHMMyi ) = m%PtfmFT(5)/1000_ReKi - m%AllOuts( OrcaHMMzi ) = m%PtfmFT(6)/1000_ReKi - - m%AllOuts( OrcaAMFxi ) = m%F_PtfmAM(1)/1000_ReKi - m%AllOuts( OrcaAMFyi ) = m%F_PtfmAM(2)/1000_ReKi - m%AllOuts( OrcaAMFzi ) = m%F_PtfmAM(3)/1000_ReKi - m%AllOuts( OrcaAMMxi ) = m%F_PtfmAM(4)/1000_ReKi - m%AllOuts( OrcaAMMyi ) = m%F_PtfmAM(5)/1000_ReKi - m%AllOuts( OrcaAMMzi ) = m%F_PtfmAM(6)/1000_ReKi - - ! Set the values for the WriteOutput array - OutData%WriteOutput( OrcaFxi ) = OutData%PtfmMesh%Force(1,1)/1000_ReKi - OutData%WriteOutput( OrcaFyi ) = OutData%PtfmMesh%Force(2,1)/1000_ReKi - OutData%WriteOutput( OrcaFzi ) = OutData%PtfmMesh%Force(3,1)/1000_ReKi - OutData%WriteOutput( OrcaMxi ) = OutData%PtfmMesh%Moment(1,1)/1000_ReKi - OutData%WriteOutput( OrcaMyi ) = OutData%PtfmMesh%Moment(2,1)/1000_ReKi - OutData%WriteOutput( OrcaMzi ) = OutData%PtfmMesh%Moment(3,1)/1000_ReKi - - OutData%WriteOutput( OrcaHMFxi ) = m%PtfmFT(1)/1000_ReKi - OutData%WriteOutput( OrcaHMFyi ) = m%PtfmFT(2)/1000_ReKi - OutData%WriteOutput( OrcaHMFzi ) = m%PtfmFT(3)/1000_ReKi - OutData%WriteOutput( OrcaHMMxi ) = m%PtfmFT(4)/1000_ReKi - OutData%WriteOutput( OrcaHMMyi ) = m%PtfmFT(5)/1000_ReKi - OutData%WriteOutput( OrcaHMMzi ) = m%PtfmFT(6)/1000_ReKi - - OutData%WriteOutput( OrcaAMFxi ) = m%F_PtfmAM(1)/1000_ReKi - OutData%WriteOutput( OrcaAMFyi ) = m%F_PtfmAM(2)/1000_ReKi - OutData%WriteOutput( OrcaAMFzi ) = m%F_PtfmAM(3)/1000_ReKi - OutData%WriteOutput( OrcaAMMxi ) = m%F_PtfmAM(4)/1000_ReKi - OutData%WriteOutput( OrcaAMMyi ) = m%F_PtfmAM(5)/1000_ReKi - OutData%WriteOutput( OrcaAMMzi ) = m%F_PtfmAM(6)/1000_ReKi - - -END SUBROUTINE SetAllOuts - - - - -END MODULE OrcaFlexInterface -!********************************************************************************************************************************** diff --git a/OpenFAST/modules/orcaflex-interface/src/OrcaFlexInterface.txt b/OpenFAST/modules/orcaflex-interface/src/OrcaFlexInterface.txt deleted file mode 100644 index da75c894e..000000000 --- a/OpenFAST/modules/orcaflex-interface/src/OrcaFlexInterface.txt +++ /dev/null @@ -1,75 +0,0 @@ -################################################################################################################################### -# Registry for OrcaFlexInterface in the FAST Modularization Framework -# This Registry file is used to create MODULE OrcaFlexInterface_Types which contains all of the user-defined types needed in OrcaFlexInterface. -# 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 - -# ..... Initialization data ....................................................................................................... -# Define inputs that the initialization routine may need here: -typedef OrcaFlexInterface/Orca InitInputType CHARACTER(1024) InputFile - - - "Name of the input file; remove if there is no file" - -typedef ^ ^ CHARACTER(1024) RootName - - - "RootName for writing output files (echo file)" - -typedef ^ ^ ReKi TMax - - - "Maximum Time" seconds - -# Define outputs from the initialization routine here: -typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - -typedef ^ ^ CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - -typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - - - -# Inputfile information -typedef ^ Orca_InputFile CHARACTER(1024) DLL_FileName - - - "Name of the DLL file" - -typedef ^ ^ CHARACTER(1024) DLL_InitProcName - - - "Name of the DLL procedure to call during initialisation" - -typedef ^ ^ CHARACTER(1024) DLL_CalcProcName - - - "Name of the DLL procedure to call during CalcOutput" - -typedef ^ ^ CHARACTER(1024) DLL_EndProcName - - - "Name of the DLL procedure to call during End" - -typedef ^ ^ CHARACTER(1024) DirRoot - - - "Directory and rootname of simulation input file" - - - - - - -# Define "other" states here: -# note that some of the "miscVars" are associated with time, but due to the nature of calling the DLL only once per time step, I have -# chosen not to place them in other states -typedef ^ OtherStateType SiKi DummyOtherState - - - "Remove if you have OtherStates" - - - -# ..... Misc/Optimization variables................................................................................................. -# 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 ReKi PtfmAM {6}{6} - - "Added mass matrix results from OrcaFlex" - -typedef ^ ^ ReKi PtfmFt {6} - - "Force/moment results from OrcaFlex" - -typedef ^ ^ ReKi F_PtfmAM {6} - - "Force/moment results calculated from the added mass and accel" - -typedef ^ ^ ReKi AllOuts : - - "An array holding the value of all of the calculated (not only selected) output channels" "see OutListParameters.xlsx spreadsheet" -typedef ^ ^ DbKi LastTimeStep - - - "The last timestep called" - - - -# Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: -typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds -typedef ^ ^ DLL_Type DLL_Orca - - - "Info for the OrcaFlex DLL" - -typedef ^ ^ CHARACTER(1024) SimNamePath - - - "Path with simulation rootname with null end character for passing to C" - -typedef ^ ^ IntKi SimNamePathLen - - - "Length of SimNamePath (including null char)" - -typedef ^ ^ IntKi NumOuts - 0 - "Number of parameters in the output list (number of outputs requested)" - -typedef ^ ^ OutParmType OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - - -# ..... Inputs .................................................................................................................... -# Define inputs that are contained on the mesh here: -typedef ^ InputType MeshType PtfmMesh - - - "Displacements at the platform reference point" - - -# ..... Outputs ................................................................................................................... -# Define outputs that are contained on the mesh here: -typedef ^ OutputType MeshType PtfmMesh - - - "Loads at the platform reference point" - -typedef ^ OutputType ReKi WriteOutput : - - "Array with values to output to file" - - - - -typedef ^ ContinuousStateType ReKi Dummy - - - "Dummy placeholder" - -typedef ^ DiscreteStateType ReKi Dummy - - - "Dummy placeholder" - -typedef ^ ConstraintStateType ReKi DummyConstrState - - - "Dummy placeholder" - diff --git a/OpenFAST/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/OpenFAST/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 deleted file mode 100644 index 51a40873d..000000000 --- a/OpenFAST/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ /dev/null @@ -1,2655 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'OrcaFlexInterface_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 -!********************************************************************************************************************************* -! OrcaFlexInterface_Types -!................................................................................................................................. -! This file is part of OrcaFlexInterface. -! -! 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 OrcaFlexInterface. 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 OrcaFlexInterface_Types -!--------------------------------------------------------------------------------------------------------------------------------- -USE NWTC_Library -IMPLICIT NONE -! ========= Orca_InitInputType ======= - TYPE, PUBLIC :: Orca_InitInputType - CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] - CHARACTER(1024) :: RootName !< RootName for writing output files (echo file) [-] - REAL(ReKi) :: TMax !< Maximum Time [seconds] - END TYPE Orca_InitInputType -! ======================= -! ========= Orca_InitOutputType ======= - TYPE, PUBLIC :: Orca_InitOutputType - TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] - END TYPE Orca_InitOutputType -! ======================= -! ========= Orca_InputFile ======= - TYPE, PUBLIC :: Orca_InputFile - CHARACTER(1024) :: DLL_FileName !< Name of the DLL file [-] - CHARACTER(1024) :: DLL_InitProcName !< Name of the DLL procedure to call during initialisation [-] - CHARACTER(1024) :: DLL_CalcProcName !< Name of the DLL procedure to call during CalcOutput [-] - CHARACTER(1024) :: DLL_EndProcName !< Name of the DLL procedure to call during End [-] - CHARACTER(1024) :: DirRoot !< Directory and rootname of simulation input file [-] - END TYPE Orca_InputFile -! ======================= -! ========= Orca_OtherStateType ======= - TYPE, PUBLIC :: Orca_OtherStateType - REAL(SiKi) :: DummyOtherState !< Remove if you have OtherStates [-] - END TYPE Orca_OtherStateType -! ======================= -! ========= Orca_MiscVarType ======= - TYPE, PUBLIC :: Orca_MiscVarType - REAL(ReKi) , DIMENSION(1:6,1:6) :: PtfmAM !< Added mass matrix results from OrcaFlex [-] - REAL(ReKi) , DIMENSION(1:6) :: PtfmFt !< Force/moment results from OrcaFlex [-] - REAL(ReKi) , DIMENSION(1:6) :: F_PtfmAM !< Force/moment results calculated from the added mass and accel [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [see OutListParameters.xlsx spreadsheet] - REAL(DbKi) :: LastTimeStep !< The last timestep called [-] - END TYPE Orca_MiscVarType -! ======================= -! ========= Orca_ParameterType ======= - TYPE, PUBLIC :: Orca_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - TYPE(DLL_Type) :: DLL_Orca !< Info for the OrcaFlex DLL [-] - CHARACTER(1024) :: SimNamePath !< Path with simulation rootname with null end character for passing to C [-] - INTEGER(IntKi) :: SimNamePathLen !< Length of SimNamePath (including null char) [-] - INTEGER(IntKi) :: NumOuts = 0 !< Number of parameters in the output list (number of outputs requested) [-] - TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] - END TYPE Orca_ParameterType -! ======================= -! ========= Orca_InputType ======= - TYPE, PUBLIC :: Orca_InputType - TYPE(MeshType) :: PtfmMesh !< Displacements at the platform reference point [-] - END TYPE Orca_InputType -! ======================= -! ========= Orca_OutputType ======= - TYPE, PUBLIC :: Orca_OutputType - TYPE(MeshType) :: PtfmMesh !< Loads at the platform reference point [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Array with values to output to file [-] - END TYPE Orca_OutputType -! ======================= -! ========= Orca_ContinuousStateType ======= - TYPE, PUBLIC :: Orca_ContinuousStateType - REAL(ReKi) :: Dummy !< Dummy placeholder [-] - END TYPE Orca_ContinuousStateType -! ======================= -! ========= Orca_DiscreteStateType ======= - TYPE, PUBLIC :: Orca_DiscreteStateType - REAL(ReKi) :: Dummy !< Dummy placeholder [-] - END TYPE Orca_DiscreteStateType -! ======================= -! ========= Orca_ConstraintStateType ======= - TYPE, PUBLIC :: Orca_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Dummy placeholder [-] - END TYPE Orca_ConstraintStateType -! ======================= -CONTAINS - SUBROUTINE Orca_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(Orca_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%TMax = SrcInitInputData%TMax - END SUBROUTINE Orca_CopyInitInput - - SUBROUTINE Orca_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(Orca_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyInitInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE Orca_DestroyInitInput - - SUBROUTINE Orca_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + 1 ! TMax - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%TMax - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_PackInitInput - - SUBROUTINE Orca_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TMax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_UnPackInitInput - - SUBROUTINE Orca_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(Orca_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - END SUBROUTINE Orca_CopyInitOutput - - SUBROUTINE Orca_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(Orca_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyInitOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, ErrMsg ) -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - END SUBROUTINE Orca_DestroyInitOutput - - SUBROUTINE Orca_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE Orca_PackInitOutput - - SUBROUTINE Orca_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE Orca_UnPackInitOutput - - SUBROUTINE Orca_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(Orca_InputFile), INTENT(INOUT) :: DstInputFileData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%DLL_FileName = SrcInputFileData%DLL_FileName - DstInputFileData%DLL_InitProcName = SrcInputFileData%DLL_InitProcName - DstInputFileData%DLL_CalcProcName = SrcInputFileData%DLL_CalcProcName - DstInputFileData%DLL_EndProcName = SrcInputFileData%DLL_EndProcName - DstInputFileData%DirRoot = SrcInputFileData%DirRoot - END SUBROUTINE Orca_CopyInputFile - - SUBROUTINE Orca_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(Orca_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyInputFile' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE Orca_DestroyInputFile - - SUBROUTINE Orca_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_InputFile), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackInputFile' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_FileName) ! DLL_FileName - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_InitProcName) ! DLL_InitProcName - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_CalcProcName) ! DLL_CalcProcName - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_EndProcName) ! DLL_EndProcName - Int_BufSz = Int_BufSz + 1*LEN(InData%DirRoot) ! DirRoot - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%DLL_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_InitProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InitProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_CalcProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_CalcProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_EndProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_EndProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DirRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE Orca_PackInputFile - - SUBROUTINE Orca_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_InputFile), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackInputFile' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%DLL_FileName) - OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_InitProcName) - OutData%DLL_InitProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_CalcProcName) - OutData%DLL_CalcProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_EndProcName) - OutData%DLL_EndProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DirRoot) - OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE Orca_UnPackInputFile - - SUBROUTINE Orca_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(Orca_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE Orca_CopyOtherState - - SUBROUTINE Orca_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(Orca_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyOtherState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE Orca_DestroyOtherState - - SUBROUTINE Orca_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyOtherState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_PackOtherState - - SUBROUTINE Orca_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyOtherState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_UnPackOtherState - - SUBROUTINE Orca_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(Orca_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%PtfmAM = SrcMiscData%PtfmAM - DstMiscData%PtfmFt = SrcMiscData%PtfmFt - DstMiscData%F_PtfmAM = SrcMiscData%F_PtfmAM -IF (ALLOCATED(SrcMiscData%AllOuts)) THEN - i1_l = LBOUND(SrcMiscData%AllOuts,1) - i1_u = UBOUND(SrcMiscData%AllOuts,1) - IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN - ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AllOuts = SrcMiscData%AllOuts -ENDIF - DstMiscData%LastTimeStep = SrcMiscData%LastTimeStep - END SUBROUTINE Orca_CopyMisc - - SUBROUTINE Orca_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(Orca_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyMisc' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF - END SUBROUTINE Orca_DestroyMisc - - SUBROUTINE Orca_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + SIZE(InData%PtfmAM) ! PtfmAM - Re_BufSz = Re_BufSz + SIZE(InData%PtfmFt) ! PtfmFt - Re_BufSz = Re_BufSz + SIZE(InData%F_PtfmAM) ! F_PtfmAM - Int_BufSz = Int_BufSz + 1 ! AllOuts allocated yes/no - IF ( ALLOCATED(InData%AllOuts) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts - END IF - Db_BufSz = Db_BufSz + 1 ! LastTimeStep - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i2 = LBOUND(InData%PtfmAM,2), UBOUND(InData%PtfmAM,2) - DO i1 = LBOUND(InData%PtfmAM,1), UBOUND(InData%PtfmAM,1) - ReKiBuf(Re_Xferred) = InData%PtfmAM(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%PtfmFt,1), UBOUND(InData%PtfmFt,1) - ReKiBuf(Re_Xferred) = InData%PtfmFt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%F_PtfmAM,1), UBOUND(InData%F_PtfmAM,1) - ReKiBuf(Re_Xferred) = InData%F_PtfmAM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%AllOuts) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOuts,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) - ReKiBuf(Re_Xferred) = InData%AllOuts(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%LastTimeStep - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE Orca_PackMisc - - SUBROUTINE Orca_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%PtfmAM,1) - i1_u = UBOUND(OutData%PtfmAM,1) - i2_l = LBOUND(OutData%PtfmAM,2) - i2_u = UBOUND(OutData%PtfmAM,2) - DO i2 = LBOUND(OutData%PtfmAM,2), UBOUND(OutData%PtfmAM,2) - DO i1 = LBOUND(OutData%PtfmAM,1), UBOUND(OutData%PtfmAM,1) - OutData%PtfmAM(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%PtfmFt,1) - i1_u = UBOUND(OutData%PtfmFt,1) - DO i1 = LBOUND(OutData%PtfmFt,1), UBOUND(OutData%PtfmFt,1) - OutData%PtfmFt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%F_PtfmAM,1) - i1_u = UBOUND(OutData%F_PtfmAM,1) - DO i1 = LBOUND(OutData%F_PtfmAM,1), UBOUND(OutData%F_PtfmAM,1) - OutData%F_PtfmAM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AllOuts)) DEALLOCATE(OutData%AllOuts) - ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) - OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%LastTimeStep = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE Orca_UnPackMisc - - SUBROUTINE Orca_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Orca_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%DLL_Orca = SrcParamData%DLL_Orca - DstParamData%SimNamePath = SrcParamData%SimNamePath - DstParamData%SimNamePathLen = SrcParamData%SimNamePathLen - DstParamData%NumOuts = SrcParamData%NumOuts -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,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 - ENDDO -ENDIF - END SUBROUTINE Orca_CopyParam - - SUBROUTINE Orca_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(Orca_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyParam' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - CALL FreeDynamicLib( ParamData%DLL_Orca, ErrStat, ErrMsg ) -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF - END SUBROUTINE Orca_DestroyParam - - SUBROUTINE Orca_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DLL_Orca: size of buffers for each call to pack subtype - CALL DLLTypePack( InData%DLL_Orca, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! DLL_Orca - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DLL_Orca - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DLL_Orca - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DLL_Orca - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%SimNamePath) ! SimNamePath - Int_BufSz = Int_BufSz + 1 ! SimNamePathLen - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - CALL DLLTypePack( InData%DLL_Orca, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! DLL_Orca - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DO I = 1, LEN(InData%SimNamePath) - IntKiBuf(Int_Xferred) = ICHAR(InData%SimNamePath(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%SimNamePathLen - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE Orca_PackParam - - SUBROUTINE Orca_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DLLTypeUnpack( OutData%DLL_Orca, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! DLL_Orca - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - DO I = 1, LEN(OutData%SimNamePath) - OutData%SimNamePath(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SimNamePathLen = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE Orca_UnPackParam - - SUBROUTINE Orca_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_InputType), INTENT(INOUT) :: SrcInputData - TYPE(Orca_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%PtfmMesh, DstInputData%PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE Orca_CopyInput - - SUBROUTINE Orca_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(Orca_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshDestroy( InputData%PtfmMesh, ErrStat, ErrMsg ) - END SUBROUTINE Orca_DestroyInput - - SUBROUTINE Orca_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PtfmMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtfmMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtfmMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtfmMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE Orca_PackInput - - SUBROUTINE Orca_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE Orca_UnPackInput - - SUBROUTINE Orca_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(Orca_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%PtfmMesh, DstOutputData%PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - END SUBROUTINE Orca_CopyOutput - - SUBROUTINE Orca_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(Orca_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshDestroy( OutputData%PtfmMesh, ErrStat, ErrMsg ) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE Orca_DestroyOutput - - SUBROUTINE Orca_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PtfmMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtfmMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtfmMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtfmMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Orca_PackOutput - - SUBROUTINE Orca_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Orca_UnPackOutput - - SUBROUTINE Orca_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(Orca_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%Dummy = SrcContStateData%Dummy - END SUBROUTINE Orca_CopyContState - - SUBROUTINE Orca_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(Orca_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyContState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE Orca_DestroyContState - - SUBROUTINE Orca_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! Dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_PackContState - - SUBROUTINE Orca_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Dummy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_UnPackContState - - SUBROUTINE Orca_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(Orca_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%Dummy = SrcDiscStateData%Dummy - END SUBROUTINE Orca_CopyDiscState - - SUBROUTINE Orca_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(Orca_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyDiscState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE Orca_DestroyDiscState - - SUBROUTINE Orca_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! Dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_PackDiscState - - SUBROUTINE Orca_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Dummy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_UnPackDiscState - - SUBROUTINE Orca_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(Orca_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE Orca_CopyConstrState - - SUBROUTINE Orca_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(Orca_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyConstrState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE Orca_DestroyConstrState - - SUBROUTINE Orca_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_PackConstrState - - SUBROUTINE Orca_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_UnPackConstrState - - - SUBROUTINE Orca_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(Orca_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(Orca_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL Orca_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Orca_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL Orca_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE Orca_Input_ExtrapInterp - - - SUBROUTINE Orca_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = u1, f(t2) = u2 -! -!.................................................................................................................................. - - TYPE(Orca_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(Orca_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(Orca_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(u1%PtfmMesh, u2%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE Orca_Input_ExtrapInterp1 - - - SUBROUTINE Orca_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 -! -!.................................................................................................................................. - - TYPE(Orca_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(Orca_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(Orca_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(Orca_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Input_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(u1%PtfmMesh, u2%PtfmMesh, u3%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE Orca_Input_ExtrapInterp2 - - - SUBROUTINE Orca_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(Orca_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(Orca_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL Orca_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Orca_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL Orca_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE Orca_Output_ExtrapInterp - - - SUBROUTINE Orca_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = y1, f(t2) = y2 -! -!.................................................................................................................................. - - TYPE(Orca_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(Orca_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(Orca_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(y1%PtfmMesh, y2%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE Orca_Output_ExtrapInterp1 - - - SUBROUTINE Orca_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 -! -!.................................................................................................................................. - - TYPE(Orca_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(Orca_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(Orca_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(Orca_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(y1%PtfmMesh, y2%PtfmMesh, y3%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE Orca_Output_ExtrapInterp2 - -END MODULE OrcaFlexInterface_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/OpenFAST/modules/servodyn/CMakeLists.txt b/OpenFAST/modules/servodyn/CMakeLists.txt deleted file mode 100644 index 5dd7f191d..000000000 --- a/OpenFAST/modules/servodyn/CMakeLists.txt +++ /dev/null @@ -1,48 +0,0 @@ -# -# Copyright 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. -# - -if (GENERATE_TYPES) - generate_f90_types(src/StrucCtrl_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/StrucCtrl_Types.f90) - generate_f90_types(src/ServoDyn_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/ServoDyn_Types.f90) -endif() - -set(SrvD_SOURCES - src/BladedInterface.f90 - src/UserSubs.f90 - src/PitchCntrl_ACH.f90 - src/StrucCtrl.f90 - src/UserVSCont_KP.f90 - src/ServoDyn.f90 - src/ServoDyn_IO.f90 - src/StrucCtrl_Types.f90 - src/ServoDyn_Types.f90 -) - -add_library(servodynlib ${SrvD_SOURCES}) -target_link_libraries(servodynlib nwtclibs) - -add_executable(servodyn_driver src/ServoDyn_Driver.f90) -target_link_libraries(servodyn_driver servodynlib nwtclibs ${CMAKE_DL_LIBS}) - -# The Structural Control driver is currently not functional, so commenting this temporarily -# add_executable(strucctrl_driver src/StrucCtrl_Driver.f90) -# target_link_libraries(strucctrl_driver servodynlib nwtclibs ${CMAKE_DL_LIBS}) - -install(TARGETS servodynlib servodyn_driver # strucctrl_driver - EXPORT "${CMAKE_PROJECT_NAME}Libraries" - RUNTIME DESTINATION bin - LIBRARY DESTINATION lib - ARCHIVE DESTINATION lib) diff --git a/OpenFAST/modules/servodyn/README.md b/OpenFAST/modules/servodyn/README.md deleted file mode 100644 index e1d650508..000000000 --- a/OpenFAST/modules/servodyn/README.md +++ /dev/null @@ -1,16 +0,0 @@ -# ServoDyn Module -The legacy version of TMD and additional documentation are available -at the [NWTC Software Portal](https://nwtc.nrel.gov/TMD/). - -## Overview -ServoDyn is the control and Electrical Drive Dynamics Module for the -OpenFAST framework. - -Included in ServoDyn is the tuned mass damper (TMD) module which adds -functionality to OpenFAST that simulates the addition of TMDs in the -nacelle and/or tower for structural control. The TMDs are two independent, -one-DOF, linear mass-spring-damping elements that act in the fore-aft and -side-side directions or one single omni-directional TMD. They can be placed -relative to the nacelle reference position or base of the undeflected tower -using the options in the input file. The TMD module is added as a sub-module -of ServoDyn. diff --git a/OpenFAST/modules/servodyn/src/BladedInterface.f90 b/OpenFAST/modules/servodyn/src/BladedInterface.f90 deleted file mode 100644 index a27aa0fbc..000000000 --- a/OpenFAST/modules/servodyn/src/BladedInterface.f90 +++ /dev/null @@ -1,1135 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2013-2016 National Renewable Energy Laboratory -! -! This file is part of FAST's Controls and Electrical Drive Module, "ServoDyn". -! -! 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. -! -!********************************************************************************************************************************** -MODULE BladedInterface - - USE NWTC_Library - - USE ServoDyn_Types - - USE, INTRINSIC :: ISO_C_Binding - - - IMPLICIT NONE - - - TYPE(ProgDesc), PARAMETER :: BladedInterface_Ver = ProgDesc( 'ServoDyn Interface for Bladed Controllers', 'using '//TRIM(OS_Desc), '' ) - - - !> Definition of the DLL Interface (from Bladed): - !! Note that aviFAIL and avcMSG should be used as INTENT(OUT), but I'm defining them INTENT(INOUT) just in case the compiler decides to reinitialize something that's INTENT(OUT) - - ABSTRACT INTERFACE - SUBROUTINE BladedDLL_Legacy_Procedure ( avrSWAP, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) BIND(C) - USE, INTRINSIC :: ISO_C_Binding - - REAL(C_FLOAT), INTENT(INOUT) :: avrSWAP (*) !< DATA - INTEGER(C_INT), INTENT(INOUT) :: aviFAIL !< FLAG (Status set in DLL and returned to simulation code) - CHARACTER(KIND=C_CHAR), INTENT(IN) :: accINFILE (*) !< INFILE - CHARACTER(KIND=C_CHAR), INTENT(INOUT) :: avcOUTNAME(*) !< OUTNAME (in:Simulation RootName; out:Name:Units; of logging channels) - CHARACTER(KIND=C_CHAR), INTENT(INOUT) :: avcMSG (*) !< MESSAGE (Message from DLL to simulation code [ErrMsg]) - END SUBROUTINE BladedDLL_Legacy_Procedure - - SUBROUTINE BladedDLL_SC_Procedure ( avrSWAP, from_SCglob, from_SC, to_SC, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) BIND(C) - USE, INTRINSIC :: ISO_C_Binding - - REAL(C_FLOAT), INTENT(INOUT) :: avrSWAP (*) !< DATA - REAL(C_FLOAT), INTENT(IN ) :: from_SCglob (*) !< DATA (global) from the supercontroller - REAL(C_FLOAT), INTENT(IN ) :: from_SC (*) !< DATA (turbine specific) from the supercontroller - REAL(C_FLOAT), INTENT(INOUT) :: to_SC (*) !< DATA to the supercontroller - INTEGER(C_INT), INTENT(INOUT) :: aviFAIL !< FLAG (Status set in DLL and returned to simulation code) - CHARACTER(KIND=C_CHAR), INTENT(IN) :: accINFILE (*) !< INFILE - CHARACTER(KIND=C_CHAR), INTENT(INOUT) :: avcOUTNAME(*) !< OUTNAME (Simulation RootName) - CHARACTER(KIND=C_CHAR), INTENT(INOUT) :: avcMSG (*) !< MESSAGE (Message from DLL to simulation code [ErrMsg]) - END SUBROUTINE BladedDLL_SC_Procedure - - FUNCTION BladedDLL_CONTROLLER_Procedure ( turbine_id ) BIND (C) ! from Bladed 4.8 API - USE, INTRINSIC :: ISO_C_Binding - -! INTEGER(C_SIZE_T), VALUE, INTENT(IN ) :: turbine_id ! pointer (address) of data from Bladed or ENFAST that is required to be used in ExternalControllerApi.dll (as written in Bladed's API) - TYPE(C_PTR), VALUE, INTENT(IN ) :: turbine_id ! pointer (address) of data from Bladed or ENFAST that is required to be used in ExternalControllerApi.dll (using standard Fortran nomenclature for ISO C BINDING) - INTEGER(C_INT) :: BladedDLL_CONTROLLER_Procedure ! an integer determining the status of the call (see aviFAIL) - - END FUNCTION BladedDLL_CONTROLLER_Procedure - - END INTERFACE - - -#ifdef STATIC_DLL_LOAD - INTERFACE - -#ifdef LOAD_SUPERCONTROLLER - SUBROUTINE DISCON ( avrSWAP, from_SCglob, from_SC, to_SC, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) BIND(C, NAME='DISCON') -#else - SUBROUTINE DISCON ( avrSWAP, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) BIND(C, NAME='DISCON') -#endif - - USE, INTRINSIC :: ISO_C_Binding - - REAL(C_FLOAT), INTENT(INOUT) :: avrSWAP (*) ! DATA -#ifdef LOAD_SUPERCONTROLLER - REAL(C_FLOAT), INTENT(IN ) :: from_SCglob (*) ! DATA (global) from the supercontroller - REAL(C_FLOAT), INTENT(IN ) :: from_SC (*) ! DATA (turbine specific) from the supercontroller - REAL(C_FLOAT), INTENT(INOUT) :: to_SC (*) ! DATA to the supercontroller -#endif - INTEGER(C_INT), INTENT(INOUT) :: aviFAIL ! FLAG (Status set in DLL and returned to simulation code) - CHARACTER(KIND=C_CHAR), INTENT(IN) :: accINFILE (*) ! INFILE - CHARACTER(KIND=C_CHAR), INTENT(IN) :: avcOUTNAME(*) ! OUTNAME (Simulation RootName) - CHARACTER(KIND=C_CHAR), INTENT(INOUT) :: avcMSG (*) ! MESSAGE (Message from DLL to simulation code [ErrMsg]) - END SUBROUTINE DISCON - END INTERFACE -#endif - - - ! Some constants for the Interface: - - INTEGER(IntKi), PARAMETER :: R_v36 = 85 !< Start of below-rated torque-speed look-up table (record no.) for Bladed version 3.6 - INTEGER(IntKi), PARAMETER :: R_v4 = 145 !< Start of below-rated torque-speed look-up table (record no.) for Bladed version 3.8 - 4.2 - INTEGER(IntKi), PARAMETER :: R_v43 = 165 !< Start of below-rated torque-speed look-up table (record no.) for Bladed version 4.3 and later - - INTEGER(IntKi), PARAMETER :: R = R_v43 !< start of the generator speed look-up table -#ifdef STATIC_DLL_LOAD - INTEGER(IntKi), PARAMETER :: MaxLoggingChannels = 0 -#else - INTEGER(IntKi), PARAMETER :: MaxLoggingChannels = 300 -#endif - - !! GH_DISCON_SIMULATION_STATUS - Flag returned by simulation from GetSimulationStatus. Descriptions taken from the user manual. - INTEGER(IntKi), PARAMETER :: GH_DISCON_STATUS_FINALISING = -1 ! Final call at the end of the simulation. - INTEGER(IntKi), PARAMETER :: GH_DISCON_STATUS_INITIALISING = 0 ! First call at time zero. - INTEGER(IntKi), PARAMETER :: GH_DISCON_STATUS_DISCRETE_STEP = 1 ! Simulation discrete timestep. - INTEGER(IntKi), PARAMETER :: GH_DISCON_STATUS_CHECKPOINT = -8 ! Create a checkpoint file (extension to GH DISCON documentation) - INTEGER(IntKi), PARAMETER :: GH_DISCON_STATUS_RESTARTING = -9 ! Restart step (extension to GH DISCON documentation) - !! GH_DISCON_PITCH_CONTROL - Flag to specify whether the pitch is controlled collectively or individually. - INTEGER(IntKi), PARAMETER :: GH_DISCON_PITCH_CONTROL_COLLECTIVE = 0 ! Pitch is controlled collectively - use GetCollectivePitchAngle and SetDemandedCollectivePitchAngle. - INTEGER(IntKi), PARAMETER :: GH_DISCON_PITCH_CONTROL_INDIVIDUAL = 1 ! Pitch is controlled on each blade individually - use GetPitchAngle and SetDemandedPitchAngle. - !! GH_DISCON_YAW_CONTROL - Flag to represent whether the yaw is controlled by rate or torque. - INTEGER(IntKi), PARAMETER :: GH_DISCON_YAW_CONTROL_RATE = 0 ! Uses the yaw rate demand to control yaw. - INTEGER(IntKi), PARAMETER :: GH_DISCON_YAW_CONTROL_TORQUE = 1 ! Uses the yaw torque demand to control yaw. - -CONTAINS -!================================================================================================================================== -!> This SUBROUTINE is used to call the Bladed-style DLL. -SUBROUTINE CallBladedDLL ( u, p, dll_data, ErrStat, ErrMsg, ChannelNameUnit ) - - TYPE(SrvD_InputType), INTENT(IN ) :: u ! System inputs - TYPE(SrvD_ParameterType), INTENT(IN ) :: p ! Parameters - TYPE(BladedDLLType), TARGET, INTENT(INOUT) :: dll_data ! data type containing the inputs for the Bladed DLL interface - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - CHARACTER(*), OPTIONAL, INTENT( OUT) :: ChannelNameUnit ! OUTNAME (Simulation RootName) - - PROCEDURE(BladedDLL_CONTROLLER_Procedure), POINTER :: DLL_CONTROLLER ! The address of the CONTROLLER or CONTROLLER_INIT procedure in the Bladed DLL - INTEGER :: ProcedureIndex - INTEGER(C_INT) :: aviFAIL ! status returned from Bladed controller - TYPE(C_PTR) :: turbine_id - TYPE(BladedDLLType), POINTER :: dll_data_PTR ! pointer to data type containing the inputs for the Bladed DLL interface - - - if (p%UseLegacyInterface) then - if (present(ChannelNameUnit)) then - call CallBladedLegacyDLL ( u, u%fromSCglob, u%fromSC, p, dll_data, ErrStat, ErrMsg, ChannelNameUnit ) - else - call CallBladedLegacyDLL ( u, u%fromSCglob, u%fromSC, p, dll_data, ErrStat, ErrMsg ) - end if - else - - if ( dll_data%SimStatus == GH_DISCON_STATUS_INITIALISING ) then - ProcedureIndex = 2 ! initialization call to CONTROLLER or CONTROLLER_INIT - else - ProcedureIndex = 1 ! normal call to CONTROLLER - end if - - CALL C_F_PROCPOINTER( p%DLL_Trgt%ProcAddr(ProcedureIndex), DLL_CONTROLLER) - dll_data_PTR => dll_data - turbine_id = C_LOC(dll_data_PTR) - - aviFAIL = DLL_CONTROLLER ( turbine_id ) - - ! these values are set in the controller: - ErrStat = dll_data%ErrStat - ErrMsg = dll_data%ErrMsg - - ! but we must also check the return value from the controller function (i'd think they would be the same) - IF ( aviFAIL /= 0 ) THEN - - IF ( aviFAIL > 0 ) THEN ! warning - ErrStat = max(ErrStat,ErrID_Info) - ELSE ! error - ErrStat = ErrID_Fatal - END IF - - END IF - - IF (ErrStat /= ErrID_None) THEN - ErrMsg = trim(p%DLL_Trgt%ProcName(ProcedureIndex))//trim(ErrMsg) - END IF - - end if - - if ( dll_data%SimStatus == GH_DISCON_STATUS_FINALISING ) then - dll_data%SimStatus = GH_DISCON_STATUS_INITIALISING - else - dll_data%SimStatus = GH_DISCON_STATUS_DISCRETE_STEP - end if - -END SUBROUTINE CallBladedDLL -!================================================================================================================================== -SUBROUTINE CallBladedLegacyDLL ( u, filt_fromSCglob, filt_fromSC, p, dll_data, ErrStat, ErrMsg, ChannelNameUnit ) - ! Passed Variables: - TYPE(SrvD_InputType), INTENT(IN ) :: u ! System inputs - TYPE(SrvD_ParameterType), INTENT(IN ) :: p ! Parameters - REAL(SiKi), INTENT(IN ) :: filt_fromSCglob (*) ! Filtered global input from Supercontroller to ServoDyn - REAL(SiKi), INTENT(IN ) :: filt_fromSC (*) ! Filtered turbine specific input from Supercontroller to ServoDyn - TYPE(BladedDLLType), INTENT(INOUT) :: dll_data ! data type containing the avrSWAP, accINFILE, and avcOUTNAME arrays - !REAL(SiKi), INTENT(INOUT) :: avrSWAP (*) ! The swap array, used to pass data to, and receive data from, the DLL controller. - !INTEGER(B1Ki), INTENT(IN ) :: accINFILE (*) ! The address of the first record of an array of 1-byte CHARACTERs giving the name of the parameter input file, 'DISCON.IN'. - !INTEGER(B1Ki), INTENT(INOUT) :: avcOUTNAME(*) ! The address of the first record of an array of 1-byte CHARACTERS giving the simulation run name without extension. - - - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - CHARACTER(*), OPTIONAL, INTENT( OUT) :: ChannelNameUnit ! OUTNAME (Simulation RootName) - - ! Local Variables: - - INTEGER(C_INT) :: aviFAIL ! A flag used to indicate the success of this DLL call set as follows: 0 if the DLL call was successful, >0 if the DLL call was successful but cMessage should be issued as a warning messsage, <0 if the DLL call was unsuccessful or for any other reason the simulation is to be stopped at this point with cMessage as the error message. - CHARACTER(KIND=C_CHAR) :: accINFILE(LEN_TRIM(dll_data%DLL_InFile)+1) ! INFILE - CHARACTER(KIND=C_CHAR) :: avcOUTNAME(p%avcOUTNAME_LEN) ! OUTNAME (in: Simulation RootName; out: string for logging channels Name:Units;) - CHARACTER(KIND=C_CHAR) :: avcMSG(LEN(ErrMsg)+1) ! MESSAGE (Message from DLL to simulation code [ErrMsg]) - - PROCEDURE(BladedDLL_Legacy_Procedure), POINTER :: DLL_Legacy_Subroutine ! The address of the (legacy DISCON) procedure in the Bladed DLL - PROCEDURE(BladedDLL_SC_Procedure), POINTER :: DLL_SC_Subroutine ! The address of the supercontroller procedure in the Bladed DLL - - ! initialize aviFAIL - aviFAIL = 0 ! bjj, this won't necessarially work if aviFAIL is INTENT(OUT) in DLL_Procedure()--could be undefined??? - - !Convert to C-type characters: the "C_NULL_CHAR" converts the Fortran string to a C-type string (i.e., adds //CHAR(0) to the end) - - avcOUTNAME = TRANSFER( TRIM(dll_data%RootName)//C_NULL_CHAR, avcOUTNAME ) - accINFILE = TRANSFER( TRIM(dll_data%DLL_InFile)//C_NULL_CHAR, accINFILE ) - avcMSG = TRANSFER( C_NULL_CHAR, avcMSG ) !bjj this is intent(out), so we shouldn't have to do this, but, to be safe... - -#ifdef STATIC_DLL_LOAD - - ! if we're statically loading the library (i.e., OpenFOAM), we can just call DISCON(); - ! I'll leave some options for whether the supercontroller is being used -#ifdef LOAD_SUPERCONTROLLER - CALL DISCON( dll_data%avrSWAP, filt_fromSCglob, filt_fromSC, dll_data%toSC, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) -#else - CALL DISCON( dll_data%avrSWAP, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) -#endif - -#else - - IF ( p%UseSC ) THEN - ! Call the DLL (first associate the address from the procedure in the DLL with the subroutine): - CALL C_F_PROCPOINTER( p%DLL_Trgt%ProcAddr(1), DLL_SC_Subroutine) - CALL DLL_SC_Subroutine ( dll_data%avrSWAP, filt_fromSCglob, filt_fromSC, dll_data%toSC, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) - - ELSE - ! Call the DLL (first associate the address from the procedure in the DLL with the subroutine): - CALL C_F_PROCPOINTER( p%DLL_Trgt%ProcAddr(1), DLL_Legacy_Subroutine) - CALL DLL_Legacy_Subroutine ( dll_data%avrSWAP, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) - END IF - -#endif - - IF ( aviFAIL /= 0 ) THEN - - ErrMsg = TRANSFER(avcMSG,ErrMsg) !convert C character array to Fortran string - CALL RemoveNullChar( ErrMsg ) - - IF ( aviFAIL > 0 ) THEN - ErrStat = ErrID_Info - ELSE - ErrStat = ErrID_Fatal - END IF - - ELSE - ErrStat = ErrID_None - ErrMsg = '' - END IF - - IF (PRESENT(ChannelNameUnit)) THEN - ChannelNameUnit = TRANSFER(avcOUTNAME,ChannelNameUnit) !convert C character array to Fortran string - CALL RemoveNullChar( ChannelNameUnit ) - END IF - - RETURN -END SUBROUTINE CallBladedLegacyDLL -!================================================================================================================================== -!> This routine initializes variables used in the Bladed DLL interface. -SUBROUTINE BladedInterface_Init(u, p, m, xd, y, InputFileData, InitInp, ErrStat, ErrMsg) - - TYPE(SrvD_InputType), INTENT(INOUT) :: u !< An initial guess for the input; input mesh must be defined - TYPE(SrvD_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Initial misc (optimization) variables - TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states - TYPE(SrvD_OutputType), INTENT(INOUT) :: y !< Initial system outputs (outputs are not calculated; - !! only the output mesh is initialized) - TYPE(SrvD_InputFile), INTENT(INOUT) :: InputFileData !< Data stored in the module's input file - TYPE(SrvD_InitInputType), INTENT(IN ) :: InitInp !< Input data 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 - INTEGER(IntKi) :: i ! loop counter - INTEGER(IntKi) :: ErrStat2 ! The error status code - CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred - - - ! Define all the parameters for the Bladed Interface - !IF (ALLOCATED(y%toSC)) THEN - ! InputFileData%DLL_ProcName = 'DISCON_SC' ! The name of the procedure in the DLL that will be called. - !ELSE - ! InputFileData%DLL_ProcName = 'DISCON' ! The name of the procedure in the DLL that will be called. - !END IF - - ErrStat = ErrID_None - ErrMsg= '' - - CALL DispNVD( BladedInterface_Ver ) ! Display the version of this interface - - p%UseLegacyInterface = .TRUE. !InputFileData%UseLegacyInterface - - m%dll_data%Ptch_Cntrl = InputFileData%Ptch_Cntrl - m%dll_data%Gain_OM = InputFileData%Gain_OM ! Optimal mode gain (Nm/(rad/s)^2) - m%dll_data%GenPwr_Dem = InputFileData%GenPwr_Dem ! Demanded power (W) - m%dll_data%GenSpd_Dem = InputFileData%GenSpd_Dem ! Demanded generator speed above rated (rad/s) - m%dll_data%GenSpd_MaxOM = InputFileData%GenSpd_MaxOM ! Optimal mode maximum speed (rad/s) - m%dll_data%GenSpd_MinOM = InputFileData%GenSpd_MinOM ! Minimum generator speed (rad/s) - m%dll_data%GenTrq_Dem = InputFileData%GenTrq_Dem ! Demanded generator torque above rated (Nm) - m%dll_data%Ptch_Max = InputFileData%Ptch_Max ! Maximum pitch angle (rad) - m%dll_data%Ptch_Min = InputFileData%Ptch_Min ! Minimum pitch angle (rad) - m%dll_data%Ptch_SetPnt = InputFileData%Ptch_SetPnt ! Below-rated pitch angle set-point (rad) - m%dll_data%PtchRate_Max = InputFileData%PtchRate_Max ! Maximum pitch rate (rad/s) - m%dll_data%PtchRate_Min = InputFileData%PtchRate_Min ! Minimum pitch rate (most negative value allowed) (rad/s) - p%NacYaw_North = InputFileData%NacYaw_North ! Reference yaw angle of the nacelle when the upwind end points due North (rad) - - m%dll_data%DLL_NumTrq = InputFileData%DLL_NumTrq ! No. of points in torque-speed look-up table: 0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0 (-) - - m%dll_data%DLL_InFile = InputFileData%DLL_InFile - m%dll_data%RootName = p%RootName - p%avcOUTNAME_LEN = max( LEN_TRIM(m%dll_data%RootName), MaxLoggingChannels*2*(1+ChanLen) ) + 1 ! = max( size of input, size of output ) + c_null_char - - m%dll_data%DLL_DT = InputFileData%DLL_DT ! Communication interval (sec) - p%DLL_n = NINT( m%dll_data%DLL_DT / p%DT ) - IF ( .NOT. EqualRealNos( p%DLL_n * p%DT, m%dll_data%DLL_DT ) ) THEN - CALL CheckError( ErrID_Fatal, 'DLL_DT must be an integer multiple of DT.' ) - END IF - IF ( m%dll_data%DLL_DT < EPSILON( m%dll_data%DLL_DT ) ) THEN - CALL CheckError( ErrID_Fatal, 'DLL_DT must be larger than zero.' ) - END IF - - p%DLL_Ramp = InputFileData%DLL_Ramp - p%BlAlpha = exp( -TwoPi*p%DT*InputFileData%BPCutoff ) !used only for the DLL - - if (InputFileData%BPCutoff < EPSILON( InputFileData%BPCutoff )) CALL CheckError( ErrID_Fatal, 'BPCutoff must be greater than 0.') - - IF ( m%dll_data%Ptch_Cntrl /= GH_DISCON_PITCH_CONTROL_INDIVIDUAL .AND. m%dll_data%Ptch_Cntrl /= GH_DISCON_PITCH_CONTROL_COLLECTIVE ) THEN - CALL CheckError( ErrID_Fatal, 'Ptch_Cntrl must be 0 (collective) or 1 (individual).') - RETURN - END IF - m%dll_data%Yaw_Cntrl = GH_DISCON_YAW_CONTROL_RATE ! currently only available option - m%dll_data%OverrideYawRateWithTorque = .false. - - CALL AllocAry( m%dll_data%BlPitchInput, p%NumBl, 'm%dll_data%BlPitchInput', ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - - IF ( m%dll_data%DLL_NumTrq < 0_IntKi ) THEN - CALL CheckError( ErrID_Fatal, 'DLL_NumTrq must not be less than zero.') - ELSEIF ( m%dll_data%DLL_NumTrq > 0 ) THEN - m%dll_data%Gain_OM = 0.0 ! 0.0 indicates that torque-speed table look-up is selected - - CALL MOVE_ALLOC(InputFileData%GenSpd_TLU, m%dll_data%GenSpd_TLU) ! Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) (rad/s) - CALL MOVE_ALLOC(InputFileData%GenTrq_TLU, m%dll_data%GenTrq_TLU) ! Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) (Nm ) - END IF - - IF ( ErrStat >= AbortErrLev ) RETURN - - - ! Set status flag and initialize avrSWAP: - m%dll_data%SimStatus = GH_DISCON_STATUS_INITIALISING - - CALL AllocAry( m%dll_data%avrSwap, R+(2*m%dll_data%DLL_NumTrq)-1 + MaxLoggingChannels, 'avrSwap', ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - m%dll_data%avrSWAP = 0.0 - - IF (ALLOCATED(y%toSC)) THEN - CALL AllocAry( m%dll_data%toSC, SIZE(y%toSC), 'm%dll_data%toSC', ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - m%dll_data%toSC = 0.0_SiKi - END IF - - - ! Initialize dll data stored in OtherState - m%dll_data%initialized = .FALSE. - - - -#ifdef STATIC_DLL_LOAD - ! because OpenFOAM needs the MPI task to copy the library, we're not going to dynamically load it; it needs to be loaded at runtime. - p%DLL_Trgt%FileName = '' - p%DLL_Trgt%ProcName = '' -#else - ! Define and load the DLL: - - p%DLL_Trgt%FileName = InputFileData%DLL_FileName - - if (.not. p%UseLegacyInterface) then - p%DLL_Trgt%ProcName = "" ! initialize all procedures to empty so we try to load only two - p%DLL_Trgt%ProcName(1) = "CONTROLLER" - p%DLL_Trgt%ProcName(2) = "CONTROLLER_INIT" - - CALL LoadDynamicLib ( p%DLL_Trgt, ErrStat2, ErrMsg2 ) - if (ErrStat2 > ErrID_Fatal) then ! it loaded the DLL but didn't find the INIT routine - p%DLL_Trgt%ProcName(2) = p%DLL_Trgt%ProcName(1) ! we won't call the separate controller_init routine the first time - p%DLL_Trgt%ProcAddr(2) = p%DLL_Trgt%ProcAddr(1) - elseif (ErrStat2 == ErrID_Fatal) then - CALL CheckError(ErrID_Info,'Error opening BLADED interface DLL. Checking for legacy DLL.') - CALL FreeDynamicLib( p%DLL_Trgt, ErrStat2, ErrMsg2 ) ! this doesn't do anything #ifdef STATIC_DLL_LOAD because p%DLL_Trgt is 0 (NULL) - p%UseLegacyInterface = .true. ! Bladed checks for the legacy version if it can't find the CONTROLL function in the DLL, so that's what we'll have to do, too - end if - end if - - if (p%UseLegacyInterface) then - p%DLL_Trgt%ProcName = "" ! initialize all procedures to empty so we try to load only one - p%DLL_Trgt%ProcName(1) = InputFileData%DLL_ProcName - - CALL LoadDynamicLib ( p%DLL_Trgt, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - CALL WrScr('Using legacy Bladed DLL interface.') - end if - - -!-------------------------------------- - p%NumOuts_DLL = 0 -#ifdef LOAD_DLL_TWICE_FOR_LOGGING_CHANNELS - CALL GetBladedLoggingChannels(u,p,xd,m, ErrStat2, ErrMsg2) ! this calls the DLL, but we don't have the correct inputs for a time step, so we'll close the DLL and start it again - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! close and reload library here... - ! (if the DLL could be guaranteed to not do anything with the - ! inputs on the initial step, we could avoid this this part) - - CALL BladedInterface_End(u, p, m, ErrStat2, ErrMsg2) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - - CALL LoadDynamicLib ( p%DLL_Trgt, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN -#endif - -!-------------------------------------- -#endif - - -CONTAINS - !............................................................................................................................... - SUBROUTINE CheckError(ErrID,Msg) - ! This subroutine sets the error message and level and cleans up if the error is >= AbortErrLev - !............................................................................................................................... - - ! Passed arguments - INTEGER(IntKi), INTENT(IN) :: ErrID ! The error identifier (ErrStat) - CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) - - - !............................................................................................................................ - ! Set error status/message; - !............................................................................................................................ - - IF ( ErrID /= ErrID_None ) THEN - - IF ( ErrStat /= ErrID_None ) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'BladedInterface_Init:'//TRIM(Msg) - ErrStat = MAX(ErrStat, ErrID) - - !......................................................................................................................... - ! Clean up if we're going to return on error: close files, deallocate local arrays - !......................................................................................................................... - IF ( ErrStat >= AbortErrLev ) THEN - p%UseBladedInterface = .FALSE. - END IF - - END IF - - - END SUBROUTINE CheckError -END SUBROUTINE BladedInterface_Init -!================================================================================================================================== -SUBROUTINE GetBladedLoggingChannels(u,p, xd, m, ErrStat, ErrMsg) - - TYPE(SrvD_InputType), INTENT(IN ) :: u !< An initial guess for the input; input mesh must be defined - TYPE(SrvD_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Initial misc (optimization) variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - ! local variables - - INTEGER(IntKi) :: StartIndx ! starting index used to parse name/unit from Bladed DLL - INTEGER(IntKi) :: Indx ! index used to parse name/unit from Bladed DLL - INTEGER(IntKi) :: i ! The error status code - INTEGER(IntKi) :: ErrStat2 ! The error status code - CHARACTER( p%avcOUTNAME_LEN ) :: LoggingChannelStr ! The error message, if an error occurred - CHARACTER(*), PARAMETER :: RoutineName = "GetBladedLoggingChannels" - - CALL Fill_CONTROL_vars( 0.0_DbKi, u, p, LEN(ErrMsg), m%dll_data ) - - if (p%UseLegacyInterface) then - - CALL CallBladedDLL(u, p, m%dll_data, ErrStat, ErrMsg, LoggingChannelStr) - IF ( ErrStat >= AbortErrLev ) RETURN - - p%NumOuts_DLL = NINT( m%dll_data%avrSWAP(65) ) ! number of channels returned for logging - - ALLOCATE ( m%dll_data%LogChannels_OutParam(p%NumOuts_DLL) , STAT=ErrStat2 ) - IF ( ErrStat2 /= 0_IntKi ) THEN - CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the Bladed DLL logging channels name array.", ErrStat, ErrMsg, RoutineName ) - RETURN - ENDIF - - ALLOCATE( m%dll_data%LogChannels(p%NumOuts_DLL), STAT=ErrStat2 ) - IF ( ErrStat2 /= 0_IntKi ) THEN - CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the Bladed DLL logging channels array.", ErrStat, ErrMsg, RoutineName ) - RETURN - ENDIF - - ! get names and units of channels - do i=1,p%NumOuts_DLL - m%dll_data%LogChannels_OutParam(i)%Indx = 0 - m%dll_data%LogChannels_OutParam(i)%SignM = 1 - m%dll_data%LogChannels_OutParam(i)%Name = "LogChan"//trim(num2lstr(i)) - m%dll_data%LogChannels_OutParam(i)%Units = "Unknown" - end do - - StartIndx = 1 - do i=1,p%NumOuts_DLL - - ! parse the channel name - indx = StartIndx + INDEX( LoggingChannelStr(StartIndx:), ':' ) - 1 - if (indx > len(LoggingChannelStr) .or. indx < 1) then - call SetErrStat( ErrID_Severe,"Error getting logging channel name.", ErrStat, ErrMsg, RoutineName ) - endif - - m%dll_data%LogChannels_OutParam(I)%Name = LoggingChannelStr(StartIndx:indx-1) - StartIndx = indx + 1 - - ! parse the channel units - indx = StartIndx + INDEX( LoggingChannelStr(StartIndx:), ';' ) - 1 - if (indx > len(LoggingChannelStr) .or. indx < 1) then - call SetErrStat( ErrID_Severe,"Error getting logging channel units.", ErrStat, ErrMsg, RoutineName ) - endif - - m%dll_data%LogChannels_OutParam(I)%Units = LoggingChannelStr(StartIndx:indx-1) - StartIndx = indx + 1 - end do - - !todo: make sure trim(m%dll_data%LogChannels_OutParam(i)%Name) does not contain spaces; replace with '_' if necessary - - else - - - ALLOCATE( m%dll_data%LogChannels( MaxLoggingChannels), & - m%dll_data%LogChannels_OutParam(MaxLoggingChannels), STAT=ErrStat2 ) - IF ( ErrStat2 /= 0_IntKi ) THEN - CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the Bladed DLL logging channels.", ErrStat, ErrMsg, RoutineName ) - RETURN - ENDIF - - CALL CallBladedDLL(u, p, m%dll_data, ErrStat, ErrMsg) - IF ( ErrStat >= AbortErrLev ) RETURN - - p%NumOuts_DLL = m%dll_data%NumLogChannels ! set this as a parameter in case the DLL changes the value during the simulation - - end if - - - ! convert Bladed-allowed unit specifiers to actual units - do i=1,p%NumOuts_DLL - select case (m%dll_data%LogChannels_OutParam(I)%Units) - case('1/T') - m%dll_data%LogChannels_OutParam(I)%Units = 'Hz' - case('A') - m%dll_data%LogChannels_OutParam(I)%Units = 'rad' - case('A/P') - m%dll_data%LogChannels_OutParam(I)%Units = 'rad/W' - case('A/PT') - m%dll_data%LogChannels_OutParam(I)%Units = 'rad/Ws' - case('A/PTT') - m%dll_data%LogChannels_OutParam(I)%Units = 'rad/Ws^2' - case('A/T') - m%dll_data%LogChannels_OutParam(I)%Units = 'rad/s' - case('A/TT') - m%dll_data%LogChannels_OutParam(I)%Units = 'rad/s^2' - case('F') - m%dll_data%LogChannels_OutParam(I)%Units = 'N' - case('F/L') - m%dll_data%LogChannels_OutParam(I)%Units = 'N/m' - case('F/LL') - m%dll_data%LogChannels_OutParam(I)%Units = 'N/m^2' - case('FL') - m%dll_data%LogChannels_OutParam(I)%Units = 'Nm' - case('FL/A') - m%dll_data%LogChannels_OutParam(I)%Units = 'Nm/rad' - case('FL/L') - m%dll_data%LogChannels_OutParam(I)%Units = 'Nm/m' - case('FLL') - m%dll_data%LogChannels_OutParam(I)%Units = 'Nm^2' - case('FLT/A') - m%dll_data%LogChannels_OutParam(I)%Units = 'Nms/rad' - case('FLTT/AA') - m%dll_data%LogChannels_OutParam(I)%Units = 'Nms^2/rad^2' - case('I') - m%dll_data%LogChannels_OutParam(I)%Units = 'A' - case('L') - m%dll_data%LogChannels_OutParam(I)%Units = 'm' - case('L/T') - m%dll_data%LogChannels_OutParam(I)%Units = 'm/s' - case('L/TT') - m%dll_data%LogChannels_OutParam(I)%Units = 'm/s^2' - case('LLL') - m%dll_data%LogChannels_OutParam(I)%Units = 'm^3' - case('LLL/A') - m%dll_data%LogChannels_OutParam(I)%Units = 'm^3/rad' - case('M') - m%dll_data%LogChannels_OutParam(I)%Units = 'kg' - case('M/L') - m%dll_data%LogChannels_OutParam(I)%Units = 'kg/m' - case('M/LLL') - m%dll_data%LogChannels_OutParam(I)%Units = 'kg/m^3' - case('M/LT') - m%dll_data%LogChannels_OutParam(I)%Units = 'kg/ms' - case('MLL') - m%dll_data%LogChannels_OutParam(I)%Units = 'kgm^2' - case('N') - m%dll_data%LogChannels_OutParam(I)%Units = '-' - case('P') - m%dll_data%LogChannels_OutParam(I)%Units = 'W' - case('PT') - m%dll_data%LogChannels_OutParam(I)%Units = 'J' - case('Q') - m%dll_data%LogChannels_OutParam(I)%Units = 'VAr' - case('T') - m%dll_data%LogChannels_OutParam(I)%Units = 's' - case('VI') - m%dll_data%LogChannels_OutParam(I)%Units = 'VA' - end select - - end do - -END SUBROUTINE GetBladedLoggingChannels -!================================================================================================================================== - -!> This routine calls the DLL for the final time (if it was previously called), and frees the dynamic library. -SUBROUTINE BladedInterface_End(u, p, m, xd, ErrStat, ErrMsg) - - TYPE(SrvD_InputType), INTENT(IN ) :: u !< System inputs - TYPE(SrvD_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< misc (optimization) variables - TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states - 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 ! The error status code - CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred - - ! call DLL final time, but skip if we've never called it - if (allocated(m%dll_data%avrSWAP)) then - IF ( m%dll_data%SimStatus /= GH_DISCON_STATUS_INITIALISING ) THEN - m%dll_data%SimStatus = GH_DISCON_STATUS_FINALISING - m%dll_data%avrSWAP(1) = m%dll_data%SimStatus ! we aren't calling fill_avrSWAP, so set this manually - CALL CallBladedDLL(u, p, m%dll_data, ErrStat, ErrMsg) - END IF - end if - - CALL FreeDynamicLib( p%DLL_Trgt, ErrStat2, ErrMsg2 ) ! this doesn't do anything #ifdef STATIC_DLL_LOAD because p%DLL_Trgt is 0 (NULL) - IF (ErrStat2 /= ErrID_None) THEN - ErrStat = MAX(ErrStat, ErrStat2) - ErrMsg = TRIM(ErrMsg)//NewLine//TRIM(ErrMsg2) - END IF - -END SUBROUTINE BladedInterface_End -!================================================================================================================================== -!> This routine sets the AVRswap array, calls the routine from the BladedDLL, and sets the outputs from the call to be used as -!! necessary in the main ServoDyn CalcOutput routine. -SUBROUTINE BladedInterface_CalcOutput(t, u, p, m, xd, ErrStat, ErrMsg) - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< misc (optimization) variables - TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - 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 ! The error status code - CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred - character(*), parameter :: RoutineName = 'BladedInterface_CalcOutput' - - ! Initialize error values: - ErrStat = ErrID_None - ErrMsg= '' - - - ! Set the input values of the avrSWAP array: - CALL Fill_CONTROL_vars( t, u, p, LEN(ErrMsg), m%dll_data ) - - -#ifdef DEBUG_BLADED_INTERFACE -!CALL WrNumAryFileNR ( 58, (/t/),'1x,ES15.6E2', ErrStat2, ErrMsg2 ) -CALL WrNumAryFileNR ( 58, m%dll_data%avrSWAP,'1x,ES15.6E2', ErrStat2, ErrMsg2 ) -write(58,'()') -#endif - - ! Call the Bladed-style DLL controller: - CALL CallBladedDLL(u, p, m%dll_data, ErrStat, ErrMsg) - IF ( ErrStat >= AbortErrLev ) RETURN - -#ifdef DEBUG_BLADED_INTERFACE -!CALL WrNumAryFileNR ( 59, (/t/),'1x,ES15.6E2', ErrStat2, ErrMsg2 ) -CALL WrNumAryFileNR ( 59, m%dll_data%avrSWAP,'1x,ES15.6E2', ErrStat2, ErrMsg2 ) -write(59,'()') -#endif - - ! Get the output values from the avrSWAP array: - - CALL CheckDLLReturnValues( p, m%dll_data, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - -END SUBROUTINE BladedInterface_CalcOutput -!================================================================================================================================== -!> This routine fills the avrSWAP array with its inputs, as described in Appendices A and B of the Bladed User Manual of Bladed -!! version 3.81. -SUBROUTINE Fill_avrSWAP( t, u, p, ErrMsgSz, dll_data ) -!SUBROUTINE Fill_avrSWAP( StatFlag, t, u, p, ErrMsgSz, dll_data ) -!.................................................................................................................................. - -! INTEGER(IntKi), INTENT(IN ) :: StatFlag ! Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation (-) - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - INTEGER(IntKi), INTENT(IN ) :: ErrMsgSz !< Allowed size of the DLL-returned error message (-) - TYPE(BladedDLLType), INTENT(INOUT) :: dll_data !< data for the Bladed DLL - - ! local variables: - INTEGER(IntKi) :: I ! Loop counter - - !> The following are values ServoDyn sends to the Bladed DLL. - !! For variables returned from the DLL, see bladedinterface::retrieve_avrswap. - dll_data%avrSWAP( 1) = dll_data%SimStatus - !> * Record 1: Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation (-) - dll_data%avrSWAP( 2) = REAL(t, SiKi) !> * Record 2: Current time (sec) [t in single precision] - dll_data%avrSWAP( 3) = dll_data%DLL_DT !> * Record 3: Communication interval (sec) [in FAST v7 this was \f$ y\_SrvD\%AllOuts(Time) - LastTime \f$, but is now the SrvD DLL_DT parameter] - dll_data%avrSWAP( 4) = u%BlPitch(1) !> * Record 4: Blade 1 pitch angle (rad) [SrvD input] - dll_data%avrSWAP( 5) = dll_data%Ptch_SetPnt !> * Record 5: Below-rated pitch angle set-point (rad) [SrvD Ptch_SetPnt parameter] - dll_data%avrSWAP( 6) = dll_data%Ptch_Min !> * Record 6: Minimum pitch angle (rad) [SrvD Ptch_Min parameter] - dll_data%avrSWAP( 7) = dll_data%Ptch_Max !> * Record 7: Maximum pitch angle (rad) [SrvD Ptch_Max parameter] - dll_data%avrSWAP( 8) = dll_data%PtchRate_Min !> * Record 8: Minimum pitch rate (most negative value allowed) (rad/s) [SrvD PtchRate_Min parameter] - dll_data%avrSWAP( 9) = dll_data%PtchRate_Max !> * Record 9: Maximum pitch rate (rad/s) [SrvD PtchRate_Max parameter] - dll_data%avrSWAP(10) = 0.0 !> * Record 10: 0 = pitch position actuator, 1 = pitch rate actuator (-) [must be 0 for ServoDyn] - dll_data%avrSWAP(11) = dll_data%BlPitchCom(1) !> * Record 11: Current demanded pitch angle (rad) [I am sending the previous value for blade 1 from the DLL, in the absence of any more information provided in Bladed documentation] - dll_data%avrSWAP(12) = 0.0 !> * Record 12: Current demanded pitch rate (rad/s) [always zero for ServoDyn] - dll_data%avrSWAP(13) = dll_data%GenPwr_Dem !> * Record 13: Demanded power (W) [SrvD GenPwr_Dem parameter from input file] - dll_data%avrSWAP(14) = u%RotPwr !> * Record 14: Measured shaft power (W) [SrvD input] - dll_data%avrSWAP(15) = dll_data%ElecPwr_prev !> * Record 15: Measured electrical power output (W) [SrvD calculation from previous step; should technically be a state] - dll_data%avrSWAP(16) = dll_data%Gain_OM !> * Record 16: Optimal mode gain (Nm/(rad/s)^2) [if torque-speed table look-up not selected in input file, use SrvD Gain_OM parameter, otherwise use 0 (already overwritten in Init routine)] - dll_data%avrSWAP(17) = dll_data%GenSpd_MinOM !> * Record 17: Minimum generator speed (rad/s) [SrvD GenSpd_MinOM parameter] - dll_data%avrSWAP(18) = dll_data%GenSpd_MaxOM !> * Record 18: Optimal mode maximum speed (rad/s) [SrvD GenSpd_MaxOMp arameter] - dll_data%avrSWAP(19) = dll_data%GenSpd_Dem !> * Record 19: Demanded generator speed above rated (rad/s) [SrvD GenSpd_Dem parameter] - dll_data%avrSWAP(20) = u%HSS_Spd !> * Record 20: Measured generator speed (rad/s) [SrvD input] - dll_data%avrSWAP(21) = u%RotSpeed !> * Record 21: Measured rotor speed (rad/s) [SrvD input] - dll_data%avrSWAP(22) = dll_data%GenTrq_Dem !> * Record 22: Demanded generator torque above rated (Nm) [SrvD GenTrq_Dem parameter from input file] -!bjj: this assumes it is the value at the previous step; but we actually want the output GenTrq... - dll_data%avrSWAP(23) = dll_data%GenTrq_prev !> * Record 23: Measured generator torque (Nm) [SrvD calculation from previous step; should technically be a state] - dll_data%avrSWAP(24) = u%YawErr !> * Record 24: Measured yaw error (rad) [SrvD input] - IF ( dll_data%DLL_NumTrq == 0 ) THEN ! Torque-speed table look-up not selected - dll_data%avrSWAP(25) = 0.0 ! Start of below-rated torque-speed look-up table (record no.) -- 0.0 indicates that torque-speed table look-up is not selected - ELSE ! Torque-speed table look-up selected - dll_data%avrSWAP(25) = R !> * Record 25: Start of below-rated torque-speed look-up table (record no.) [parameter \f$R\f$ (bladedinterface::r) or 0 if DLL_NumTrq == 0] - ENDIF - dll_data%avrSWAP(26) = dll_data%DLL_NumTrq !> * Record 26: No. of points in torque-speed look-up table (-) [SrvD DLL_NumTrq parameter] - dll_data%avrSWAP(27) = u%HorWindV !> * Record 27: Hub wind speed (m/s) [SrvD input] - dll_data%avrSWAP(28) = dll_data%Ptch_Cntrl !> * Record 28: Pitch control: 0 = collective, 1 = individual (-) [SrvD Ptch_Cntrl parameter] - dll_data%avrSWAP(29) = dll_data%Yaw_Cntrl !> * Record 29: Yaw control: 0 = yaw rate control, 1 = yaw torque control (-) [must be 0 for ServoDyn] - !^^^ bjj: maybe torque control can be used in ServoDyn? can we specifiy yaw torque control? - dll_data%avrSWAP(30) = u%RootMyc(1) !> * Record 30: Blade 1 root out-of-plane bending moment (Nm) [SrvD input] - dll_data%avrSWAP(31) = u%RootMyc(2) !> * Record 31: Blade 2 root out-of-plane bending moment (Nm) [SrvD input] - dll_data%avrSWAP(32) = u%RootMyc(3) !> * Record 32: Blade 3 root out-of-plane bending moment (Nm) [SrvD input] -IF ( p%NumBl > 1 ) THEN - dll_data%avrSWAP(33) = u%BlPitch(2) !> * Record 33: Blade 2 pitch angle (rad) [SrvD input] -END IF -IF ( p%NumBl > 2 ) THEN - dll_data%avrSWAP(34) = u%BlPitch(3) !> * Record 34: Blade 3 pitch angle (rad) [SrvD input] -! dll_data%avrSWAP(34) = u%BlPitch(3) !> * Record 34: Blade 3 pitch angle (rad) [SrvD input] -END IF - dll_data%avrSWAP(35) = dll_data%GenState !> * Record 35: Generator contactor (-) [GenState from previous call to DLL (initialized to 1)] -! record 36 is initialized to 0 (brake off); then we will keep the brake status set in previous call to DLL -! dll_data%avrSWAP(36) = dll_data%HSSBrFrac !> * Record 36: Shaft brake status: 0 = off, 1 = on (full), 16 = Get brake torque from record 107 (-) [HSSBrFrac from previous call to DLL (initialized to 0)] - dll_data%avrSWAP(37) = u%YawAngle - p%NacYaw_North !> * Record 37: Nacelle yaw angle from North (rad) [ \f$ u\%YawAngle - p\%NacYaw\_North \f$ ] -! Records 38-48 are outputs [see Retrieve_avrSWAP()] - dll_data%avrSWAP(49) = ErrMsgSz + 1 !> * Record 49: Maximum number of characters in the "MESSAGE" argument (-) [size of ErrMsg argument plus 1 (we add one for the C NULL CHARACTER)] - dll_data%avrSWAP(50) = LEN_TRIM(dll_data%DLL_InFile) +1 !> * Record 50: Number of characters in the "INFILE" argument (-) [trimmed length of DLL_InFile parameter plus 1 (we add one for the C NULL CHARACTER)] - dll_data%avrSWAP(51) = LEN_TRIM(dll_data%RootName) +1 !> * Record 51: Number of characters in the "OUTNAME" argument (-) [trimmed length of RootName parameter plus 1 (we add one for the C NULL CHARACTER)] -! Record 52 is reserved for future use ! DLL interface version number (-) - dll_data%avrSWAP(53) = u%YawBrTAxp !> * Record 53: Tower top fore-aft acceleration (m/s^2) [SrvD input] - dll_data%avrSWAP(54) = u%YawBrTAyp !> * Record 54: Tower top side-to-side acceleration (m/s^2) [SrvD input] -! Records 55-59 are outputs [see Retrieve_avrSWAP()] - dll_data%avrSWAP(60) = u%LSSTipPxa !> * Record 60: Rotor azimuth angle (rad) [SrvD input] - dll_data%avrSWAP(61) = p%NumBl !> * Record 61: Number of blades (-) [SrvD NumBl parameter] - dll_data%avrSWAP(62) = MaxLoggingChannels !> * Record 62: Maximum number of values which can be returned for logging (-) [set to parameter bladedinterface::maxloggingchannels] - dll_data%avrSWAP(63) = R + (2*dll_data%DLL_NumTrq) !> * Record 63: Record number for start of logging output (-) [set to R + (2*p\%DLL_NumTrq)] - dll_data%avrSWAP(64) = p%avcOUTNAME_LEN !> * Record 64: Maximum number of characters which can be returned in "OUTNAME" (-) [set to bladedinterface::MaxLoggingChannels * (2+nwtc_base::chanlen) + 1 (we add one for the C NULL CHARACTER)] -! Record 65 is output [see Retrieve_avrSWAP()] -! Records 66-68 are reserved - - dll_data%avrSWAP(69) = u%RootMxc(1) !> * Record 69: Blade 1 root in-plane bending moment (Nm) [SrvD input] - dll_data%avrSWAP(70) = u%RootMxc(2) !> * Record 70: Blade 2 root in-plane bending moment (Nm) [SrvD input] - dll_data%avrSWAP(71) = u%RootMxc(3) !> * Record 71: Blade 3 root in-plane bending moment (Nm) [SrvD input] -! Record 72 is output [see Retrieve_avrSWAP()] - dll_data%avrSWAP(73) = u%LSSTipMya !> * Record 73: Rotating hub My (GL co-ords) (Nm) [SrvD input] - dll_data%avrSWAP(74) = u%LSSTipMza !> * Record 74: Rotating hub Mz (GL co-ords) (Nm) [SrvD input] - dll_data%avrSWAP(75) = u%LSSTipMys !> * Record 75: Fixed hub My (GL co-ords) (Nm) [SrvD input] - dll_data%avrSWAP(76) = u%LSSTipMzs !> * Record 76: Fixed hub Mz (GL co-ords) (Nm) [SrvD input] - dll_data%avrSWAP(77) = u%YawBrMyn !> * Record 77: Yaw bearing My (GL co-ords) (Nm) [SrvD input] - dll_data%avrSWAP(78) = u%YawBrMzn !> * Record 78: Yaw bearing Mz (GL co-ords) (Nm) [SrvD input] -! Records 79-80 are outputs [see Retrieve_avrSWAP()] -! Record 81 is the variable slip current demand; both input and output [see Retrieve_avrSWAP()] - ! variable slip current demand is ignored; instead, the generator torque demand from Record 47 is used - dll_data%avrSWAP(82) = u%NcIMURAxs !> * Record 82: Nacelle roll acceleration (rad/s^2) [SrvD input] -- this is in the shaft (tilted) coordinate system, instead of the nacelle (nontilted) coordinate system - dll_data%avrSWAP(83) = u%NcIMURAys !> * Record 83: Nacelle nodding acceleration (rad/s^2) [SrvD input] - dll_data%avrSWAP(84) = u%NcIMURAzs !> * Record 84: Nacelle yaw acceleration (rad/s^2) [SrvD input] -- this is in the shaft (tilted) coordinate system, instead of the nacelle (nontilted) coordinate system - - - -! Records 92-94 are outputs [see Retrieve_avrSWAP()] - - ! these two "inputs" are actually customizations for a particular DLL - dll_data%avrSWAP(95) = p%AirDens !> * Record 95: Reserved (SrvD customization: set to SrvD AirDens parameter) - dll_data%avrSWAP(96) = p%AvgWindSpeed !> * Record 96: Reserved (SrvD customization: set to SrvD AvgWindSpeed parameter) - -! Record 98 is output [see Retrieve_avrSWAP()] - dll_data%avrSWAP(98) = 0 !> * Record 98: set to 0 - -! Records 102-104 are outputs [see Retrieve_avrSWAP()] -! Records 107-108 are outputs [see Retrieve_avrSWAP()] - - dll_data%avrSWAP(109) = u%LSSTipMxa ! or u%LSShftMxs !> * Record 109: Shaft torque (=hub Mx for clockwise rotor) (Nm) [SrvD input] - dll_data%avrSWAP(117) = 0 !> * Record 117: Controller state [always set to 0] - - !> * Records \f$R\f$ through \f$R + 2*DLL\_NumTrq - 1\f$: torque-speed look-up table elements. - DO I = 1,dll_data%DLL_NumTrq ! Loop through all torque-speed look-up table elements - dll_data%avrSWAP( R + (2*I) - 2 ) = dll_data%GenSpd_TLU(I) !> + Records \f$R, R+2, R+4, \dots, R + 2*DLL\_NumTrq - 2\f$: Generator speed look-up table elements (rad/s) - dll_data%avrSWAP( R + (2*I) - 1 ) = dll_data%GenTrq_TLU(I) !> + Records \f$R+1, R+3, R+5, \dots, R + 2*DLL\_NumTrq - 1\f$: Generator torque look-up table elements (Nm) - ENDDO - - -!> * Records 120-129: User-defined variables 1-10; ignored in ServoDyn -! Records 130-142 are outputs [see Retrieve_avrSWAP()] -! Records L1 and onward are outputs [see Retrieve_avrSWAP()] - - - - RETURN - -END SUBROUTINE Fill_avrSWAP -!================================================================================================================================== -!> This routine fills the dll_data variables that are used in the non-legacy version of the Bladed DLL interface with inputs, -!! as described in Appendices A and B of the Bladed User Manual of Bladed version 4.8. -SUBROUTINE Fill_CONTROL_vars( t, u, p, ErrMsgSz, dll_data ) - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - INTEGER(IntKi), INTENT(IN ) :: ErrMsgSz !< Allowed size of the DLL-returned error message (-) -! REAL(SiKi), INTENT(INOUT) :: avrSWAP(:) ! the SWAP array for the Bladed DLL Interface - TYPE(BladedDLLType), INTENT(INOUT) :: dll_data !< data for the Bladed DLL - - ! local variables: - INTEGER(IntKi) :: i ! Loop counter - INTEGER(IntKi) :: j ! Loop counter - - if (dll_data%SimStatus == GH_DISCON_STATUS_INITIALISING) then - dll_data%avrSWAP = 0.0 - dll_data%NumLogChannels = 0 - - dll_data%GenState = 1 - dll_data%GenTrq = 0.0 - dll_data%YawRateCom = 0.0 - dll_data%HSSBrTrqDemand = 0.0 - dll_data%ShaftBrakeStatusBinaryFlag = 0 ! no brakes deployed - dll_data%HSSBrDeployed = .false. - - dll_data%PrevBlPitch(:) = 0.0_ReKi ! Harcoded to size 3 - dll_data%BlPitchCom(:) = 0.0_ReKi ! Harcoded to size 3 - dll_data%BlAirfoilCom(:)= 0.0_ReKi ! Harcoded to size 3 - dll_data%PrevBlPitch(1:p%NumBl) = p%BlPitchInit(1:p%NumBl) - dll_data%BlPitchCom(1:p%NumBl) = p%BlPitchInit(1:p%NumBl) - end if - - call Fill_avrSWAP( t, u, p, ErrMsgSz, dll_data ) ! we'll set the avrSWAP variable, for the legacy version of the DLL, too. - - !> The following are values ServoDyn sends to the Bladed DLL. - !! For variables returned from the DLL, see bladedinterface::retrieve_control_vars. - - dll_data%ErrMsg = '' - dll_data%ErrStat = ErrID_None - dll_data%OverrideYawRateWithTorque = .false. - - dll_data%CurrentTime = t ! Current time (sec) - dll_data%BlPitchInput(1:p%NumBl) = u%BlPitch(1:p%NumBl) ! current blade pitch (input) - dll_data%YawAngleFromNorth = u%YawAngle - p%NacYaw_North ! Nacelle yaw angle from North (rad) - dll_data%HorWindV = u%HorWindV ! Hub wind speed (m/s) - dll_data%HSS_Spd = u%HSS_Spd ! Measured generator speed (rad/s) - dll_data%YawErr = u%YawErr ! Measured yaw error (rad) - dll_data%RotSpeed = u%RotSpeed ! Measured rotor speed (rad/s) - dll_data%YawBrTAxp = u%YawBrTAxp ! Tower top fore-aft acceleration (m/s^2) - dll_data%YawBrTAyp = u%YawBrTAyp ! Tower top side-to-side acceleration (m/s^2) - dll_data%LSSTipMys = u%LSSTipMys ! Fixed hub My (GL co-ords) (Nm) - dll_data%LSSTipMzs = u%LSSTipMzs ! Fixed hub Mz (GL co-ords) (Nm) - dll_data%LSSTipPxa = u%LSSTipPxa ! Rotor azimuth angle (rad) - dll_data%Yaw = u%Yaw ! Current nacelle yaw (angular position) (rad) NEW TO DLL!!! - dll_data%YawRate = u%YawRate ! Current nacelle yaw rate (angular velocity) (rad/s) NEW TO DLL!!! - dll_data%LSSTipMya = u%LSSTipMya ! Rotating hub My (GL co-ords) (Nm) - dll_data%LSSTipMza = u%LSSTipMza ! Rotating hub Mz (GL co-ords) (Nm) - dll_data%YawBrMyn = u%YawBrMyn ! Yaw bearing My (GL co-ords) (Nm) - dll_data%YawBrMzn = u%YawBrMzn ! Yaw bearing Mz (GL co-ords) (Nm) - dll_data%RotPwr = u%RotPwr ! Measured shaft power (W) [SrvD input] - dll_data%NcIMURAxs = u%NcIMURAxs ! Nacelle roll acceleration (rad/s^2) -- this is in the shaft (tilted) coordinate system, instead of the nacelle (nontilted) coordinate system - dll_data%NcIMURAys = u%NcIMURAys ! Nacelle nodding acceleration (rad/s^2) - dll_data%NcIMURAzs = u%NcIMURAzs ! Nacelle yaw acceleration (rad/s^2) -- this is in the shaft (tilted) coordinate system, instead of the nacelle (nontilted) coordinate system - dll_data%LSSTipMxa = u%LSSTipMxa ! Shaft torque (=hub Mx for clockwise rotor) (Nm) - dll_data%RootMyc = u%RootMyc ! Blade root out-of-plane bending moment (Nm) [SrvD input] - dll_data%RootMxc = u%RootMxc ! Blade root in-plane bending moment (Nm) [SrvD input] - -END SUBROUTINE Fill_CONTROL_vars -!================================================================================================================================== -!> This routine retrieves the DLL return values from the avrSWAP array, as described in Appendices A and B of the Bladed User -!! Manual of Bladed version 3.81. -SUBROUTINE Retrieve_avrSWAP( p, dll_data, ErrStat, ErrMsg ) -!SUBROUTINE Retrieve_avrSWAP( p, dll_data ) -!.................................................................................................................................. - - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(BladedDLLType), INTENT(INOUT) :: dll_data !< data for the Bladed DLL - 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 ! Loop counter - CHARACTER(*), PARAMETER :: RoutineName = 'Retrieve_avrSWAP' - - - ! Initialize ErrStat and ErrMsg - ErrStat = ErrID_None - ErrMsg = '' - - !> The following are values the Bladed DLL sends to ServoDyn. Whether or not ServoDyn uses the values in CalcOutput (servodyn::srvd_calcoutput) - !! and/or UpdateStates (servodyn::srvd_updatestates) is determined by other parameters set in the ServoDyn input file. - !! For variables sent to the DLL, see bladedinterface::fill_avrswap. - - - !! Load control demands (commands) out of the avrSWAP array according to - !! Appendix A of the Bladed User Manual: - -!> * Record 35: Generator contactor (-) [sent to DLL at the next call] - dll_data%GenState = NINT( dll_data%avrSWAP(35) ) ! Generator contactor (-) - - -!> * Record 36: Shaft brake status (-) [sent to DLL at the next call; anything other than 0 or 1 is an error] - !dll_data%HSSBrFrac = dll_data%avrSWAP(36) ! Shaft brake status (-) - dll_data%ShaftBrakeStatusBinaryFlag = NINT(dll_data%avrSWAP(36)) - -!! Records 38-40 are reserved -!> * Record 41: demanded yaw actuator torque [this output is ignored since record 29 is set to 0 by ServoDyn indicating yaw rate control] - dll_data%YawTorqueDemand = dll_data%avrSWAP(41) - -! Records 42-46: demanded pitch positions or rates - IF ( dll_data%Ptch_Cntrl == GH_DISCON_PITCH_CONTROL_INDIVIDUAL ) THEN ! Individual pitch control (p%Ptch_Cntrl == 1) -!> * Records 42-44: Demanded Individual Pitch position (rad) (or pitch rate [rad/s]) - DO K = 1,p%NumBl ! Loop through all blades avrSWAP(42), avrSWAP(43), and, if NumBl = 3, avrSWAP(44) - dll_data%BlPitchCom(K) = dll_data%avrSWAP( 41 + K ) ! Demanded individual pitch position of blade K (rad) - ENDDO ! K - blades - - ELSE !IF ( p%Ptch_Cntrl == GH_DISCON_PITCH_CONTROL_COLLECTIVE ) THEN ! Collective pitch control -!> * Record 45: Demanded pitch angle (Collective pitch) (rad) - dll_data%BlPitchCom(:) = dll_data%avrSWAP(45) ! Demanded pitch angle (Collective pitch) (rad) - -!> * Record 46, demanded pitch rate (Collective pitch), is ingored since record 10 is set to 0 by ServoDyn indicating pitch position actuator - - ENDIF - - dll_data%GenTrq = dll_data%avrSWAP(47) !> * Record 47: Demanded generator torque (Nm) - dll_data%YawRateCom = dll_data%avrSWAP(48) !> * Record 48: Demanded nacelle yaw rate (rad/s) - - -!> * Record 55: Pitch override [anything other than 0 is an error in ServoDyn] - IF ( NINT( dll_data%avrSWAP(55) ) /= 0 ) THEN - ! Pitch override requested by DLL; abort program - CALL SetErrStat( ErrID_Severe, 'Built-in pitch override unsupported. Set avrSWAP(55) to 0 in '// & - TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) - - END IF - - -!> * Record 56: Torque override - IF ( NINT( dll_data%avrSWAP(56) ) /= 0 ) THEN - ! Torque override requested by DLL; abort program - CALL SetErrStat( ErrID_Severe, 'Built-in torque override unsupported. Set avrSWAP(56) to 0 in '// & - TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) - - END IF - - -!! Records 57-59 are reserved - -!> * Record 65: Number of variables returned for logging [anything greater than MaxLoggingChannels is an error] - IF ( NINT( dll_data%avrSWAP(65) ) > MaxLoggingChannels ) THEN - - ! Return variables for logging requested by DLL; abort program - CALL SetErrStat( ErrID_Fatal, 'Return variables exceed maximum number allowed. Set avrSWAP(65) to a number no larger than '// & - trim(num2lstr(MaxLoggingChannels))//' in '//TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) - - ENDIF - -!> * Record 72, the generator start-up resistance, is ignored -!> * Record 79, the request for loads, is ignored; instead, the blade, hub, and yaw bearing loads are always passed to the DLL as if Record 79 was set to 4 -!> * Records 80-81, the variable-slip current demand inputs, are ignored; instead, the generator torque demand from Record 47 is used - - -!> * Records 92-94: allow the control to change the wind inflow input; NOT ALLOWED in ServoDyn -!> * Record 98: Safety system number to activate; not used in ServoDyn - -!> * Records 102-104: Yaw control/stiffness/damping; ignored in ServoDyn - if (dll_data%avrSWAP(102)==4) then - dll_data%OverrideYawRateWithTorque = .true. - elseif (dll_data%avrSWAP(102)==0) then - dll_data%OverrideYawRateWithTorque = .false. - else - dll_data%OverrideYawRateWithTorque = .false. - CALL SetErrStat( ErrID_Severe, 'Invalid yaw control flag. Set avrSWAP(102) to 0 or 4 in '// & - TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) - end if - -!> * Record 107: Brake torque demand (used only when avrSWAP(36) is 16) - if (dll_data%ShaftBrakeStatusBinaryFlag == 16) then - dll_data%HSSBrTrqDemand = dll_data%avrSWAP(107) - end if - -!> * Record 108: Yaw brake torque demand; ignored in ServoDyn - -!> * Records 120-129: User-defined variables 1-10; ignored in ServoDyn - ! 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) - dll_data%BlAirfoilCom(1) = dll_data%avrSWAP(120) - dll_data%BlAirfoilCom(2) = dll_data%avrSWAP(121) - dll_data%BlAirFoilCom(3) = dll_data%avrSWAP(122) - -!> * Records 130-142: Reserved - -!> * L1: variables for logging output; - - do k=1,p%NumOuts_DLL - dll_data%LogChannels(k) = dll_data%avrSWAP( NINT(dll_data%avrSWAP(63))+k-1 ) - end do - - -END SUBROUTINE Retrieve_avrSWAP -!================================================================================================================================== -!> This routine checks that the values returned to FAST from the controller DLL (from either version of the interface) are valid -SUBROUTINE CheckDLLReturnValues( p, dll_data, ErrStat, ErrMsg ) - - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(BladedDLLType), INTENT(INOUT) :: dll_data !< data for the Bladed DLL - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'CheckDLLReturnValues' - - ! Initialize ErrStat and ErrMsg - ErrStat = ErrID_None - ErrMsg = '' - - if (p%UseLegacyInterface) then - CALL Retrieve_avrSWAP( p, dll_data, ErrStat, ErrMsg ) - if (ErrStat >= AbortErrLev) return - end if - - - IF ( ( dll_data%GenState /= 0_IntKi ) .AND. ( dll_data%GenState /= 1_IntKi ) ) THEN - ! Generator contactor indicates something other than off or main; abort program - if (p%UseLegacyInterface) then - CALL SetErrStat( ErrID_Fatal, 'Only off and main generators supported. Set avrSWAP(35) to 0 or 1 in '//TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) - else - CALL SetErrStat( ErrID_Fatal, 'Only off and main generators supported. Call SetGeneratorContactor() with generator_contactor set to 0 or 1 in '// & - TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) - end if - END IF - - - SELECT CASE (dll_data%ShaftBrakeStatusBinaryFlag) - CASE (0) - dll_data%HSSBrTrqDemand = 0.0_ReKi - dll_data%HSSBrDeployed = .false. - CASE (1) - if (.not. dll_data%HSSBrDeployed) then - dll_data%TimeHSSBrDeployed = dll_data%CurrentTime - dll_data%TimeHSSBrFullyDeployed = dll_data%TimeHSSBrDeployed + p%HSSBrDT - dll_data%HSSBrDeployed = .true. - dll_data%HSSBrTrqDemand = 0.0_ReKi - else - ! apply a linear ramp up to the maximum value - IF ( dll_data%CurrentTime < dll_data%TimeHSSBrFullyDeployed ) THEN - dll_data%HSSBrTrqDemand = ( dll_data%CurrentTime - dll_data%TimeHSSBrDeployed )/p%HSSBrDT * p%HSSBrTqF - ELSE ! Full braking torque - dll_data%HSSBrTrqDemand = p%HSSBrTqF - ENDIF - end if - CASE (16) - dll_data%HSSBrDeployed = .false. - ! do we need to check that dll_data%HSSBrTrqDemand is set properly???? - CASE DEFAULT - dll_data%HSSBrDeployed = .false. - - ! Fatal issue: shaft brake status specified incorrectly - if (p%UseLegacyInterface) then - CALL SetErrStat( ErrID_Fatal, 'Shaft brake status set improperly. Set avrSWAP(36) to 0, 1, or 16 in '// & - TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) - else - CALL SetErrStat( ErrID_Fatal, 'Shaft brake status set improperly. Call SetShaftBrakeStatusBinaryFlag() with binary_brake_status set to 0 or 1 in '// & - TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) - end if - END SELECT - -END SUBROUTINE CheckDLLReturnValues -!================================================================================================================================== -END MODULE BladedInterface diff --git a/OpenFAST/modules/servodyn/src/PitchCntrl_ACH.f90 b/OpenFAST/modules/servodyn/src/PitchCntrl_ACH.f90 deleted file mode 100644 index 167851ce2..000000000 --- a/OpenFAST/modules/servodyn/src/PitchCntrl_ACH.f90 +++ /dev/null @@ -1,759 +0,0 @@ - ! NOTE: This source file contains an example PitchCntrl() user-specified - ! routine for computing blade pitch control commands based on transfer - ! function descriptions specified in a pitch.ipt input file. This - ! routine was written by Craig Hansen (ACH) of Windward Engineering - ! LLC. Questions related to the use of this routine should be - ! addressed to Craig Hansen. -module PitchCntrl_ACH -contains -!======================================================================= -SUBROUTINE PitchCntrl ( BlPitch, ElecPwr, LSS_Spd, TwrAccel, NB, ZTime, DT, DirRoot, TFOutput ) - - - ! This routine reads a data file containing user specified transfer - ! function information to allow the use of control systems in FAST - ! and ADAMS. The parameters read in, and array dimensions may be - ! adjusted to suit the users need. - ! The transfer function coefficients are read in, then converted to - ! state space form for integration using a fourth order Runge-Kutta - ! integration scheme. - ! This routine was originally written by C. Hansen in Fortran 77 for - ! use with FAST and ADAMS. It was converted to Modern Fortran by - ! J. Jonkman. - - -USE NWTC_Library - - -IMPLICIT NONE - - - ! Passed variables: - -INTEGER , INTENT(IN ) :: NB ! Number of blades. - -REAL(ReKi), INTENT(IN ) :: BlPitch (NB) ! Current values of the blade pitch angles (rad) -REAL(DbKi), INTENT(IN ) :: DT ! Integration time step (sec) -REAL(ReKi), INTENT(IN ) :: ElecPwr ! Electrical power (watts) -REAL(ReKi), INTENT(IN ) :: LSS_Spd ! LSS speed (rad/s) -REAL(ReKi), INTENT(OUT) :: TFOutput(NB) ! Desired pitch angles returned by this subroutine (rad) -REAL(ReKi), INTENT(IN ) :: TwrAccel ! Tower top acceleration (m/s^2) -REAL(DbKi), INTENT(IN ) :: ZTime ! Current simulation time (sec) - -CHARACTER(1024), INTENT(IN ) :: DirRoot ! The name of the root file including the full path to the current working directory. This may be useful if you want this routine to write a permanent record of what it does to be stored with the simulation results: the results should be stored in a file whose name (including path) is generated by appending any suitable extension to DirRoot. - - - ! Local Variables: - - ! NOTE: If the values of MSZ OR NSZ are changed, the PARAMETER - ! statements in TFSISO must also be changed to match. -INTEGER , PARAMETER :: MSZ = 12 ! Larger than highest order of transfer function; also used to size number of constants CNST -INTEGER , PARAMETER :: NSZ = 4 ! Number of transfer functions we will use - -REAL(ReKi) :: A0 -REAL(ReKi), SAVE :: AC (MSZ,NSZ) -REAL(ReKi), SAVE :: BC (0:MSZ,NSZ) -REAL(ReKi), SAVE :: CNST (MSZ) ! Maximum of MSZ constants -REAL(ReKi) :: TFInput ! Input to the transfer function -REAL(ReKi), SAVE :: TPCOn ! Time to enable active pitch control. -REAL(ReKi) :: SUM - -INTEGER , SAVE :: CntrlRgn ! Control region (CntrlRgn = 2 = power control, CntrlRgn = 3 = speed control) -INTEGER :: I -INTEGER :: J -INTEGER :: NCNST -INTEGER , SAVE :: NORDER (NSZ) -INTEGER :: NR -INTEGER :: NTEMP - -LOGICAL, SAVE :: INITFLAG = .TRUE. - -CHARACTER(80) :: DESCRIP -CHARACTER( 3) :: FmtText = '(A)' ! Format for outputting pure text. - -CHARACTER(1024) :: PitchFileName ! the name of the input control file -INTEGER(IntKi) :: ErrStat -CHARACTER(ErrMsgLen) :: ErrMsg - - -IF ( INITFLAG ) THEN - - - ! Save the value of time in which pitch control is first activated: - - TPCOn = REAL( ZTime, ReKi) - - ! Read control parameters from 'pitch.ipt' if control is employed - I = INDEX( DirRoot, PathSep, BACK=.TRUE. ) - IF ( I < LEN_TRIM(DirRoot) .OR. I > 0 ) THEN - PitchFileName = DirRoot(1:I)//'pitch.ipt' - ELSE - PitchFileName = 'pitch.ipt' - END IF - - - CALL OpenFInpFile ( 86, TRIM(PitchFileName), ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) CALL ProgAbort(TRIM(ErrMsg)) - - - READ(86,FmtText) DESCRIP - - CALL WrScr1( '***********************************************' ) - CALL WrScr( 'Running with control option using data from:' ) - CALL WrScr( TRIM(DESCRIP) ) - CALL WrScr( '***********************************************' ) - CALL WrScr( ' ' ) - - READ(86,*) CntrlRgn - - - READ(86,*) NCNST - - DO I = 1,NCNST - READ(86,*,END=20) CNST(I) - ENDDO - - NR = 1 - - -10 READ(86,*,END=40) NTEMP ! Use NTEMP to avoid array overflow at end of file - NORDER(NR) = NTEMP - READ(86,*,END=30) (BC(I,NR), I = NORDER(NR),0,-1) - READ(86,*,END=30) (AC(I,NR), I = NORDER(NR),1,-1), A0 - - IF ( ABS(A0) > 1.E-7 ) THEN - DO I = 0,NORDER(NR) - BC(I,NR) = BC(I,NR)/A0 - ENDDO - DO I = 1,NORDER(NR) - AC(I,NR) = AC(I,NR)/A0 - ENDDO - ELSE - CALL ProgAbort ( 'Coefficient of largest power of s in the denominator must not be zero.' ) - ENDIF - - - ! Calculate coefficients for state space model - - DO I = 1,NORDER(NR) - SUM = 0.0 - DO J = 1,I - SUM = SUM - AC(J,NR)*BC(I-J,NR) - ENDDO - BC(I,NR) = BC(I,NR) + SUM - ENDDO - - - NR = NR + 1 - - - GOTO 10 - -20 CALL WrScr( 'Error while reading constants from pitch.ipt file' ) - CALL WrScr( 'Encountered end of file while reading constants' ) - CALL WrScr( 'Number of constants expected: '//TRIM(Num2LStr(NCNST)) ) - CALL WrScr( 'Number of constants found: '//TRIM(Num2LStr(I-1 )) ) - CALL ProgAbort( 'Check your pitch.ipt file.' ) - - -30 CALL WrScr( 'Error in specification of transfer function #'//TRIM(Num2LStr(NR)) ) - CALL ProgAbort( 'Check your pitch.ipt file.' ) - - -40 CONTINUE - - - ! Always require that NSZ transfer functions are input to help - ! ensure correct input file for this version of code - - IF( NR-1 /= NSZ ) THEN - CALL WrScr( 'Error in pitch.ipt file' ) - CALL WrScr( 'Incorrect number of transfer functions ' ) - CALL WrScr( 'Number that were read: '//TRIM(Num2LStr(NR-1)) ) - CALL WrScr( 'Number that were expected: '//TRIM(Num2LStr(NSZ )) ) - CALL ProgAbort( 'Check your pitch.ipt file.' ) - ENDIF - - - INITFLAG = .FALSE. - - CLOSE(86) - - - RETURN - - -ENDIF ! Initialization - - - ! Determine the Transfer Function Input, TFInput, based on specified control - ! region: - -SELECT CASE ( CntrlRgn ) ! Which control region are we in? - -CASE ( 2 ) ! Region 2 control = power control - - TFInput = 0.001*ElecPwr ! Electric power, kW - -CASE ( 3 ) ! Region 3 control = speed control - -! TFInput = HSS_Spd/ABS(GBRatio)*RPS2RPM ! LSS speed at gearbox entrance, rpm - TFInput = LSS_Spd*RPS2RPM ! LSS speed at gearbox entrance, rpm - - -CASE DEFAULT ! None of the above - - CALL ProgAbort ( ' CntrlRgn must be 2 or 3.' ) - - -ENDSELECT - - - ! Use the control routine - -CALL CTRL4 ( CNST, AC, BC, NORDER, MSZ, NSZ, & - TFOutput, BlPitch, TFInput, TwrAccel, NB, ZTime, TPCOn ) - - - -RETURN -END SUBROUTINE PitchCntrl -!======================================================================= -SUBROUTINE CTRL4 ( CNST, AC, BC, NORDER, MSZ, NSZ, & - TFOutput, BlPitch, TFInput, TwrAccel, NB, ZTime, TPCOn ) - - - ! In this subroutine dependencies between transfer functions, as well - ! as inputs and outputs of transfer functions are defined. For the - ! call to TFSISO the user need only be concerned with the first - ! three arguments. The first argument is the transfer fuction - ! input, the second is the transfer function output, the third - ! specifies the transfer function number, with the number - ! coresponding to the order in which the transfer functions were - ! read from the input file. - - -USE NWTC_Library - -IMPLICIT NONE - - - ! Passed variables: - -INTEGER , INTENT(IN ) :: MSZ -INTEGER , INTENT(IN ) :: NB ! Number of blades. -INTEGER , INTENT(IN ) :: NSZ - -REAL(ReKi), INTENT(IN ) :: AC (MSZ,NSZ) -REAL(ReKi), INTENT(IN ) :: BC (0:MSZ,NSZ) -REAL(ReKi), INTENT(IN ) :: BlPitch (NB) ! Current blade pitch. -REAL(ReKi), INTENT(IN ) :: CNST (MSZ) -REAL(ReKi), INTENT(IN ) :: TFInput -REAL(ReKi), INTENT(OUT) :: TFOutput(NB) -REAL(ReKi), INTENT(IN ) :: TPCOn ! Time to enable active pitch control. -REAL(ReKi), INTENT(IN ) :: TwrAccel -REAL(DbKi), INTENT(IN ) :: ZTime ! Current simulation time. - -INTEGER , INTENT(IN ) :: NORDER (NSZ) - - - ! Local variables: - -REAL(ReKi) :: AWIND = 0.0 -REAL(ReKi) :: DTSTRT -REAL(ReKi) :: DTCNTRL -REAL(ReKi) :: GAINSCHED -REAL(ReKi) :: GSCoef -REAL(ReKi) :: GSExp -REAL(ReKi) :: GSPit1 -REAL(ReKi) :: GSPit2 -REAL(ReKi) :: OLDTIME = 0.0 ! Previous time we changed the pitch angle, sec -REAL(ReKi) :: OLDTFOUTPUT -REAL(ReKi), PARAMETER :: OnePlusEps = 1.0 + EPSILON(OnePlusEps) ! The number slighty greater than unity in the precision of ReKi. -REAL(ReKi) :: PHI0 -REAL(ReKi) :: PHI1 -REAL(ReKi) :: PHI2 -REAL(ReKi) :: PITMAX -REAL(ReKi) :: PITMIN -REAL(ReKi) :: TWROUTPUT -REAL(ReKi) :: U1 -REAL(ReKi) :: U2 -REAL(ReKi) :: X - -INTEGER :: DEBUGFLAG -INTEGER :: K ! Blade number - -LOGICAL :: TRIMFLAG = .TRUE. ! Initialization flag - -CHARACTER( 8) :: Frmt1 = '(20(:A))' -CHARACTER(14) :: Frmt2 = '(20(:G12.5,A))' -INTEGER(IntKi) :: ErrStat -CHARACTER(ErrMsgLen) :: ErrMsg - - -SAVE ! mlb - Do we need to save everything? - - - - ! Enter variables which need to be initialized after trim solution here - -IF ( TRIMFLAG ) THEN - - - PHI0 = BlPitch(1)*R2D ! Initial pitch angle (deg) - OLDTFOUTPUT = BlPitch(1) - TRIMFLAG = .FALSE. - - - ! Assign variable values from the pitch.ipt file - - PITMIN = CNST( 4) ! Minimum pitch angle, deg - PITMAX = CNST( 5) ! Maximum pitch angle, deg - DTCNTRL = CNST( 6) ! Time interval for pitch control, sec - GSPit1 = CNST( 7) ! Pitch angle for start of gain scheduling (>0), rad - GSPit2 = CNST( 8) ! Pitch angle for end of gain scheduling, rad - GSCoef = CNST( 9) ! constant 'a' in gain schedule power law ( GS = a * x**p) - GSExp = CNST(10) ! exponent 'p' in gain schedule power law ( GS = a * x**p) - DEBUGFLAG = CNST(11) ! Debug file output (0=no, 1=yes) - - - ! Open file to receive control variable output for debug (if desired) - - IF( DEBUGFLAG == 1 ) THEN - - CALL OpenFOutFile (40, 'pitcntrl.plt', ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) CALL ProgAbort(TRIM(ErrMsg)) - WRITE (40,"( / 'This file was generated by ' , A , A , ' on ' , A , ' at ' , A , '.' / )") & - TRIM(ProgName), TRIM( ProgVer ), CurDate(), CurTime() - - WRITE(40,*) 'Output of PITCH control control subroutine' - WRITE(40,*) 'Gain schedule coeffs = ', GSCoef, GSExp - - WRITE(40,Frmt1) & - 'Time', TAB, & - 'Pitch', TAB, & - 'TFInput', TAB, & - 'TwrAccel', TAB, & - 'TWROUTPUT', TAB, & - 'Input1U1', TAB, & - 'OutputPHI0', TAB, & - 'OutputPHI1', TAB, & - 'OutputPHI2', TAB, & - 'PitchOutput', TAB, & - 'GainSched', TAB, & - 'Awindup' - - ENDIF - - -ENDIF - - -!check for numerical stability -!print *, REAL(ZTime,ReKi) - OLDTIME, (REAL(ZTime,ReKi) - OLDTIME < DTCNTRL ) , EqualRealNos( REAL(ZTime,ReKi), OldTime+DtCntrl ) -IF ( .NOT. EqualRealNos( REAL(ZTime,ReKi), OldTime+DtCntrl ) ) THEN - IF( REAL(ZTime,ReKi) - OLDTIME < DTCNTRL ) THEN ! Time check needed for FAST -!old IF( REAL(ZTime,ReKi) - OLDTIME < DTCNTRL ) THEN ! Time check needed for FAST -!new: IF( ZTime*OnePlusEps - OLDTIME < DTCNTRL ) THEN ! Time check needed for FAST - DO K = 1,NB - TFOutput(K) = OLDTFOUTPUT - ENDDO ! K - RETURN - END IF -ENDIF - - -OLDTIME = REAL(ZTime,ReKi) - - - ! Apply gain scheduling based on measured pitch angle (rad) - -X = SAT2( BlPitch(1), GSPit1, GSPit2 ) ! Use endpoints if outside the endpoints -GAINSCHED = GSCoef*( X**GSExp ) - - - ! Ramp the gains up from zero to the desired values during startup - ! The intent is to avoid controller problems due to startup transients - -DTSTRT = ZTime - TPCOn + 0.01 ! Avoid zero gain by using offset -IF( DTSTRT < 5.0 ) GAINSCHED = GAINSCHED * DTSTRT / 5.0 - - - ! First TF input is error * gain - -U1 = GAINSCHED * CNST(1) * ( CNST(2) - TFInput ) -U2 = GAINSCHED * CNST(3) * AWIND - - - ! U1 = Input to transfer function (rotor RPM or kW error, depending upon PCHMODE) - ! PHI0 = Output of transfer function = pitch in degrees - ! Third argument = number or ID of transfer function - ! First transfer function is integral term of PID pitch demand control - -CALL TFSISO( U1-U2, PHI0, 1, AC, BC, DTCNTRL, NORDER, MSZ, NSZ ) - - - ! Second transfer function is PD terms of PID pitch demand control - ! NOTE: The antiwindup term is not included here - -CALL TFSISO( U1 , PHI1, 2, AC, BC, DTCNTRL, NORDER, MSZ, NSZ ) - - - ! Add these two to get pitch demand control output - -PHI1 = PHI0 + PHI1 - - - ! Now apply third transfer function to represent tower acceleration - ! feedback. If order of 3rd transfer function is zero, this - ! transfer function is not applied. - -IF ( NORDER(3) == 0 ) THEN - TWROUTPUT = 0.0 -ELSE - CALL TFSISO( TwrAccel, TWROUTPUT, 3, AC, BC, DTCNTRL, NORDER, MSZ, NSZ ) -ENDIF - - - ! Add pitch demand from tower accel. to that from speed/power error - -PHI1 = PHI1 + TWROUTPUT - - - ! SAT2 function ensures that the pitch angle demand does not go - ! beyond limits (2nd and 3rd arguments in degrees) - -PHI2 = SAT2( PHI1, PITMIN, PITMAX ) ! Pitch angle, deg - -AWIND = PHI1 - PHI2 ! Anti windup term when pitch demand saturates, deg - - - ! Now apply fourth transfer function to represent the actuator - ! (Do not use this actuator in ADAMS. If order of 4th - ! transfer function is zero, this transfer function is not applied) - -IF ( NORDER(4) == 0 ) THEN - DO K=1,NB - TFOutput(K) = PHI2 - ENDDO ! K -ELSE - CALL TFSISO( PHI2, TFOutput(1), 4, AC, BC, DTCNTRL, NORDER, MSZ, NSZ ) - TFOutput = TFOutput(1) ! All blades use same pitch in this version -ENDIF - - -DO K=1,NB - TFOutput(K) = TFOutput(K)*D2R ! Pitch angle returned by subroutine, rad -ENDDO ! K - - -OLDTFOUTPUT = TFOutput(1) ! Save for use until next control time - - - ! Write to controller output file if desired. - -IF ( DEBUGFLAG == 1 ) THEN - WRITE(40,Frmt2) & - ZTime, TAB, & - BlPitch(1)*R2D, TAB, & - TFInput, TAB, & - TwrAccel, TAB, & - TWROUTPUT, TAB, & - U1, TAB, & - PHI0, TAB, & - PHI1, TAB, & - PHI2, TAB, & - TFOutput(1)*R2D, TAB, & - GAINSCHED, TAB, & - AWIND -ENDIF - - - -RETURN -END SUBROUTINE CTRL4 -!======================================================================= -SUBROUTINE TFSISO ( U, Y, NR, AC, BC, DT, NORDER, MSZ, NSZ ) - - - ! This routine integrates the transfer functions using a fourth order - ! Runge-Kutta method. - - -USE NWTC_Library - - -IMPLICIT NONE - - - ! Passed variables: - -INTEGER , INTENT(IN ) :: MSZ -INTEGER , INTENT(IN ) :: NSZ - -REAL(ReKi), INTENT(IN ) :: AC (MSZ,NSZ) -REAL(ReKi), INTENT(IN ) :: BC (0:MSZ,NSZ) -REAL(ReKi), INTENT(IN ) :: DT -REAL(ReKi), INTENT(IN ) :: U -REAL(ReKi), INTENT(OUT) :: Y - -INTEGER , INTENT(IN ) :: NORDER (NSZ) -INTEGER , INTENT(IN ) :: NR - - - ! Local variables: - - ! NOTE: If the values of M OR N are changed, the PARAMETER - ! statements in PitchCntrl must also be changed to match. -INTEGER , PARAMETER :: M = 12 ! Larger than highest order of transfer function; also used to size number of constants CNST -INTEGER , PARAMETER :: N = 4 ! Number of transfer functions we will use - -REAL(ReKi) :: DT6 -REAL(ReKi) :: DXDT (MSZ) -REAL(ReKi) :: DXM (MSZ) -REAL(ReKi) :: DXT (MSZ) -REAL(ReKi) :: HDT -REAL(ReKi) :: X (M,N) = 0.0 -REAL(ReKi) :: XT (MSZ) - -INTEGER :: I - -LOGICAL :: INITFLAG(N) = .TRUE. - - - -IF ( INITFLAG(NR) ) THEN - CALL TFINIT( U, Y, X, AC, BC, NORDER, NSZ, MSZ, NR ) - IF( ( NSZ /= N ) .OR. ( MSZ /= M ) ) THEN - PRINT*, 'ERROR IN PARAMETERS M AND/OR N IN TFSISO' - ENDIF - INITFLAG(NR) = .FALSE. -ENDIF - - -HDT = 0.5*DT -DT6 = DT/6.0 - - -DO I = 1,NORDER(NR) - XT(I) = X(I,NR) -ENDDO - - -CALL XDOT( U, XT, AC, BC, DXDT, NORDER, NSZ, MSZ, NR ) -DO I = 1,NORDER(NR) - XT(I) = X(I,NR) + HDT*DXDT(I) -ENDDO - - -CALL XDOT( U, XT, AC, BC, DXT, NORDER, NSZ, MSZ, NR ) -DO I = 1,NORDER(NR) - XT(I) = X(I,NR) + HDT*DXT (I) -ENDDO - - -CALL XDOT( U, XT, AC, BC, DXM, NORDER, NSZ, MSZ, NR ) -DO I = 1,NORDER(NR) - XT(I) = X(I,NR) + DT*DXM (I) - DXM(I) = DXT(I) + DXM(I) -ENDDO - - -CALL XDOT( U, XT, AC, BC, DXT, NORDER, NSZ, MSZ, NR ) -DO I = 1,NORDER(NR) - X(I,NR) = X(I,NR) + DT6*( DXDT(I) + DXT(I) +2.0*DXM(I) ) -ENDDO - - -Y = X(1,NR) + BC(0,NR)*U - - - -RETURN -END SUBROUTINE TFSISO -!======================================================================= -SUBROUTINE XDOT ( U, X, AC, BC, DXDT, NORDER, NSZ, MSZ, NR ) - - - ! This routine calculates derivatives for fourth order Runge-Kutta. - - -USE NWTC_Library - - -IMPLICIT NONE - - - ! Passed variables: - -INTEGER , INTENT(IN ) :: MSZ -INTEGER , INTENT(IN ) :: NSZ - -REAL(ReKi), INTENT(IN ) :: AC (MSZ,NSZ) -REAL(ReKi), INTENT(IN ) :: BC (0:MSZ,NSZ) -REAL(ReKi), INTENT(OUT) :: DXDT (MSZ) -REAL(ReKi), INTENT(IN ) :: U -REAL(ReKi), INTENT(IN ) :: X (MSZ) - -INTEGER , INTENT(IN ) :: NORDER (NSZ) -INTEGER , INTENT(IN ) :: NR - - - ! Local variables: - -REAL(ReKi) :: SUM - -INTEGER :: I - - - - ! Derivatives: - -DO I = 1,NORDER(NR)-1 - DXDT(I) = X(I+1) + BC(I,NR)*U -ENDDO - - -SUM = 0.0 -DO I = 1,NORDER(NR) - SUM = SUM - X(I)*AC( NORDER(NR) + 1 - I, NR ) -ENDDO - - -DXDT(NORDER(NR)) = SUM + BC(NORDER(NR),NR)*U - - - -RETURN -END SUBROUTINE XDOT -!======================================================================= -SUBROUTINE TFINIT ( U, Y, X, AC, BC, NORDER, NSZ, MSZ, NR ) - - - ! This routine initialize states for fourth order Runge-Kutta. - - -USE NWTC_Library - - -IMPLICIT NONE - - - ! Passed variables: - -INTEGER , INTENT(IN ) :: MSZ -INTEGER , INTENT(IN ) :: NSZ - -REAL(ReKi), INTENT(IN ) :: AC (MSZ,NSZ) -REAL(ReKi), INTENT(IN ) :: BC (0:MSZ,NSZ) -REAL(ReKi), INTENT(IN ) :: U -REAL(ReKi), INTENT(OUT) :: X (MSZ,NSZ) -REAL(ReKi), INTENT(IN ) :: Y - -INTEGER , INTENT(IN ) :: NORDER (NSZ) -INTEGER , INTENT(IN ) :: NR - - - ! Local variables: - -REAL(ReKi) :: SUM - -INTEGER :: I - - - -X(1,NR) = Y - BC(0,NR)*U -DO I = 1,NORDER(NR)-1 - X(I+1,NR) = -BC(I,NR)*U -ENDDO - - -SUM = 0.0 -DO I = 1,NORDER(NR)-1 - SUM = SUM - X(I,NR)*AC( NORDER(NR) + 1 - I, NR ) -ENDDO - - - ! Watch out for zero values of AC - -IF( AC(1,NR) /= 0.0 ) THEN - X(NORDER(NR),NR) = ( -SUM - BC(NORDER(NR),NR)*U )/AC(1,NR) -ELSE - X(NORDER(NR),NR) = ( -SUM - BC(NORDER(NR),NR)*U )/0.001 -ENDIF - - - -RETURN -END SUBROUTINE TFINIT -!======================================================================= -FUNCTION SAT2 ( X, XMIN, XMAX ) - - - ! Saturation function. - - -USE NWTC_Library - - -IMPLICIT NONE - - - ! Passed variables: - -REAL(ReKi) :: SAT2 -REAL(ReKi), INTENT(IN ) :: X -REAL(ReKi), INTENT(IN ) :: XMAX -REAL(ReKi), INTENT(IN ) :: XMIN - - - -IF ( X > XMAX ) THEN - SAT2 = XMAX -ELSEIF ( X < XMIN ) THEN - SAT2 = XMIN -ELSE - SAT2 = X -ENDIF - - - -RETURN -END FUNCTION SAT2 -!======================================================================= -FUNCTION DEADBAND ( X, XMIN, XMAX ) - - - ! Deadband function. - - -USE NWTC_Library - - -IMPLICIT NONE - - - ! Passed variables: - -REAL(ReKi) :: DEADBAND -REAL(ReKi), INTENT(IN ) :: X -REAL(ReKi), INTENT(IN ) :: XMAX -REAL(ReKi), INTENT(IN ) :: XMIN - - - -IF ( X > XMAX ) THEN - DEADBAND = X - XMAX -ELSEIF ( X < XMIN ) THEN - DEADBAND = X - XMIN -ELSE - DEADBAND = 0.0 -ENDIF - - - -RETURN -END FUNCTION DEADBAND -!======================================================================= -end module PitchCntrl_ACH - \ No newline at end of file diff --git a/OpenFAST/modules/servodyn/src/ServoDyn.f90 b/OpenFAST/modules/servodyn/src/ServoDyn.f90 deleted file mode 100644 index 615d6d17a..000000000 --- a/OpenFAST/modules/servodyn/src/ServoDyn.f90 +++ /dev/null @@ -1,3569 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2013-2016 National Renewable Energy Laboratory -! -! This file is part of FAST's Controls and Electrical Drive Module, "ServoDyn". -! -! 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. -! -!********************************************************************************************************************************** -!> Control and electrical drive dynamics module for FAST -MODULE ServoDyn - - USE ServoDyn_Types - USE NWTC_Library - USE BladedInterface - USE StrucCtrl - USE ServoDyn_IO - - USE UserVSCont_KP ! <- module not in the FAST Framework! - USE PitchCntrl_ACH ! <- module not in the FAST Framework! - USE UserSubs ! <- module not in the FAST Framework! - - IMPLICIT NONE - - PRIVATE - - TYPE(ProgDesc), PARAMETER :: SrvD_Ver = ProgDesc( 'ServoDyn', '', '' ) - -#ifdef COMPILE_SIMULINK - LOGICAL, PARAMETER, PUBLIC :: Cmpl4SFun = .TRUE. ! Is the module being compiled as an S-Function for Simulink? -#else - LOGICAL, PARAMETER, PUBLIC :: Cmpl4SFun = .FALSE. ! Is the module being compiled as an S-Function for Simulink? -#endif - -#ifdef COMPILE_LABVIEW - LOGICAL, PARAMETER, PUBLIC :: Cmpl4LV = .TRUE. ! Is the module being compiled for Labview? -#else - LOGICAL, PARAMETER, PUBLIC :: Cmpl4LV = .FALSE. ! Is the module being compiled for Labview? -#endif - - ! indices into linearization arrays - INTEGER, PARAMETER :: Indx_u_Yaw = 1 - INTEGER, PARAMETER :: Indx_u_YawRate = 2 - INTEGER, PARAMETER :: Indx_u_HSS_Spd = 3 - - INTEGER, PARAMETER, PUBLIC :: SrvD_Indx_Y_BlPitchCom(3) = (/1,2,3/) - INTEGER, PARAMETER, PUBLIC :: SrvD_Indx_Y_YawMom = 4 - INTEGER, PARAMETER, PUBLIC :: SrvD_Indx_Y_GenTrq = 5 - INTEGER, PARAMETER, PUBLIC :: SrvD_Indx_Y_ElecPwr = 6 - INTEGER, PARAMETER, PUBLIC :: SrvD_Indx_Y_WrOutput = 6 ! last non-writeoutput variable - - - ! Parameters for type of control - - INTEGER(IntKi), PARAMETER :: ControlMode_NONE = 0 !< The (ServoDyn-universal) control code for not using a particular type of control - INTEGER(IntKi), PARAMETER :: ControlMode_SIMPLE = 1 !< The (ServoDyn-universal) control code for obtaining the control values from a simple built-in controller - INTEGER(IntKi), PARAMETER :: ControlMode_ADVANCED = 2 !< The (ServoDyn-universal) control code for not using the control values from an advanced built-in controller (or just a different simple model?) - INTEGER(IntKi), PARAMETER :: ControlMode_USER = 3 !< The (ServoDyn-universal) control code for obtaining the control values from a user-defined routine - INTEGER(IntKi), PARAMETER :: ControlMode_EXTERN = 4 !< The (ServoDyn-universal) control code for obtaining the control values from Simulink or Labivew - INTEGER(IntKi), PARAMETER :: ControlMode_DLL = 5 !< The (ServoDyn-universal) control code for obtaining the control values from a Bladed-Style dynamic-link library - - INTEGER(IntKi), PARAMETER, PUBLIC :: TrimCase_none = 0 - INTEGER(IntKi), PARAMETER, PUBLIC :: TrimCase_yaw = 1 - INTEGER(IntKi), PARAMETER, PUBLIC :: TrimCase_torque = 2 - INTEGER(IntKi), PARAMETER, PUBLIC :: TrimCase_pitch = 3 - - ! ..... Public Subroutines ................................................................................................... - - PUBLIC :: SrvD_Init ! Initialization routine - PUBLIC :: SrvD_End ! Ending routine (includes clean up) - - PUBLIC :: SrvD_UpdateStates ! Loose coupling routine for solving for constraint states, integrating - ! continuous states, and updating discrete states - PUBLIC :: SrvD_CalcOutput ! Routine for computing outputs - - PUBLIC :: SrvD_CalcConstrStateResidual ! Tight coupling routine for returning the constraint state residual - PUBLIC :: SrvD_CalcContStateDeriv ! Tight coupling routine for computing derivatives of continuous states - PUBLIC :: SrvD_UpdateDiscState ! Tight coupling routine for updating discrete states - - PUBLIC :: SrvD_JacobianPInput ! Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- - ! (Xd), and constraint-state (Z) equations all with respect to the inputs (u) - PUBLIC :: SrvD_JacobianPContState ! Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- - ! (Xd), and constraint-state (Z) equations all with respect to the continuous - ! states (x) - PUBLIC :: SrvD_JacobianPDiscState ! Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- - ! (Xd), and constraint-state (Z) equations all with respect to the discrete - ! states (xd) - PUBLIC :: SrvD_JacobianPConstrState ! Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- - ! (Xd), and constraint-state (Z) equations all with respect to the constraint - ! states (z) - PUBLIC :: SrvD_GetOP ! Routine to pack the operating point values (for linearization) into arrays - - -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 SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(SrvD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine - TYPE(SrvD_InputType), INTENT( OUT) :: u !< An initial guess for the input; input mesh must be defined - TYPE(SrvD_ParameterType), INTENT( OUT) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT( OUT) :: x !< Initial continuous states - TYPE(SrvD_DiscreteStateType), INTENT( OUT) :: xd !< Initial discrete states - TYPE(SrvD_ConstraintStateType), INTENT( OUT) :: z !< Initial guess of the constraint states - TYPE(SrvD_OtherStateType), INTENT( OUT) :: OtherState !< Initial other states - TYPE(SrvD_OutputType), INTENT( OUT) :: y !< Initial system outputs (outputs are not calculated; - !! only the output mesh is initialized) - TYPE(SrvD_MiscVarType), INTENT( OUT) :: m !< Initial misc (optimization) variables - REAL(DbKi), INTENT(INOUT) :: Interval !< Coupling interval in seconds: the rate that - !! (1) SrvD_UpdateStates() is called in loose coupling & - !! (2) SrvD_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. - TYPE(SrvD_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 - - character(1024) :: PriPath ! Path name of the primary file - type(FileInfoType) :: FileInfo_In !< The derived type for holding the full input file for parsing -- we may pass this in the future - TYPE(SrvD_InputFile) :: InputFileData ! Data stored in the module's input file - TYPE(StC_InitInputType) :: StC_InitInp ! data to initialize StC module - TYPE(StC_InitOutputType) :: StC_InitOut ! data from StC module initialization (not used) - INTEGER(IntKi) :: i ! loop counter - INTEGER(IntKi) :: j ! loop counter - INTEGER(IntKi) :: K ! loop counter - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - character(*), parameter :: RoutineName = 'SrvD_Init' - - - - ! Initialize variables - - ErrStat = ErrID_None - ErrMsg = "" - - - ! Initialize the NWTC Subroutine Library - - CALL NWTC_Init( EchoLibVer=.FALSE. ) - - ! Display the module information - - CALL DispNVD( SrvD_Ver ) - CALL GetPath( InitInp%InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - - !............................................................................................ - ! Read the input file and validate the data - ! (note p%NumBl and p%RootName must be set first!) - !............................................................................................ - p%RootName = InitInp%Rootname ! FAST adds the '.SrvD' before calling this module - p%NumBl = InitInp%NumBl - - if (InitInp%UseInputFile) then - ! Read the entire input file, minus any comment lines, into the FileInfo_In - ! data structure in memory for further processing. - call ProcessComFile( InitInp%InputFile, FileInfo_In, ErrStat2, ErrMsg2 ) - else - ! put passed string info into the FileInfo_In -- FileInfo structure - call NWTC_Library_CopyFileInfoType( InitInp%PassedPrimaryInputData, FileInfo_In, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - endif - if (Failed()) return; - - ! For diagnostic purposes, the following can be used to display the contents - ! of the FileInfo_In data structure. - ! call Print_FileInfo_Struct( CU, FileInfo_In ) ! CU is the screen -- different number on different systems. - - ! Parse the FileInfo_In structure of data from the inputfile into the InitInp%InputFile structure - CALL ParseInputFileInfo( PriPath, InitInp%InputFile, TRIM(InitInp%RootName), FileInfo_In, InputFileData, Interval, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - CALL ValidatePrimaryData( InitInp, InputFileData, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - !............................................................................................ - ! Define parameters here: - !............................................................................................ - CALL SrvD_SetParameters( InputFileData, p, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - ! Set and verify BlPitchInit, which comes from InitInputData (not the inputfiledata) - CALL AllocAry( p%BlPitchInit, p%NumBl, 'BlPitchInit', ErrStat2, ErrMsg2 ) - if (Failed()) return; - p%BlPitchInit = InitInp%BlPitchInit - - IF ( ANY( p%BlPitchInit <= -pi ) .OR. ANY( p%BlPitchInit > pi ) ) THEN - call SetErrStat( ErrID_Fatal, 'BlPitchInit must be in the range (-pi,pi] radians (i.e., (-180,180] degrees).',ErrStat,ErrMsg,RoutineName) - call Cleanup() - END IF - - !............................................................................................ - ! Define initial system states here: - !............................................................................................ - - x%DummyContState = 0.0_ReKi - z%DummyConstrState = 0.0_ReKi - - CALL AllocAry( m%xd_BlPitchFilter, p%NumBl, 'BlPitchFilter', ErrStat2, ErrMsg2 ) - if (Failed()) return; - m%xd_BlPitchFilter = p%BlPitchInit - - !....................... - ! Other states for pitch maneuver - !....................... - CALL AllocAry( OtherState%BegPitMan, p%NumBl, 'BegPitMan', ErrStat2, ErrMsg2 ) - if (Failed()) return; - OtherState%BegPitMan = .false. ! Pitch maneuvers didn't actually start, yet - - CALL AllocAry( OtherState%BlPitchI, p%NumBl, 'BlPitchI', ErrStat2, ErrMsg2 ) - if (Failed()) return; - OtherState%BlPitchI = 0.0_ReKi - - CALL AllocAry( OtherState%TPitManE, p%NumBl, 'TPitManE', ErrStat2, ErrMsg2 ) - if (Failed()) return; - OtherState%TPitManE = 0.0_DbKi - - !....................... - ! Other states for yaw maneuver - !....................... - OtherState%BegYawMan = .false. ! Yaw maneuver didn't actually start, yet - OtherState%NacYawI = 0.0_ReKi - OtherState%TYawManE = 0.0_ReKi - - !....................... - ! other states for torque control: - !....................... - OtherState%Off4Good = .false. ! generator is not off for good - ! is the generator online at initialization? - IF ( p%GenTiStr .and. p%TimGenOn <= 0.0_ReKi ) THEN ! Start-up of generator determined by time, TimGenOn - OtherState%GenOnLine = .true. - ELSE - OtherState%GenOnLine = .false. - END IF - - - !............................................................................................ - ! Define initial guess for the system inputs here: - !............................................................................................ - - CALL AllocAry( u%BlPitch, p%NumBl, 'BlPitch', ErrStat2, ErrMsg2 ) - if (Failed()) return; - - CALL AllocAry( u%ExternalBlPitchCom, p%NumBl, 'ExternalBlPitchCom', ErrStat2, ErrMsg2 ) - if (Failed()) return; - - IF ( (InitInp%NumSC2CtrlGlob > 0) .or. (InitInp%NumSC2Ctrl > 0) .or. (InitInp%NumCtrl2SC > 0) ) THEN - p%UseSC = .TRUE. - ElSE - p%UseSC = .FALSE. - END IF - - IF (p%UseBladedInterface) THEN - CALL AllocAry( u%fromSC, InitInp%NumSC2Ctrl, 'u%fromSC', ErrStat2, ErrMsg2 ) - if (Failed()) return; - if (InitInp%NumSC2Ctrl > 0 ) then - u%fromSC = InitInp%fromSC - end if - END IF - - IF (p%UseBladedInterface) THEN - CALL AllocAry( u%fromSCglob, InitInp%NumSC2CtrlGlob, 'u%fromSCglob', ErrStat2, ErrMsg2 ) - if (Failed()) return; - if (InitInp%NumSC2CtrlGlob > 0) then - u%fromSCglob = InitInp%fromSCGlob - end if - END IF - - u%BlPitch = p%BlPitchInit(1:p%NumBl) - - u%Yaw = p%YawNeut - u%YawRate = 0.0 - - u%LSS_Spd = 0.0 - u%HSS_Spd = 0.0 - u%RotSpeed = 0.0 - - u%ExternalYawPosCom = p%YawNeut - u%ExternalYawRateCom = 0. - u%ExternalBlPitchCom = p%BlPitchInit(1:p%NumBl) - u%ExternalGenTrq = 0. - u%ExternalElecPwr = 0. - u%ExternalHSSBrFrac = 0. - - u%TwrAccel = 0. - u%YawErr = 0. - u%WindDir = 0. - - !Inputs for the Bladed Interface: - u%RootMyc(:) = 0. ! Hardcoded to 3 - u%YawBrTAxp = 0. - u%YawBrTAyp = 0. - u%LSSTipPxa = 0. - u%RootMxc(:)= 0. ! Hardcoded to 3 - u%LSSTipMxa = 0. - u%LSSTipMya = 0. - u%LSSTipMza = 0. - u%LSSTipMys = 0. - u%LSSTipMzs = 0. - u%YawBrMyn = 0. - u%YawBrMzn = 0. - u%NcIMURAxs = 0. - u%NcIMURAys = 0. - u%NcIMURAzs = 0. - u%RotPwr = 0. - u%HorWindV = 0. - u%YawAngle = 0. - m%dll_data%ElecPwr_prev = 0. - m%dll_data%GenTrq_prev = 0. - - !............................................................................................ - ! Define system output initializations (set up mesh) here: - !............................................................................................ - CALL AllocAry( y%BlPitchCom, p%NumBl, 'BlPitchCom', ErrStat2, ErrMsg2 ) - if (Failed()) return; - - ! 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 - CALL AllocAry( y%BlAirfoilCom, p%NumBl, 'BlAirfoilCom', ErrStat2, ErrMsg2 ) - if (Failed()) return; - y%BlAirfoilCom = 0.0_ReKi - - ! tip brakes - this may be added back, later, so we'll keep these here for now - CALL AllocAry( y%TBDrCon, p%NumBl, 'TBDrCon', ErrStat2, ErrMsg2 ) - if (Failed()) return; - - - IF (InitInp%NumCtrl2SC > 0 .and. p%UseBladedInterface) THEN - CALL AllocAry( y%toSC, InitInp%NumCtrl2SC, 'y%SuperController', ErrStat2, ErrMsg2 ) - if (Failed()) return; - y%toSC = 0.0_SiKi - END IF - - - !............................................................................................ - ! tip brakes - this may be added back, later, so we'll keep these here for now - !............................................................................................ - CALL AllocAry( OtherState%BegTpBr, p%NumBl, 'BegTpBr', ErrStat2, ErrMsg2 ) - if (Failed()) return; - OtherState%BegTpBr = .FALSE. - - CALL AllocAry( OtherState%TTpBrDp, p%NumBl, 'TTpBrDp', ErrStat2, ErrMsg2 ) - if (Failed()) return; - OtherState%TTpBrDp = HUGE(OtherState%TTpBrDp) !basically never deploy them. Eventually this will be added back? - - CALL AllocAry( OtherState%TTpBrFl, p%NumBl, 'TTpBrFl', ErrStat2, ErrMsg2 ) - if (Failed()) return; - OtherState%TTpBrFl = HUGE(OtherState%TTpBrFl) !basically never deploy them. Eventually this will be added back? - !OtherState%TTpBrFl = InputFileData%TTpBrFl + p%TpBrDT - - - !............................................................................................ - ! yaw control integrated command angle - !............................................................................................ - OtherState%YawPosComInt = p%YawNeut - - - !............................................................................................ - ! If you want to choose your own rate instead of using what the glue code suggests, tell the glue code the rate at which - ! this module must be called here: - !............................................................................................ - - Interval = p%DT - - !............................................................................................ - ! After we've set up all the data for everything else, we'll call the routines to initialize the Bladed Interface - ! (it requires initial guesses for input/output) - !............................................................................................ - - IF ( p%UseBladedInterface ) THEN - - p%AirDens = InitInp%AirDens - p%AvgWindSpeed = InitInp%AvgWindSpeed - - CALL BladedInterface_Init(u, p, m, xd, y, InputFileData, InitInp, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - m%LastTimeCalled = - m%dll_data%DLL_DT ! we'll initialize the last time the DLL was called as -1 DLL_DT. - m%LastTimeFiltered = - p%DT ! we'll initialize the last time the DLL was filtered as -1 DT. - m%FirstWarn = .TRUE. - ELSE - m%dll_data%DLL_DT = p%DT ! DLL_DT is used to compute the pitch rate and acceleration outputs - p%DLL_n = 1 ! Without a call to the DLL, update the history every time step - - p%DLL_Trgt%FileName = "" - p%DLL_Trgt%ProcName = "" - - END IF - - - !............................................................................................ - ! Setup and initialize the StC submodule (possibly multiple instances at each location) - !............................................................................................ - call StC_Nacelle_Setup(InitInp,p,InputFileData,u%NStC,p%NStC,x%NStC,xd%NStC,z%NStC,OtherState%NStC,y%NStC,m%NStC,ErrStat2,ErrMsg2) - if (Failed()) return; - - call StC_Tower_Setup(InitInp,p,InputFileData,u%TStC,p%TStC,x%TStC,xd%TStC,z%TStC,OtherState%TStC,y%TStC,m%TStC,ErrStat2,ErrMsg2) - if (Failed()) return; - - call StC_Blade_Setup(InitInp,p,InputFileData,u%BStC,p%BStC,x%BStC,xd%BStC,z%BStC,OtherState%BStC,y%BStC,m%BStC,ErrStat2,ErrMsg2) - if (Failed()) return; - - call StC_S_Setup(InitInp,p,InputFileData,u%SStC,p%SStC,x%SStC,xd%SStC,z%SStC,OtherState%SStC,y%SStC,m%SStC,ErrStat2,ErrMsg2) - if (Failed()) return; - - - !............................................................................................ - ! Set Init outputs for linearization (after StrucCtrl, in case we ever add the StrucCtrl to the linearization features): - !............................................................................................ - xd%CtrlOffset = 0.0_ReKi ! initialize before first use with TrimCase in linearization - p%TrimCase = InitInp%TrimCase - p%TrimGain = InitInp%TrimGain - p%RotSpeedRef = InitInp%RotSpeedRef - - if (InitInp%Linearize) then - - ! If the module does allow linearization, return the appropriate Jacobian row/column names here: - ! Allocate and set these variables: InitOut%LinNames_y, InitOut%LinNames_x, InitOut%LinNames_xd, InitOut%LinNames_z, InitOut%LinNames_u - - CALL AllocAry( InitOut%RotFrame_y, SrvD_Indx_Y_WrOutput+p%NumOuts, 'RotFrame_y', ErrStat2, ErrMsg2 ) - if (Failed()) return; - - CALL AllocAry( InitOut%LinNames_y, SrvD_Indx_Y_WrOutput+p%NumOuts, 'LinNames_y', ErrStat2, ErrMsg2 ) - if (Failed()) return; - - do i=1,size(SrvD_Indx_Y_BlPitchCom) ! NOTE: potentially limit to NumBl - InitOut%LinNames_y(SrvD_Indx_Y_BlPitchCom(i)) = 'BlPitchCom('//trim(num2lstr(i))//'), rad' - InitOut%RotFrame_y(SrvD_Indx_Y_BlPitchCom(i)) = .true. - end do - InitOut%LinNames_y(SrvD_Indx_Y_YawMom) = 'YawMom, Nm' - InitOut%RotFrame_y(SrvD_Indx_Y_YawMom) = .false. - - InitOut%LinNames_y(SrvD_Indx_Y_GenTrq) = 'GenTrq, Nm' - InitOut%RotFrame_y(SrvD_Indx_Y_GenTrq) = .false. - - InitOut%LinNames_y(SrvD_Indx_Y_ElecPwr) = 'ElecPwr, W' - InitOut%RotFrame_y(SrvD_Indx_Y_ElecPwr) = .false. - - do i=1,p%NumOuts - InitOut%LinNames_y(i+SrvD_Indx_Y_WrOutput) = trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units - InitOut%RotFrame_y(i+SrvD_Indx_Y_WrOutput) = ANY( p%OutParam(i)%Indx == BlPitchC ) ! the only WriteOutput values in the rotating frame are BlPitch commands - end do - - - CALL AllocAry( InitOut%RotFrame_u, 3, 'RotFrame_u', ErrStat2, ErrMsg2 ) - if (Failed()) return; - - CALL AllocAry( InitOut%IsLoad_u, 3, 'IsLoad_u', ErrStat2, ErrMsg2 ) - if (Failed()) return; - - CALL AllocAry( InitOut%LinNames_u, 3, 'LinNames_u', ErrStat2, ErrMsg2 ) - if (Failed()) return; - - InitOut%LinNames_u(Indx_u_Yaw ) = 'Yaw, rad' - InitOut%LinNames_u(Indx_u_YawRate) = 'YawRate, rad/s' - InitOut%LinNames_u(Indx_u_HSS_Spd) = 'HSS_Spd, rad/s' - InitOut%RotFrame_u = .false. ! none of these are in the rotating frame - InitOut%IsLoad_u = .false. ! none of these linearization inputs are loads - - else - - p%TrimCase = TrimCase_none - - end if - - - !............................................................................................ - ! Define initialization-routine output here: - !............................................................................................ - CALL AllocAry( y%WriteOutput, p%NumOuts+p%NumOuts_DLL, 'WriteOutput', ErrStat2, ErrMsg2 ) - if (Failed()) return; - y%WriteOutput = 0 - - CALL AllocAry( InitOut%WriteOutputHdr, p%NumOuts+p%NumOuts_DLL, 'WriteOutputHdr', ErrStat2, ErrMsg2 ) - if (Failed()) return; - CALL AllocAry( InitOut%WriteOutputUnt, p%NumOuts+p%NumOuts_DLL, 'WriteOutputUnt', ErrStat2, ErrMsg2 ) - if (Failed()) return; - - do i=1,p%NumOuts - InitOut%WriteOutputHdr(i) = p%OutParam(i)%Name - InitOut%WriteOutputUnt(i) = p%OutParam(i)%Units - end do - - j=p%NumOuts - do i=1,p%NumOuts_DLL - j = j + 1 - InitOut%WriteOutputHdr(j) = m%dll_data%LogChannels_OutParam(i)%Name - InitOut%WriteOutputUnt(j) = m%dll_data%LogChannels_OutParam(i)%Units - end do - - InitOut%Ver = SrvD_Ver - - InitOut%UseHSSBrake = (p%HSSBrMode /= ControlMode_None .AND. p%THSSBrDp < InitInp%TMax) .or. p%HSSBrMode == ControlMode_DLL - - IF ( p%UseBladedInterface .OR. InitOut%UseHSSBrake ) THEN - InitOut%CouplingScheme = ExplicitLoose - ! CALL SetErrStat( ErrID_Info, 'The external dynamic-link library option being used in ServoDyn '& - ! //'requires an explicit-loose coupling scheme.',ErrStat,ErrMsg,RoutineName ) - ELSE - InitOut%CouplingScheme = ExplicitLoose - END IF - - - !............................................................................................ - ! Clean up the local variables: - !............................................................................................ - CALL SrvD_DestroyInputFile( InputFileData, ErrStat2, ErrMsg2 ) - CALL StC_DestroyInitOutput(StC_InitOut, ErrStat2, ErrMsg2 ) - - RETURN - -contains - logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - if (Failed) call Cleanup() - end function Failed - subroutine Cleanup() ! Ignore any errors here - CALL SrvD_DestroyInputFile(InputFileData, ErrStat2, ErrMsg2 ) - CALL StC_DestroyInitInput(StC_InitInp, ErrStat2, ErrMsg2 ) - CALL StC_DestroyInitOutput(StC_InitOut, ErrStat2, ErrMsg2 ) - end subroutine Cleanup -END SUBROUTINE SrvD_Init -!---------------------------------------------------------------------------------------------------------------------------------- - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets the data structures for the structural control (StC) module -- Nacelle Instances -subroutine StC_Nacelle_Setup(SrvD_InitInp,SrvD_p,InputFileData,u,p,x,xd,z,OtherState,y,m,ErrStat,ErrMsg) - type(SrvD_InitInputType), intent(in ) :: SrvD_InitInp !< Input data for initialization routine - type(SrvD_ParameterType), intent(in ) :: SrvD_p !< Parameters - TYPE(SrvD_InputFile), intent(in ) :: InputFileData ! Data stored in the module's input file - type(StC_InputType), allocatable,intent( out) :: u(:) !< An initial guess for the input; input mesh must be defined - type(StC_ParameterType), allocatable,intent( out) :: p(:) !< Parameters - type(StC_ContinuousStateType), allocatable,intent( out) :: x(:) !< Initial continuous states - type(StC_DiscreteStateType), allocatable,intent( out) :: xd(:) !< Initial discrete states - type(StC_ConstraintStateType), allocatable,intent( out) :: z(:) !< Initial guess of the constraint states - type(StC_OtherStateType), allocatable,intent( out) :: OtherState(:) !< Initial other states - type(StC_OutputType), allocatable,intent( out) :: y(:) !< Initial system outputs (outputs are not calculated; - type(StC_MiscVarType), allocatable,intent( out) :: 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) :: ErrStat2 ! temporary Error status of the operation - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - integer(IntKi) :: j ! Counter for the instances - real(DbKi) :: Interval !< Coupling interval in seconds from StC - type(StC_InitInputType) :: StC_InitInp !< data to initialize StC module - type(StC_InitOutputType) :: StC_InitOut !< data from StC module initialization (not currently used) - character(*), parameter :: RoutineName = 'StC_Nacelle_Setup' - - ErrStat = ErrID_None - ErrMsg = "" - - if (SrvD_p%NumNStC > 0_IntKi) then - allocate(u(SrvD_p%NumNStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, u') ) return; - allocate(p(SrvD_p%NumNStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, p') ) return; - allocate(x(SrvD_p%NumNStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, x') ) return; - allocate(xd(SrvD_p%NumNStC),STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, xd') ) return; - allocate(z(SrvD_p%NumNStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, z') ) return; - allocate(OtherState(SrvD_p%NumNStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, OtherState') ) return; - allocate(y(SrvD_p%NumNStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, y') ) return; - allocate(m(SrvD_p%NumNStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, m') ) return; - - do j=1,SrvD_p%NumNStC - StC_InitInp%InputFile = InputFileData%NStCfiles(j) - StC_InitInp%RootName = TRIM(SrvD_p%RootName)//'.NStC' - StC_InitInp%Gravity = SrvD_InitInp%gravity - StC_InitInp%NumMeshPts = 1_IntKi ! single point mesh for Nacelle - Interval = SrvD_p%DT ! Pass the ServoDyn DT - - CALL AllocAry( StC_InitInp%InitPosition, 3, StC_InitInp%NumMeshPts, 'StC_InitInp%InitPosition', errStat2, ErrMsg2); if (Failed()) return; - CALL AllocAry( StC_InitInp%InitOrientation,3, 3, StC_InitInp%NumMeshPts, 'StC_InitInp%InitOrientation', errStat2, ErrMsg2); if (Failed()) return; - StC_InitInp%InitPosition(:,1) = SrvD_InitInp%NacPosition - StC_InitInp%InitOrientation(:,:,1) = SrvD_InitInp%NacOrientation - - CALL StC_Init( StC_InitInp, u(j), p(j), x(j), xd(j), z(j), OtherState(j), y(j), m(j), Interval, StC_InitOut, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - IF (.NOT. EqualRealNos( Interval, SrvD_p%DT ) ) & - CALL SetErrStat( ErrID_Fatal, "Nacelle StrucCtrl (instance "//trim(num2lstr(j))//") time step differs from SrvD time step.",ErrStat,ErrMsg,RoutineName ) - if (Failed()) return; - - call Cleanup() - enddo - endif -contains - logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - if (Failed) call Cleanup() - end function Failed - logical function AllErr(Msg) - character(*), intent(in) :: Msg - if(ErrStat2 /= 0) then - CALL SetErrStat( ErrID_Fatal, Msg, ErrStat, ErrMsg, RoutineName ) - endif - AllErr = ErrStat >= AbortErrLev - if (AllErr) call Cleanup() - end function AllErr - subroutine Cleanup() ! Ignore any errors here - CALL StC_DestroyInitInput(StC_InitInp, ErrStat2, ErrMsg2 ) - CALL StC_DestroyInitOutput(StC_InitOut, ErrStat2, ErrMsg2 ) - end subroutine Cleanup -end subroutine StC_Nacelle_Setup -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets the data structures for the structural control (StC) module -- Tower instances -subroutine StC_Tower_Setup(SrvD_InitInp,SrvD_p,InputFileData,u,p,x,xd,z,OtherState,y,m,ErrStat,ErrMsg) - type(SrvD_InitInputType), intent(in ) :: SrvD_InitInp !< Input data for initialization routine - type(SrvD_ParameterType), intent(in ) :: SrvD_p !< Parameters - TYPE(SrvD_InputFile), intent(in ) :: InputFileData ! Data stored in the module's input file - type(StC_InputType), allocatable,intent( out) :: u(:) !< An initial guess for the input; input mesh must be defined - type(StC_ParameterType), allocatable,intent( out) :: p(:) !< Parameters - type(StC_ContinuousStateType), allocatable,intent( out) :: x(:) !< Initial continuous states - type(StC_DiscreteStateType), allocatable,intent( out) :: xd(:) !< Initial discrete states - type(StC_ConstraintStateType), allocatable,intent( out) :: z(:) !< Initial guess of the constraint states - type(StC_OtherStateType), allocatable,intent( out) :: OtherState(:) !< Initial other states - type(StC_OutputType), allocatable,intent( out) :: y(:) !< Initial system outputs (outputs are not calculated; - type(StC_MiscVarType), allocatable,intent( out) :: 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) :: ErrStat2 ! temporary Error status of the operation - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - integer(IntKi) :: j ! Counter for the instances - real(DbKi) :: Interval !< Coupling interval in seconds from StC - type(StC_InitInputType) :: StC_InitInp !< data to initialize StC module - type(StC_InitOutputType) :: StC_InitOut !< data from StC module initialization (not currently used) - character(*), parameter :: RoutineName = 'StC_Tower_Setup' - - ErrStat = ErrID_None - ErrMsg = "" - - if (SrvD_p%NumTStC > 0_IntKi) then - allocate(u(SrvD_p%NumTStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, u') ) return; - allocate(p(SrvD_p%NumTStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, p') ) return; - allocate(x(SrvD_p%NumTStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, x') ) return; - allocate(xd(SrvD_p%NumTStC),STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, xd') ) return; - allocate(z(SrvD_p%NumTStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, z') ) return; - allocate(OtherState(SrvD_p%NumTStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, OtherState') ) return; - allocate(y(SrvD_p%NumTStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, y') ) return; - allocate(m(SrvD_p%NumTStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, m') ) return; - - do j=1,SrvD_p%NumTStC - StC_InitInp%InputFile = InputFileData%TStCfiles(j) - StC_InitInp%RootName = TRIM(SrvD_p%RootName)//'.TStC' - StC_InitInp%Gravity = SrvD_InitInp%gravity - StC_InitInp%NumMeshPts = 1_IntKi ! single point mesh for Tower - Interval = SrvD_p%DT ! Pass the ServoDyn DT - - CALL AllocAry( StC_InitInp%InitPosition, 3, StC_InitInp%NumMeshPts, 'StC_InitInp%InitPosition', errStat2, ErrMsg2); if (Failed()) return; - CALL AllocAry( StC_InitInp%InitOrientation,3, 3, StC_InitInp%NumMeshPts, 'StC_InitInp%InitOrientation', errStat2, ErrMsg2); if (Failed()) return; - StC_InitInp%InitPosition(:,1) = SrvD_InitInp%TwrBasePos - StC_InitInp%InitOrientation(:,:,1) = SrvD_InitInp%TwrBaseOrient - - CALL StC_Init( StC_InitInp, u(j), p(j), x(j), xd(j), z(j), OtherState(j), y(j), m(j), Interval, StC_InitOut, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - IF (.NOT. EqualRealNos( Interval, SrvD_p%DT ) ) & - CALL SetErrStat( ErrID_Fatal, "Tower StrucCtrl (instance "//trim(num2lstr(j))//") time step differs from SrvD time step.",ErrStat,ErrMsg,RoutineName ) - if (Failed()) return; - - call Cleanup() - enddo - endif -contains - logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - if (Failed) call Cleanup() - end function Failed - logical function AllErr(Msg) - character(*), intent(in) :: Msg - if(ErrStat2 /= 0) then - CALL SetErrStat( ErrID_Fatal, Msg, ErrStat, ErrMsg, RoutineName ) - endif - AllErr = ErrStat >= AbortErrLev - if (AllErr) call Cleanup() - end function AllErr - subroutine Cleanup() ! Ignore any errors here - CALL StC_DestroyInitInput(StC_InitInp, ErrStat2, ErrMsg2 ) - CALL StC_DestroyInitOutput(StC_InitOut, ErrStat2, ErrMsg2 ) - end subroutine Cleanup -end subroutine StC_Tower_Setup -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets the data structures for the structural control (StC) module -- Blade instances -subroutine StC_Blade_Setup(SrvD_InitInp,SrvD_p,InputFileData,u,p,x,xd,z,OtherState,y,m,ErrStat,ErrMsg) - type(SrvD_InitInputType), intent(in ) :: SrvD_InitInp !< Input data for initialization routine - type(SrvD_ParameterType), intent(in ) :: SrvD_p !< Parameters - TYPE(SrvD_InputFile), intent(in ) :: InputFileData ! Data stored in the module's input file - type(StC_InputType), allocatable,intent( out) :: u(:) !< An initial guess for the input; input mesh must be defined - type(StC_ParameterType), allocatable,intent( out) :: p(:) !< Parameters - type(StC_ContinuousStateType), allocatable,intent( out) :: x(:) !< Initial continuous states - type(StC_DiscreteStateType), allocatable,intent( out) :: xd(:) !< Initial discrete states - type(StC_ConstraintStateType), allocatable,intent( out) :: z(:) !< Initial guess of the constraint states - type(StC_OtherStateType), allocatable,intent( out) :: OtherState(:) !< Initial other states - type(StC_OutputType), allocatable,intent( out) :: y(:) !< Initial system outputs (outputs are not calculated; - type(StC_MiscVarType), allocatable,intent( out) :: 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) :: ErrStat2 ! temporary Error status of the operation - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - integer(IntKi) :: j ! Counter for the instances - integer(IntKi) :: k ! Counter for the blade - real(DbKi) :: Interval !< Coupling interval in seconds from StC - type(StC_InitInputType) :: StC_InitInp !< data to initialize StC module - type(StC_InitOutputType) :: StC_InitOut !< data from StC module initialization (not currently used) - character(*), parameter :: RoutineName = 'StC_Blade_Setup' - - ErrStat = ErrID_None - ErrMsg = "" - - if (SrvD_p%NumBStC > 0_IntKi) then - allocate(u(SrvD_p%NumBStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, u') ) return; - allocate(p(SrvD_p%NumBStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, p') ) return; - allocate(x(SrvD_p%NumBStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, x') ) return; - allocate(xd(SrvD_p%NumBStC),STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, xd') ) return; - allocate(z(SrvD_p%NumBStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, z') ) return; - allocate(OtherState(SrvD_p%NumBStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, OtherState') ) return; - allocate(y(SrvD_p%NumBStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, y') ) return; - allocate(m(SrvD_p%NumBStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, m') ) return; - - do j=1,SrvD_p%NumBStC - StC_InitInp%InputFile = InputFileData%BStCfiles(j) - StC_InitInp%RootName = TRIM(SrvD_p%RootName)//'.BStC' - StC_InitInp%Gravity = SrvD_InitInp%gravity - StC_InitInp%NumMeshPts = SrvD_p%NumBl ! p%NumBl points for blades - Interval = SrvD_p%DT ! Pass the ServoDyn DT - - CALL AllocAry( StC_InitInp%InitPosition, 3, StC_InitInp%NumMeshPts, 'StC_InitInp%InitPosition', errStat2, ErrMsg2); if (Failed()) return; - CALL AllocAry( StC_InitInp%InitOrientation,3, 3, StC_InitInp%NumMeshPts, 'StC_InitInp%InitOrientation', errStat2, ErrMsg2); if (Failed()) return; - do k=1,StC_InitInp%NumMeshPts - StC_InitInp%InitPosition(:,k) = SrvD_InitInp%BladeRootPosition(:,k) - StC_InitInp%InitOrientation(:,:,k) = SrvD_InitInp%BladeRootOrientation(:,:,k) - enddo - - CALL StC_Init( StC_InitInp, u(j), p(j), x(j), xd(j), z(j), OtherState(j), y(j), m(j), Interval, StC_InitOut, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - IF (.NOT. EqualRealNos( Interval, SrvD_p%DT ) ) & - CALL SetErrStat( ErrID_Fatal, "Blade StrucCtrl (instance "//trim(num2lstr(j))//") time step differs from SrvD time step.",ErrStat,ErrMsg,RoutineName ) - if (Failed()) return; - - call Cleanup() - enddo - endif -contains - logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - if (Failed) call Cleanup() - end function Failed - logical function AllErr(Msg) - character(*), intent(in) :: Msg - if(ErrStat2 /= 0) then - CALL SetErrStat( ErrID_Fatal, Msg, ErrStat, ErrMsg, RoutineName ) - endif - AllErr = ErrStat >= AbortErrLev - if (AllErr) call Cleanup() - end function AllErr - subroutine Cleanup() ! Ignore any errors here - CALL StC_DestroyInitInput(StC_InitInp, ErrStat2, ErrMsg2 ) - CALL StC_DestroyInitOutput(StC_InitOut, ErrStat2, ErrMsg2 ) - end subroutine Cleanup -end subroutine StC_Blade_Setup -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets the data structures for the structural control (StC) module -- hydrodynamics platform instances -subroutine StC_S_Setup(SrvD_InitInp,SrvD_p,InputFileData,u,p,x,xd,z,OtherState,y,m,ErrStat,ErrMsg) - type(SrvD_InitInputType), intent(in ) :: SrvD_InitInp !< Input data for initialization routine - type(SrvD_ParameterType), intent(in ) :: SrvD_p !< Parameters - TYPE(SrvD_InputFile), intent(in ) :: InputFileData ! Data stored in the module's input file - type(StC_InputType), allocatable,intent( out) :: u(:) !< An initial guess for the input; input mesh must be defined - type(StC_ParameterType), allocatable,intent( out) :: p(:) !< Parameters - type(StC_ContinuousStateType), allocatable,intent( out) :: x(:) !< Initial continuous states - type(StC_DiscreteStateType), allocatable,intent( out) :: xd(:) !< Initial discrete states - type(StC_ConstraintStateType), allocatable,intent( out) :: z(:) !< Initial guess of the constraint states - type(StC_OtherStateType), allocatable,intent( out) :: OtherState(:) !< Initial other states - type(StC_OutputType), allocatable,intent( out) :: y(:) !< Initial system outputs (outputs are not calculated; - type(StC_MiscVarType), allocatable,intent( out) :: 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) :: ErrStat2 ! temporary Error status of the operation - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - integer(IntKi) :: j ! Counter for the instances - real(DbKi) :: Interval !< Coupling interval in seconds from StC - type(StC_InitInputType) :: StC_InitInp !< data to initialize StC module - type(StC_InitOutputType) :: StC_InitOut !< data from StC module initialization (not currently used) - character(*), parameter :: RoutineName = 'StC_S_Setup' - - ErrStat = ErrID_None - ErrMsg = "" - - if (SrvD_p%NumSStC > 0_IntKi) then - allocate(u(SrvD_p%NumSStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, u') ) return; - allocate(p(SrvD_p%NumSStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, p') ) return; - allocate(x(SrvD_p%NumSStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, x') ) return; - allocate(xd(SrvD_p%NumSStC),STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, xd') ) return; - allocate(z(SrvD_p%NumSStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, z') ) return; - allocate(OtherState(SrvD_p%NumSStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, OtherState') ) return; - allocate(y(SrvD_p%NumSStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, y') ) return; - allocate(m(SrvD_p%NumSStC), STAT=ErrStat2); if ( AllErr('Could not allocate StrucCtrl input array, m') ) return; - - do j=1,SrvD_p%NumSStC - StC_InitInp%InputFile = InputFileData%SStCfiles(j) - StC_InitInp%RootName = TRIM(SrvD_p%RootName)//'.SStC' - StC_InitInp%Gravity = SrvD_InitInp%gravity - StC_InitInp%NumMeshPts = 1_IntKi ! single point mesh for Platform - Interval = SrvD_p%DT ! Pass the ServoDyn DT - - CALL AllocAry( StC_InitInp%InitPosition, 3, StC_InitInp%NumMeshPts, 'StC_InitInp%InitPosition', errStat2, ErrMsg2); if (Failed()) return; - CALL AllocAry( StC_InitInp%InitOrientation,3, 3, StC_InitInp%NumMeshPts, 'StC_InitInp%InitOrientation', errStat2, ErrMsg2); if (Failed()) return; - StC_InitInp%InitPosition(1:3,1) = SrvD_InitInp%PlatformPos(1:3) - StC_InitInp%InitOrientation(:,:,1) = SrvD_InitInp%PlatformOrient - - CALL StC_Init( StC_InitInp, u(j), p(j), x(j), xd(j), z(j), OtherState(j), y(j), m(j), Interval, StC_InitOut, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - IF (.NOT. EqualRealNos( Interval, SrvD_p%DT ) ) & - CALL SetErrStat( ErrID_Fatal, "Platform StrucCtrl (instance "//trim(num2lstr(j))//") time step differs from SrvD time step.",ErrStat,ErrMsg,RoutineName ) - if (Failed()) return; - - call Cleanup() - enddo - endif -contains - logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - if (Failed) call Cleanup() - end function Failed - logical function AllErr(Msg) - character(*), intent(in) :: Msg - if(ErrStat2 /= 0) then - CALL SetErrStat( ErrID_Fatal, Msg, ErrStat, ErrMsg, RoutineName ) - endif - AllErr = ErrStat >= AbortErrLev - if (AllErr) call Cleanup() - end function AllErr - subroutine Cleanup() ! Ignore any errors here - CALL StC_DestroyInitInput(StC_InitInp, ErrStat2, ErrMsg2 ) - CALL StC_DestroyInitOutput(StC_InitOut, ErrStat2, ErrMsg2 ) - end subroutine Cleanup -end subroutine StC_S_Setup - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is called at the end of the simulation. -SUBROUTINE SrvD_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(SrvD_InputType), INTENT(INOUT) :: u !< System inputs - TYPE(SrvD_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states - TYPE(SrvD_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states - TYPE(SrvD_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states - TYPE(SrvD_OtherStateType), INTENT(INOUT) :: OtherState !< Other states - TYPE(SrvD_OutputType), INTENT(INOUT) :: y !< System outputs - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Initial 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 ! loop counter for instance of StC at location - - - ! Place any last minute operations or calculations here: - IF ( p%UseBladedInterface ) THEN - CALL BladedInterface_End(u, p, m, xd, ErrStat, ErrMsg ) - END IF - - ! StrucCtrl -- since all StC data is stored in SrvD types, we don't technically need to call StC_End directly - if (allocated(u%NStC)) then - do j=1,p%NumNStC ! Nacelle - call StC_End( u%NStC(j), p%NStC(j), x%NStC(j), xd%NStC(j), z%NStC(j), OtherState%NStC(j), y%NStC(j), m%NStC(j), ErrStat, ErrMsg ) - enddo - endif - if (allocated(u%TStC)) then - do j=1,p%NumTStC ! Tower - call StC_End( u%TStC(j), p%TStC(j), x%TStC(j), xd%TStC(j), z%TStC(j), OtherState%TStC(j), y%TStC(j), m%TStC(j), ErrStat, ErrMsg ) - enddo - endif - if (allocated(u%BStC)) then - do j=1,p%NumBStC ! Blades - call StC_End( u%BStC(j), p%BStC(j), x%BStC(j), xd%BStC(j), z%BStC(j), OtherState%BStC(j), y%BStC(j), m%BStC(j), ErrStat, ErrMsg ) - enddo - endif - if (allocated(u%SStC)) then - do j=1,p%NumSStC ! Platform - call StC_End( u%SStC(j), p%SStC(j), x%SStC(j), xd%SStC(j), z%SStC(j), OtherState%SStC(j), y%SStC(j), m%SStC(j), ErrStat, ErrMsg ) - enddo - endif - - - ! Destroy the input data: - CALL SrvD_DestroyInput( u, ErrStat, ErrMsg ) - - ! Destroy the parameter data: - CALL SrvD_DestroyParam( p, ErrStat, ErrMsg ) - - ! Destroy the state data: - CALL SrvD_DestroyContState( x, ErrStat, ErrMsg ) - CALL SrvD_DestroyDiscState( xd, ErrStat, ErrMsg ) - CALL SrvD_DestroyConstrState( z, ErrStat, ErrMsg ) - CALL SrvD_DestroyOtherState( OtherState, ErrStat, ErrMsg ) - - ! Destroy the misc var data: - CALL SrvD_DestroyMisc( m, ErrStat, ErrMsg ) - - - ! Destroy the output data: - CALL SrvD_DestroyOutput( y, ErrStat, ErrMsg ) - - ! We are ignoring any errors from destroying data - ErrStat = ErrID_None - ErrMsg = "" - -END SUBROUTINE SrvD_End -!---------------------------------------------------------------------------------------------------------------------------------- -!> This is a loose coupling routine for solving constraint states, integrating continuous states, and updating discrete and other -!! states. Continuous, constraint, discrete, and other states are updated to values at t + Interval. -SUBROUTINE SrvD_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval - TYPE(SrvD_InputType), INTENT(INOUT) :: Inputs(:) !< Inputs at InputTimes (output only for mesh record-keeping in ExtrapInterp routine) - REAL(DbKi), INTENT(IN ) :: InputTimes(:) !< Times in seconds associated with Inputs - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT(INOUT) :: x !< Input: Continuous states at t; - !! Output: Continuous states at t + Interval - TYPE(SrvD_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t; - !! Output: Discrete states at t + Interval - TYPE(SrvD_ConstraintStateType), INTENT(INOUT) :: z !< Input: Constraint states at t; - !! Output: Constraint states at t + Interval - TYPE(SrvD_OtherStateType), INTENT(INOUT) :: OtherState !< Other states: Other states at t; - !! Output: Other states at t + Interval - 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 - - ! Local variables - TYPE(StC_InputType),ALLOCATABLE :: u(:) ! Inputs at t - INTEGER(IntKi) :: i ! loop counter - INTEGER(IntKi) :: j ! loop counter for StC instance of type - INTEGER(IntKi) :: order - TYPE(SrvD_InputType) :: u_interp ! interpolated input - ! Local variables: - - - INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (occurs after initial error) - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UpdateStates' - REAL(DbKi) :: t_next - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - !............................................................................................................................... - ! update states in StrucCtrl submodule, if necessary: - !............................................................................................................................... - - IF ((p%NumNStC + p%NumTStC + p%NumBStC + p%NumSStC) > 0_IntKi) THEN - order = SIZE(Inputs) - allocate(u(order), STAT=ErrStat2) - if (ErrStat2 /= 0) then - CALL SetErrStat( ErrID_Fatal, 'Could not allocate StrucCtrl input array, u', ErrStat, ErrMsg, RoutineName ) - if (Failed()) return; - endif - ENDIF - - - ! Nacelle StrucCtrl - do j=1,p%NumNStC - do i=1,order - call StC_CopyInput( Inputs(i)%NStC(j), u(i), MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - if (Failed()) return; - enddo - - call StC_UpdateStates( t, n, u, InputTimes, p%NStC(j), x%NStC(j), xd%NStC(j), z%NStC(j), OtherState%NStC(j), m%NStC(j), ErrStat2, ErrMsg2 ) - if (Failed()) return; - - ! destroy these for the next call to StC_UpdateStates (reset for next StC instance) - do i=1,SIZE(u) - call StC_DestroyInput(u(i), ErrStat2, ErrMsg2) - if (Failed()) return; - enddo - enddo - - - ! Tower StrucCtrl - do j=1,p%NumTStC - do i=1,order - call StC_CopyInput( Inputs(i)%TStC(j), u(i), MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - if (Failed()) return; - enddo - - call StC_UpdateStates( t, n, u, InputTimes, p%TStC(j), x%TStC(j), xd%TStC(j), z%TStC(j), OtherState%TStC(j), m%TStC(j), ErrStat2, ErrMsg2 ) - if (Failed()) return; - - ! destroy these for the next call to StC_UpdateStates (reset for next StC instance) - do i=1,SIZE(u) - call StC_DestroyInput(u(i), ErrStat2, ErrMsg2) - if (Failed()) return; - enddo - enddo - - - ! Blade StrucCtrl - do j=1,p%NumBStC - do i=1,order - call StC_CopyInput( Inputs(i)%BStC(j), u(i), MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - if (Failed()) return; - enddo - - call StC_UpdateStates( t, n, u, InputTimes, p%BStC(j), x%BStC(j), xd%BStC(j), z%BStC(j), OtherState%BStC(j), m%BStC(j), ErrStat2, ErrMsg2 ) - if (Failed()) return; - - ! destroy these for the next call to StC_UpdateStates (reset for next StC instance) - do i=1,SIZE(u) - call StC_DestroyInput(u(i), ErrStat2, ErrMsg2) - if (Failed()) return; - enddo - enddo - - - ! Platform StrucCtrl - do j=1,p%NumSStC - do i=1,order - call StC_CopyInput( Inputs(i)%SStC(j), u(i), MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - if (Failed()) return; - enddo - - call StC_UpdateStates( t, n, u, InputTimes, p%SStC(j), x%SStC(j), xd%SStC(j), z%SStC(j), OtherState%SStC(j), m%SStC(j), ErrStat2, ErrMsg2 ) - if (Failed()) return; - - ! destroy these for the next call to StC_UpdateStates (reset for next StC instance) - do i=1,SIZE(u) - call StC_DestroyInput(u(i), ErrStat2, ErrMsg2) - if (Failed()) return; - enddo - enddo - - - !............................................................................................................................... - ! get inputs at t: - !............................................................................................................................... - CALL SrvD_CopyInput( Inputs(1), u_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - CALL SrvD_Input_ExtrapInterp( Inputs, InputTimes, u_interp, t, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - !............................................................................................................................... - ! update discrete states: - !............................................................................................................................... - ! 1. Get appropriate value of input for the filter in discrete states (this works only for the DLL at this point, so we're going to move it there) - ! 2. Update control offset for trim solutions - - CALL SrvD_UpdateDiscState( t, u_interp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - !............................................................................................................................... - ! get inputs at t+dt: - !............................................................................................................................... - t_next = t+p%dt - - CALL SrvD_Input_ExtrapInterp( Inputs, InputTimes, u_interp, t_next, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - IF (p%UseBladedInterface) THEN - CALL DLL_controller_call(t_next, u_interp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) - if (Failed()) return; - END IF - - !............................................................................................................................... - ! update remaining states to values at t+dt: - !............................................................................................................................... - - ! Torque control: - CALL Torque_UpdateStates( t_next, u_interp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - ! Pitch control: - CALL Pitch_UpdateStates( t_next, u_interp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - ! Yaw control: - CALL Yaw_UpdateStates( t_next, u_interp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - ! Tip brake control: - CALL TipBrake_UpdateStates( t_next, u_interp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - !................................................................... - ! Compute ElecPwr and GenTrq for controller (and DLL needs this saved): - !................................................................... - IF ( OtherState%GenOnLine .and. .not. OtherState%Off4Good ) THEN ! Generator is on line. - CALL CalculateTorque( t, u_interp, p, m, m%dll_data%GenTrq_prev, m%dll_data%ElecPwr_prev, ErrStat2, ErrMsg2 ) - if (Failed()) return; - ELSE ! Generator is off line. - m%dll_data%GenTrq_prev = 0.0_ReKi - m%dll_data%ElecPwr_prev = 0.0_ReKi - ENDIF - - !............................................................................................................................... - 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() - - IF (ALLOCATED(u)) THEN - DO i=1,SIZE(u) - CALL StC_DestroyInput(u(i), ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - END DO - DEALLOCATE(u) - END IF - - CALL SrvD_DestroyInput(u_interp, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - END SUBROUTINE Cleanup - -END SUBROUTINE SrvD_UpdateStates -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine for deciding if Bladed-style DLL controller should be called -SUBROUTINE DLL_controller_call(t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t - TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - 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 - - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DLL_controller_call' - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - ! we should be calling this routine ONLY when the following statement is true: - !IF ( p%UseBladedInterface ) THEN - - IF ( .NOT. EqualRealNos( t - m%dll_data%DLL_DT, m%LastTimeCalled ) ) THEN - IF (m%FirstWarn) THEN - IF ( EqualRealNos( p%DT, m%dll_data%DLL_DT ) ) THEN ! This must be because we're doing a correction step or calling multiple times per time step - CALL SetErrStat ( ErrID_Warn, 'BladedInterface option was designed for an explicit-loose '//& - 'coupling scheme. Using last calculated values from DLL on all subsequent calls until time is advanced. '//& - 'Warning will not be displayed again.', ErrStat, ErrMsg, RoutineName ) - ELSE ! this may be because of calling multiple times per time step, but most likely is because DT /= DLL_DT - CALL SetErrStat ( ErrID_Warn, 'Using last calculated values from DLL on all subsequent calls until next DLL_DT has been reached. '//& - 'Warning will not be displayed again.', ErrStat, ErrMsg, RoutineName ) - END IF - m%FirstWarn = .FALSE. - END IF - ELSE - m%dll_data%PrevBlPitch(1:p%NumBl) = m%dll_data%BlPitchCom(1:p%NumBl) ! used for linear ramp of delayed signal - m%LastTimeCalled = t - - CALL BladedInterface_CalcOutput( t, u, p, m, xd, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - m%dll_data%initialized = .true. - END IF - - !END IF - -END SUBROUTINE DLL_controller_call -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine for computing outputs, used in both loose and tight coupling. -SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t - TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(SrvD_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- - !! nectivity information does not have to be recalculated) - 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 - - ! Local variables - REAL(ReKi) :: AllOuts(0:MaxOutPts) ! All the the available output channels - INTEGER(IntKi) :: I ! Generic loop index - INTEGER(IntKi) :: K ! Blade index - INTEGER(IntKi) :: J ! Structural control instance at location - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CalcOutput' - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - ! StrucCtrl - do j=1,p%NumNStC ! Nacelle - CALL StC_CalcOutput( t, u%NStC(j), p%NStC(j), x%NStC(j), xd%NStC(j), z%NStC(j), OtherState%NStC(j), y%NStC(j), m%NStC(j), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - enddo - do j=1,p%NumTStC ! Tower - CALL StC_CalcOutput( t, u%TStC(j), p%TStC(j), x%TStC(j), xd%TStC(j), z%TStC(j), OtherState%TStC(j), y%TStC(j), m%TStC(j), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - enddo - do j=1,p%NumBStC ! Blades - CALL StC_CalcOutput( t, u%BStC(j), p%BStC(j), x%BStC(j), xd%BStC(j), z%BStC(j), OtherState%BStC(j), y%BStC(j), m%BStC(j), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - enddo - do j=1,p%NumSStC ! Platform - CALL StC_CalcOutput( t, u%SStC(j), p%SStC(j), x%SStC(j), xd%SStC(j), z%SStC(j), OtherState%SStC(j), y%SStC(j), m%SStC(j), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - enddo - - !............................................................................................................................... - ! Get the demanded values from the external Bladed dynamic link library, if necessary: - !............................................................................................................................... - IF ( p%UseBladedInterface ) THEN - - ! Initialize the DLL controller in CalcOutput ONLY if it hasn't already been initialized in SrvD_UpdateStates - IF (.NOT. m%dll_data%initialized) THEN - CALL DLL_controller_call(t, u, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - ! 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) - y%BlAirfoilCom(1:p%NumBl) = m%dll_data%BlAirfoilCom(1:p%NumBl) - - IF (ALLOCATED(y%toSC)) THEN - y%toSC = m%dll_data%toSC - END IF - - END IF - - !............................................................................................................................... - ! Compute the outputs - !............................................................................................................................... - - ! Torque control: - CALL Torque_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) ! calculates ElecPwr, which Pitch_CalcOutput will use in the user pitch routine - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - - ! Pitch control: - CALL Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y%BlPitchCom, y%ElecPwr, m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - - ! Yaw control: - CALL Yaw_CalcOutput( t, u, p, x, xd, z, OtherState, y, m,ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - - ! Tip brake control: - CALL TipBrake_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - - - !............................................................................................................................... - ! Place the selected output channels into the WriteOutput(:) array with the proper sign: - !............................................................................................................................... - - AllOuts=0.0_ReKi - - call Set_SrvD_Outs( p, y, m, AllOuts ) - - if (p%NumNStC>0) call Set_NStC_Outs( p, x%NStC, m%NStC, y%NStC, AllOuts ) - if (p%NumTStC>0) call Set_TStC_Outs( p, x%TStC, m%TStC, y%TStC, AllOuts ) - if (p%NumBStC>0) call Set_BStC_Outs( p, x%BStC, m%BStC, y%BStC, AllOuts ) - if (p%NumSStC>0) call Set_SStC_Outs( p, x%SStC, m%SStC, y%SStC, AllOuts ) - - DO I = 1,p%NumOuts ! Loop through all selected output channels - y%WriteOutput(I) = p%OutParam(I)%SignM * AllOuts( p%OutParam(I)%Indx ) - ENDDO ! I - All selected output channels - - DO I = 1,p%NumOuts_DLL ! Loop through all DLL logging channels - y%WriteOutput(I+p%NumOuts) = m%dll_data%LogChannels( I ) - ENDDO - - RETURN -END SUBROUTINE SrvD_CalcOutput -!---------------------------------------------------------------------------------------------------------------------------------- -!> Tight coupling routine for computing derivatives of continuous states. -SUBROUTINE SrvD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t - TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc (optimization) variables - TYPE(SrvD_ContinuousStateType), INTENT( OUT) :: dxdt !< Continuous state derivatives at t - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CalcContStateDeriv' - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: j ! Index to instance of StC for location - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - - ! Compute the first time derivatives of the continuous states here: - - dxdt%DummyContState = 0.0_ReKi - - ! StrucCtrl - do j=1,p%NumNStC ! Nacelle - CALL StC_CalcContStateDeriv( t, u%NStC(j), p%NStC(j), x%NStC(j), xd%NStC(j), z%NStC(j), OtherState%NStC(j), m%NStC(j), dxdt%NStC(j), ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - enddo - do j=1,p%NumTStC ! Tower - CALL StC_CalcContStateDeriv( t, u%TStC(j), p%TStC(j), x%TStC(j), xd%TStC(j), z%TStC(j), OtherState%TStC(j), m%TStC(j), dxdt%TStC(j), ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - enddo - do j=1,p%NumBStC ! Blade - CALL StC_CalcContStateDeriv( t, u%BStC(j), p%BStC(j), x%BStC(j), xd%BStC(j), z%BStC(j), OtherState%BStC(j), m%BStC(j), dxdt%BStC(j), ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - enddo - do j=1,p%NumSStC ! Platform - CALL StC_CalcContStateDeriv( t, u%SStC(j), p%SStC(j), x%SStC(j), xd%SStC(j), z%SStC(j), OtherState%SStC(j), m%SStC(j), dxdt%SStC(j), ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - enddo - - -END SUBROUTINE SrvD_CalcContStateDeriv -!---------------------------------------------------------------------------------------------------------------------------------- -!> Tight coupling routine for updating discrete states. -SUBROUTINE SrvD_UpdateDiscState( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(SrvD_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t; - !! Output: Discrete states at t + Interval - TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t - TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - 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 - - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UpdateDiscState' - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: j ! Index to instance of StC for location - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - select case (p%TrimCase) - case (TrimCase_yaw) - xd%CtrlOffset = xd%CtrlOffset + (u%RotSpeed - p%RotSpeedRef) * sign(p%TrimGain, p%YawNeut + xd%CtrlOffset) - case (TrimCase_torque, TrimCase_pitch) - xd%CtrlOffset = xd%CtrlOffset + (u%RotSpeed - p%RotSpeedRef) * p%TrimGain -! case default -! xd%CtrlOffset = 0.0_ReKi ! same as initialized value - end select - - !xd%BlPitchFilter = p%BlAlpha * xd%BlPitchFilter + (1.0_ReKi - p%BlAlpha) * u%BlPitch - - !if ( p%PCMode == ControlMode_DLL ) then - ! if ( p%DLL_Ramp ) then - ! temp = (t - m%LastTimeCalled) / m%dll_data%DLL_DT - ! temp = m%dll_data%PrevBlPitch(1:p%NumBl) + & - ! temp * ( m%dll_data%BlPitchCom(1:p%NumBl) - m%dll_data%PrevBlPitch(1:p%NumBl) ) - ! else - ! temp = m%dll_data%BlPitchCom(1:p%NumBl) - ! end if - ! - ! xd%BlPitchFilter = p%BlAlpha * xd%BlPitchFilter + (1.0_ReKi - p%BlAlpha) * temp - !else - ! - !end if - - ! Update discrete states for StrucCtrl --- StC does not currently support this -! do j=1,p%NumNStC ! Nacelle -! CALL StC_UpdateDiscState( t, u%NStC(j), p%NStC(j), x%NStC(j), xd%NStC(j), z%NStC(j), OtherState%NStC(j), m%NStC(j), ErrStat, ErrMsg ) -! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) -! enddo -! do j=1,p%NumTStC ! tower -! CALL StC_UpdateDiscState( t, u%TStC(j), p%TStC(j), x%TStC(j), xd%TStC(j), z%TStC(j), OtherState%TStC(j), m%TStC(j), ErrStat, ErrMsg ) -! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) -! enddo -! do j=1,p%NumBStC ! Blade -! CALL StC_UpdateDiscState( t, u%BStC(j), p%BStC(j), x%BStC(j), xd%BStC(j), z%BStC(j), OtherState%BStC(j), m%BStC(j), ErrStat, ErrMsg ) -! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) -! enddo -! do j=1,p%NumSStC ! Platform -! CALL StC_UpdateDiscState( t, u%SStC(j), p%SStC(j), x%SStC(j), xd%SStC(j), z%SStC(j), OtherState%SStC(j), m%SStC(j), ErrStat, ErrMsg ) -! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) -! enddo - -END SUBROUTINE SrvD_UpdateDiscState -!---------------------------------------------------------------------------------------------------------------------------------- -!> Tight coupling routine for solving for the residual of the constraint state equations. -SUBROUTINE SrvD_CalcConstrStateResidual( t, u, p, x, xd, z, OtherState, m, z_residual, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t (possibly a guess) - TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc (optimization) variables - TYPE(SrvD_ConstraintStateType), INTENT( OUT) :: z_residual !< Residual of the constraint state equations using - !! the input values described above - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CalcConstrStateResidual' - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: j ! Index to instance of StC for location - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - - ! Solve for the constraint states for StrucCtrl --- StC does not currently support this -! do j=1,p%NumNStC ! Nacelle -! CALL StC_CalcConstrStateResidual( t, u%NStC(j), p%NStC(j), x%NStC(j), xd%NStC(j), z%NStC(j), OtherState%NStC(j), m%NStC(j), z_residual%NStC(j), ErrStat, ErrMsg ) -! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) -! enddo -! do j=1,p%NumTStC ! Tower -! CALL StC_CalcConstrStateResidual( t, u%TStC(j), p%TStC(j), x%TStC(j), xd%TStC(j), z%TStC(j), OtherState%TStC(j), m%TStC(j), z_residual%TStC(j), ErrStat, ErrMsg ) -! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) -! enddo -! do j=1,p%NumBStC ! Blade -! CALL StC_CalcConstrStateResidual( t, u%BStC(j), p%BStC(j), x%BStC(j), xd%BStC(j), z%BStC(j), OtherState%BStC(j), m%BStC(j), z_residual%BStC(j), ErrStat, ErrMsg ) -! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) -! enddo -! do j=1,p%NumSStC ! Platform -! CALL StC_CalcConstrStateResidual( t, u%SStC(j), p%SStC(j), x%SStC(j), xd%SStC(j), z%SStC(j), OtherState%SStC(j), m%SStC(j), z_residual%SStC(j), ErrStat, ErrMsg ) -! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) -! enddo - - z_residual%DummyConstrState = 0.0_ReKi - -END SUBROUTINE SrvD_CalcConstrStateResidual - - -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -! ###### The following four routines are Jacobian routines for linearization capabilities ####### -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the inputs (u). The partial derivative dY/du is returned. -SUBROUTINE SrvD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(SrvD_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required); - !! Output fields are not used by this routine, but type is - !! available here so that mesh parameter information (i.e., - !! connectivity) does not have to be recalculated for dYdu. - 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 - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions - !! (Y) with respect to the inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state - !! functions (X) with respect to inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state - !! functions (Xd) with respect to inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state - !! functions (Z) with respect to inputs (u) [intent in to avoid deallocation] - - ! local variables - REAL(R8Ki) :: AllOuts(3,1:MaxOutPts) ! All the the available output channels - REAL(R8Ki) :: GenTrq_du, ElecPwr_du ! derivatives of generator torque and electrical power w.r.t. u%HSS_SPD - INTEGER(IntKi) :: I ! Generic loop index - INTEGER(IntKi) :: ErrStat2 ! Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_JacobianPInput' - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - - - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: - - IF ( PRESENT( dYdu ) ) THEN - - !> \f{equation}{ \frac{\partial Y}{\partial u} = \begin{bmatrix} - !! \frac{\partial Y_{BlPitchCom_1}}{\partial u_{Yaw}} & \frac{\partial Y_{BlPitchCom_1}}{\partial u_{YawRate}} & \frac{\partial Y_{BlPitchCom_1}}{\partial u_{HSS\_Spd}} \\ - !! \frac{\partial Y_{BlPitchCom_2}}{\partial u_{Yaw}} & \frac{\partial Y_{BlPitchCom_2}}{\partial u_{YawRate}} & \frac{\partial Y_{BlPitchCom_2}}{\partial u_{HSS\_Spd}} \\ - !! \frac{\partial Y_{BlPitchCom_3}}{\partial u_{Yaw}} & \frac{\partial Y_{BlPitchCom_3}}{\partial u_{YawRate}} & \frac{\partial Y_{BlPitchCom_3}}{\partial u_{HSS\_Spd}} \\ - !! \frac{\partial Y_{YawMom}}{\partial u_{Yaw}} & \frac{\partial Y_{YawMom}}{\partial u_{YawRate}} & \frac{\partial Y_{YawMom}}{\partial u_{HSS\_Spd}} \\ - !! \frac{\partial Y_{GenTrq}}{\partial u_{Yaw}} & \frac{\partial Y_{GenTrq}}{\partial u_{YawRate}} & \frac{\partial Y_{GenTrq}}{\partial u_{HSS\_Spd}} \\ - !! \frac{\partial Y_{ElecPwr}}{\partial u_{Yaw}} & \frac{\partial Y_{ElecPwr}}{\partial u_{YawRate}} & \frac{\partial Y_{ElecPwr}}{\partial u_{HSS\_Spd}} \\ - !! \frac{\partial Y_{WriteOutput_i}}{\partial u_{Yaw}} & \frac{\partial Y_{WriteOutput_i}}{\partial u_{YawRate}} & \frac{\partial Y_{WriteOutput_i}}{\partial u_{HSS\_Spd}} \end{bmatrix} - !! = \begin{bmatrix} - !! 0 & 0 & 0 \\ - !! 0 & 0 & 0 \\ - !! 0 & 0 & 0 \\ - !! \frac{\partial Y_{YawMom}}{\partial u_{Yaw}} & \frac{\partial Y_{YawMom}}{\partial u_{YawRate}} & 0 \\ - !! 0 & 0 & \frac{\partial Y_{GenTrq}}{\partial u_{HSS\_Spd}} \\ - !! 0 & 0 & \frac{\partial Y_{ElecPwr}}{\partial u_{HSS\_Spd}} \\ - !! \frac{\partial Y_{WriteOutput_i}}{\partial u_{Yaw}} & \frac{\partial Y_{WriteOutput_i}}{\partial u_{YawRate}} & \frac{\partial Y_{WriteOutput_i}}{\partial u_{HSS\_Spd}} \end{bmatrix} - !!\f} - - - ! Note this is similiar to SrvD_CalcOutput - - if (.not. allocated(dYdu)) then - call allocAry(dYdu, SrvD_Indx_Y_WrOutput+p%NumOuts, 3, 'dYdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end if - dYdu = 0.0_R8Ki - - - ! ! Torque control: - !> Compute - !> \f$ \frac{\partial Y_{GenTrq}}{\partial u_{HSS\_Spd}} \f$ and - !> \f$ \frac{\partial Y_{ElecPwr}}{\partial u_{HSS\_Spd}} \f$ in servodyn::torque_jacobianpinput. - call Torque_JacobianPInput( t, u, p, x, xd, z, OtherState, m, GenTrq_du, ElecPwr_du, ErrStat, ErrMsg ) ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - dYdu(SrvD_Indx_Y_GenTrq, Indx_u_HSS_Spd) = GenTrq_du - dYdu(SrvD_Indx_Y_ElecPwr,Indx_u_HSS_Spd) = ElecPwr_du - - - ! Pitch control: - !> \f$ \frac{\partial Y_{BlPitchCom_k}}{\partial u} = 0 \f$ - - ! Yaw control: - !> \f$ \frac{\partial Y_{YawMom}}{\partial u_{Yaw}} = -p\%YawSpr \f$ - dYdu(SrvD_Indx_Y_YawMom,Indx_u_Yaw) = -p%YawSpr ! from Yaw_CalcOutput - !> \f$ \frac{\partial Y_{YawMom}}{\partial u_{YawRate}} = -p\%YawDamp \f$ - dYdu(SrvD_Indx_Y_YawMom,Indx_u_YawRate) = -p%YawDamp ! from Yaw_CalcOutput - - - !......................................................................................................................... - ! Calculate all of the available output channels (because they repeat for the derivative) here: - !......................................................................................................................... - AllOuts = 0.0_R8Ki ! all variables not specified below are zeros (either constant or disabled): - - AllOuts(:, GenTq) = 0.001_R8Ki*dYdu(SrvD_Indx_Y_GenTrq,:) - AllOuts(:, GenPwr) = 0.001_R8Ki*dYdu(SrvD_Indx_Y_ElecPwr,:) - AllOuts(:, YawMomCom) = -0.001_R8Ki*dYdu(SrvD_Indx_Y_YawMom,:) - - !............................................................................................................................... - ! Place the selected output channels into the WriteOutput(:) portion of the jacobian with the proper sign: - !............................................................................................................................... - - DO I = 1,p%NumOuts ! Loop through all selected output channels - dYdu(I+SrvD_Indx_Y_WrOutput,:) = p%OutParam(I)%SignM * AllOuts( :, p%OutParam(I)%Indx ) - ENDDO ! I - All selected output channels - - END IF - - IF ( PRESENT( dXdu ) ) THEN - if (allocated(dXdu)) deallocate(dXdu) - END IF - - IF ( PRESENT( dXddu ) ) THEN - if (allocated(dXddu)) deallocate(dXddu) - END IF - - IF ( PRESENT( dZdu ) ) THEN - if (allocated(dZdu)) deallocate(dZdu) - END IF - - -END SUBROUTINE SrvD_JacobianPInput -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and DZ/dx are returned. -!! Note SrvD does not have continuous states, so these are not set. -SUBROUTINE SrvD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(SrvD_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required); - !! Output fields are not used by this routine, but type is - !! available here so that mesh parameter information (i.e., - !! connectivity) does not have to be recalculated for dYdx. - 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 - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions - !! (Y) with respect to the continuous - !! states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state - !! functions (X) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state - !! functions (Xd) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state - !! functions (Z) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - - - - IF ( PRESENT( dYdx ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: - - ! allocate and set dYdx - - END IF - - IF ( PRESENT( dXdx ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: - - ! allocate and set dXdx - - END IF - - IF ( PRESENT( dXddx ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the continuous states (x) here: - - ! allocate and set dXddx - - END IF - - IF ( PRESENT( dZdx ) ) THEN - - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the continuous states (x) here: - - ! allocate and set dZdx - - END IF - - -END SUBROUTINE SrvD_JacobianPContState -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the discrete states (xd). The partial derivatives dY/dxd, dX/dxd, dXd/dxd, and DZ/dxd are returned. -!! Note SrvD does not have discrete states, so these are not set. -SUBROUTINE SrvD_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(SrvD_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required); - !! Output fields are not used by this routine, but type is - !! available here so that mesh parameter information (i.e., - !! connectivity) does not have to be recalculated for dYdxd. - 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 - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdxd(:,:) !< Partial derivatives of output functions - !! (Y) with respect to the discrete - !! states (xd) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdxd(:,:) !< Partial derivatives of continuous state - !! functions (X) with respect to the - !! discrete states (xd) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddxd(:,:)!< Partial derivatives of discrete state - !! functions (Xd) with respect to the - !! discrete states (xd) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdxd(:,:) !< Partial derivatives of constraint state - !! functions (Z) with respect to the - !! discrete states (xd) [intent in to avoid deallocation] - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - - - IF ( PRESENT( dYdxd ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the discrete states (xd) here: - - ! allocate and set dYdxd - - END IF - - IF ( PRESENT( dXdxd ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the discrete states (xd) here: - - ! allocate and set dXdxd - - END IF - - IF ( PRESENT( dXddxd ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the discrete states (xd) here: - - ! allocate and set dXddxd - - END IF - - IF ( PRESENT( dZdxd ) ) THEN - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the discrete states (xd) here: - - ! allocate and set dZdxd - - END IF - - -END SUBROUTINE SrvD_JacobianPDiscState -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the constraint states (z). The partial derivatives dY/dz, dX/dz, dXd/dz, and DZ/dz are returned. -!! Note SrvD does not have constraint states, so these are not set. -SUBROUTINE SrvD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(SrvD_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required); - !! Output fields are not used by this routine, but type is - !! available here so that mesh parameter information (i.e., - !! connectivity) does not have to be recalculated for dYdz. - 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 - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdz(:,:) !< Partial derivatives of output - !! functions (Y) with respect to the - !! constraint states (z) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdz(:,:) !< Partial derivatives of continuous - !! state functions (X) with respect to - !! the constraint states (z) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddz(:,:) !< Partial derivatives of discrete state - !! functions (Xd) with respect to the - !! constraint states (z) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdz(:,:) !< Partial derivatives of constraint - !! state functions (Z) with respect to - !! the constraint states (z) [intent in to avoid deallocation] - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - - IF ( PRESENT( dYdz ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z) here: - - ! allocate and set dYdz - - END IF - - IF ( PRESENT( dXdz ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the constraint states (z) here: - - ! allocate and set dXdz - - END IF - - IF ( PRESENT( dXddz ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the constraint states (z) here: - - ! allocate and set dXddz - - END IF - - IF ( PRESENT( dZdz ) ) THEN - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z) here: - - ! allocate and set dZdz - - END IF - - -END SUBROUTINE SrvD_JacobianPConstrState -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE SrvD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(SrvD_OutputType), INTENT(IN ) :: y !< Output at operating point - 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 - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - - - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (occurs after initial error) - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_GetOP' - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - - !.......................................... - IF ( PRESENT( u_op ) ) THEN - - if (.not. allocated(u_op)) then - CALL AllocAry( u_op, 3, 'u_op', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - end if - - - u_op(Indx_u_Yaw ) = u%Yaw - u_op(Indx_u_YawRate) = u%YawRate - u_op(Indx_u_HSS_Spd) = u%HSS_Spd - - END IF - - !.......................................... - IF ( PRESENT( y_op ) ) THEN - - if (.not. allocated(y_op)) then - CALL AllocAry( y_op, SrvD_Indx_Y_WrOutput+p%NumOuts, 'y_op', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - end if - - - do i=1,size(SrvD_Indx_Y_BlPitchCom) ! Note: Potentially limit to NumBl - if (i<=p%NumBl) then - y_op(SrvD_Indx_Y_BlPitchCom(i)) = y%BlPitchCom(i) - else - y_op(SrvD_Indx_Y_BlPitchCom(i)) = 0.0_ReKI - endif - end do - y_op(SrvD_Indx_Y_YawMom) = y%YawMom - y_op(SrvD_Indx_Y_GenTrq) = y%GenTrq - y_op(SrvD_Indx_Y_ElecPwr) = y%ElecPwr - do i=1,p%NumOuts - y_op(i+SrvD_Indx_Y_WrOutput) = y%WriteOutput(i) - end do - - END IF - - IF ( PRESENT( x_op ) ) THEN - - END IF - - IF ( PRESENT( dx_op ) ) THEN - - END IF - - IF ( PRESENT( xd_op ) ) THEN - - END IF - - IF ( PRESENT( z_op ) ) THEN - - END IF - -END SUBROUTINE SrvD_GetOP -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine validates the inputs from the primary input file. -SUBROUTINE ValidatePrimaryData( InitInp, InputFileData, ErrStat, ErrMsg ) -!.................................................................................................................................. - - ! Passed variables: - - TYPE(SrvD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine - TYPE(SrvD_InputFile), INTENT(IN) :: InputFileData !< All the data in the ServoDyn input file - INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message - - - ! local variables - INTEGER(IntKi) :: K ! Blade number - CHARACTER(*), PARAMETER :: RoutineName = 'ValidatePrimaryData' - INTEGER(IntKi) :: ErrStat2 !< Error status - CHARACTER(ErrMsgLen) :: ErrMsg2 !< temporary Error message if ErrStat /= ErrID_None - - - ErrStat = ErrID_None - ErrMsg = '' - - CALL Pitch_ValidateData() - CALL Yaw_ValidateData() - CALL TipBrake_ValidateData() - CALL Torque_ValidateData() - CALL HSSBr_ValidateData() -!FIXME: add validation for StC inputs -! CALL StC_ValidateData() - - ! Checks for linearization: - if ( InitInp%Linearize ) then - - if ( InputFileData%PCMode /= ControlMode_NONE ) & - call SetErrStat(ErrID_Fatal,"PCMode must be 0 for linearization.",ErrStat,ErrMsg,RoutineName) - if ( InputFileData%VSContrl /= ControlMode_NONE .and. InputFileData%VSContrl /= ControlMode_SIMPLE ) & - call SetErrStat(ErrID_Fatal,"VSContrl must be 0 or 1 for linearization.",ErrStat,ErrMsg,RoutineName) - if ( InputFileData%GenModel /= ControlMode_SIMPLE .and. InputFileData%GenModel /= ControlMode_ADVANCED ) & - call SetErrStat(ErrID_Fatal,"GenModel must be 1 or 2 for linearization.",ErrStat,ErrMsg,RoutineName) - - if ( .not. InputFileData%GenTiStr ) & - call SetErrStat(ErrID_Fatal,"GenTiStr must be TRUE for linearization.",ErrStat,ErrMsg,RoutineName) - if ( .not. InputFileData%GenTiStp ) & - call SetErrStat(ErrID_Fatal,"GenTiStp must be TRUE for linearization.",ErrStat,ErrMsg,RoutineName) - - if (InputFileData%HSSBrMode /= ControlMode_NONE) & - call SetErrStat(ErrID_Fatal,"HSSBrMode must be 0 for linearization.",ErrStat,ErrMsg,RoutineName) - if (InputFileData%YCMode /= ControlMode_NONE) & - call SetErrStat(ErrID_Fatal,"YCMode must be 0 for linearization.",ErrStat,ErrMsg,RoutineName) - - if ((InputFileData%NumNStC + InputFileData%NumTStC + InputFileData%NumBStC + InputFileData%NumSStC) > 0_IntKi) & - call SetErrStat(ErrID_Fatal,"StrucCtrl module is not currently allowed in linearization. NumNStC, NumTStC, NumBStC, and NumSStC must all be ZERO.",ErrStat,ErrMsg,RoutineName) - - if (InitInp%TrimCase /= TrimCase_none) then - if (InitInp%TrimCase /= TrimCase_yaw .and. InitInp%TrimCase /= TrimCase_torque .and. InitInp%TrimCase /= TrimCase_pitch) then - call SetErrStat(ErrID_Fatal,"Invalid value entered for TrimCase.",ErrStat,ErrMsg,RoutineName) - else - if (InitInp%TrimGain <= 0.0_ReKi) call SetErrStat(ErrID_Fatal,"TrimGain must be a positive number.",ErrStat,ErrMsg,RoutineName) - end if - end if - - end if - - -! this code was in FASTSimulink.f90 in FAST v7: - IF (Cmpl4SFun) THEN !warn if ServoDyn isn't going to use the inputs from the Simulink interface - IF (InputFileData%YCMode /= ControlMode_EXTERN) CALL SetErrStat( ErrID_Info, 'Yaw angle and rate are not commanded from Simulink model.', ErrStat, ErrMsg, RoutineName ) - IF (InputFileData%PCMode /= ControlMode_EXTERN) CALL SetErrStat( ErrID_Info, 'Pitch angles are not commanded from Simulink model.', ErrStat, ErrMsg, RoutineName ) - IF (InputFileData%VSContrl /= ControlMode_EXTERN) CALL SetErrStat( ErrID_Info, 'Generator torque and power are not commanded from Simulink model.', ErrStat, ErrMsg, RoutineName ) - IF (InputFileData%HSSBrMode /= ControlMode_EXTERN) CALL SetErrStat( ErrID_Info, 'HSS brake is not commanded from Simulink model.', ErrStat, ErrMsg, RoutineName ) - END IF - - RETURN - -CONTAINS - !------------------------------------------------------------------------------------------------------------------------------- - !> This routine performs the checks on inputs for the pitch controller. - SUBROUTINE Pitch_ValidateData( ) - !............................................................................................................................... - - ! Check that the requested pitch control modes are valid: - - IF ( .NOT. Cmpl4SFun .AND. .NOT. Cmpl4LV ) THEN - - IF ( InputFileData%PCMode == ControlMode_EXTERN ) THEN - CALL SetErrStat( ErrID_Fatal, 'PCMode can equal '//TRIM(Num2LStr(ControlMode_EXTERN))//' only when ServoDyn is interfaced with Simulink or LabVIEW.'// & - ' Set PCMode to 0, 3, or 5 or interface ServoDyn with Simulink or LabVIEW.', ErrStat, ErrMsg, RoutineName ) - END IF - - END IF - - - IF ( InputFileData%PCMode /= ControlMode_NONE .and. InputFileData%PCMode /= ControlMode_USER ) THEN - IF ( InputFileData%PCMode /= ControlMode_EXTERN .and. InputFileData%PCMode /= ControlMode_DLL ) & - CALL SetErrStat( ErrID_Fatal, 'PCMode must be 0, 3, 4, or 5.', ErrStat, ErrMsg, RoutineName ) - ENDIF - - - ! Time that pitch control is enabled: - - IF ( InputFileData%TPCOn < 0.0_DbKi ) THEN - CALL SetErrStat( ErrID_Fatal, 'TPCOn must not be negative.', ErrStat, ErrMsg, RoutineName ) - ENDIF - - ! Make sure the number of blades in the simulation doesn't exceed 3: - - IF ( InitInp%NumBl > SIZE(InputFileData%TPitManS,1) ) CALL SetErrStat( ErrID_Fatal, 'Number of blades exceeds input values.', ErrStat, ErrMsg, RoutineName ) - - ! Check the pitch-maneuver start times and rates: - - DO K=1,MIN(InitInp%NumBl,SIZE(InputFileData%TPitManS)) - - IF ( InputFileData%TPitManS(K) < 0.0_DbKi ) & - CALL SetErrStat( ErrID_Fatal, 'TPitManS('//TRIM( Num2LStr( K ) )//') must not be negative.', ErrStat, ErrMsg, RoutineName ) - IF ( EqualRealNos( InputFileData%PitManRat(K), 0.0_ReKi ) ) & - CALL SetErrStat( ErrID_Fatal, 'PitManRat('//TRIM( Num2LStr(K) )//') must not be 0.', ErrStat, ErrMsg, RoutineName ) - - ENDDO ! K - - -!??? IF ( ANY( p%BlPitchInit <= -pi ) .OR. ANY( p%BlPitchInit > pi ) ) THEN -! CALL SetErrStat( ErrID_Fatal, 'BlPitchInit('//TRIM( Num2LStr( K ) )//') must be in the range (-pi,pi] radians (i.e., (-180,180] degrees).' , ErrStat, ErrMsg, RoutineName ) - - - - END SUBROUTINE Pitch_ValidateData - !------------------------------------------------------------------------------------------------------------------------------- - !> This routine performs the checks on inputs for the yaw controller. - SUBROUTINE Yaw_ValidateData( ) - !............................................................................................................................... - - ! checks for yaw control mode: - IF ( InputFileData%YCMode /= ControlMode_NONE .and. InputFileData%YCMode /= ControlMode_USER ) THEN - IF ( InputFileData%YCMode /= ControlMode_DLL .and. InputFileData%YCMode /= ControlMode_EXTERN ) & - CALL SetErrStat( ErrID_Fatal, 'YCMode must be 0, 3, 4 or 5.', ErrStat, ErrMsg, RoutineName ) - ENDIF - - - ! Some special checks based on whether inputs will come from external source (e.g., Simulink, LabVIEW) - IF ( .NOT. Cmpl4SFun .AND. .NOT. Cmpl4LV ) THEN - - IF ( InputFileData%YCMode == ControlMode_EXTERN ) THEN - CALL SetErrStat( ErrID_Fatal, 'YCMode can equal '//TRIM(Num2LStr(ControlMode_EXTERN))//' only when ServoDyn is interfaced with Simulink or LabVIEW.'// & - ' Set YCMode to 0, 3, or 5 or interface ServoDyn with Simulink or LabVIEW.', ErrStat, ErrMsg, RoutineName ) - END IF - - END IF - - - ! Check the start time to enable yaw control mode: - - IF ( InputFileData%TYCOn < 0.0_DbKi ) THEN - CALL SetErrStat( ErrID_Fatal, 'TYCOn must not be negative.', ErrStat, ErrMsg, RoutineName ) - ENDIF - - - ! Check the nacelle-yaw-maneuver start times and rates: - IF ( InputFileData%TYawManS < 0.0_DbKi ) CALL SetErrStat( ErrID_Fatal, 'TYawManS must not be negative.', ErrStat, ErrMsg, RoutineName ) - IF ( EqualRealNos( InputFileData%YawManRat, 0.0_ReKi ) ) CALL SetErrStat( ErrID_Fatal, 'YawManRat must not be 0.', ErrStat, ErrMsg, RoutineName ) - ! IF ( InputFileData%TYawManE < InputFileData%TYawManS ) CALL SetErrStat( ErrID_Fatal, 'TYawManE must not be less than TYawManS.', ErrStat, ErrMsg, RoutineName ) - - - ! Check the nacelle-yaw spring and damping constants: - - IF ( InputFileData%YawSpr < 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'YawSpr must not be negative.' , ErrStat, ErrMsg, RoutineName ) - IF ( InputFileData%YawDamp < 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'YawDamp must not be negative.', ErrStat, ErrMsg, RoutineName ) - - ! Check the neutral position: - IF ( InputFileData%YawNeut <= -pi .OR. InputFileData%YawNeut > pi ) & - CALL SetErrStat( ErrID_Fatal, 'YawNeut must be in the range (-pi, pi] radians (i.e., (-180,180] degrees).', ErrStat, ErrMsg, RoutineName ) - - - END SUBROUTINE Yaw_ValidateData - !------------------------------------------------------------------------------------------------------------------------------- - !> This routine performs the checks on inputs for the tip brakes. - SUBROUTINE TipBrake_ValidateData( ) - !............................................................................................................................... - - !IF ( TBDrConN < 0.0 ) CALL ProgAbort ( ' TBDrConN must not be negative.' ) - !IF ( TBDrConD < TBDrConN ) CALL ProgAbort( ' TBDrConD must not be less than TBDrConN.' ) - !IF ( p%TpBrDT < 0.0_DbKi ) CALL ProgAbort ( ' TpBrDT must not be negative.' ) - - - !DO K=1,MIN(InitInp%NumBl,SIZE(InputFileData%TTpBrDp)) - ! IF ( InputFileData%TTpBrDp(K) < 0.0_DbKi ) & - ! CALL SetErrStat( ErrID_Fatal, 'TTpBrDp(' //TRIM( Num2LStr( K ) )//') must not be negative.', ErrStat, ErrMsg, RoutineName ) - ! IF ( InputFileData%TBDepISp(K) < 0.0_DbKi ) & - ! CALL SetErrStat( ErrID_Fatal, 'TBDepISp('//TRIM( Num2LStr( K ) )//') must not be negative.', ErrStat, ErrMsg, RoutineName ) - !ENDDO ! K - - - END SUBROUTINE TipBrake_ValidateData - !------------------------------------------------------------------------------------------------------------------------------- - !> This routine performs the checks on inputs for the torque controller. - SUBROUTINE Torque_ValidateData( ) - !............................................................................................................................... - IF ( .NOT. Cmpl4SFun .AND. .NOT. Cmpl4LV ) THEN - - IF ( InputFileData%VSContrl == ControlMode_EXTERN ) THEN - CALL SetErrStat( ErrID_Fatal, 'VSContrl can equal '//TRIM(Num2LStr(ControlMode_EXTERN))//' only when ServoDyn is interfaced with Simulink or LabVIEW.'// & - ' Set VSContrl to 0, 1, 3, or 5 or interface ServoDyn with Simulink or LabVIEW.', ErrStat, ErrMsg, RoutineName ) - END IF - END IF - - - ! checks for generator and torque control: - IF ( InputFileData%VSContrl /= ControlMode_NONE .and. & - InputFileData%VSContrl /= ControlMode_SIMPLE .AND. InputFileData%VSContrl /= ControlMode_USER ) THEN - IF ( InputFileData%VSContrl /= ControlMode_DLL .AND. InputFileData%VSContrl /=ControlMode_EXTERN ) & - CALL SetErrStat( ErrID_Fatal, 'VSContrl must be either 0, 1, 3, 4, or 5.', ErrStat, ErrMsg, RoutineName ) - ENDIF - - IF ( InputFileData%SpdGenOn < 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'SpdGenOn must not be negative.', ErrStat, ErrMsg, RoutineName ) - IF ( InputFileData%TimGenOn < 0.0_DbKi ) CALL SetErrStat( ErrID_Fatal, 'TimGenOn must not be negative.', ErrStat, ErrMsg, RoutineName ) - IF ( InputFileData%TimGenOf < 0.0_DbKi ) CALL SetErrStat( ErrID_Fatal, 'TimGenOf must not be negative.', ErrStat, ErrMsg, RoutineName ) - ! IF ( InputFileData%TimGenOf < InputFileData%TimGenOn ) CALL SetErrStat( ErrID_Fatal, 'TimGenOf must not be before TimGenOn.', ErrStat, ErrMsg, RoutineName ) - IF ( InputFileData%GenEff < 0.0_ReKi .OR. InputFileData%GenEff > 1.0_ReKi ) THEN - CALL SetErrStat( ErrID_Fatal, 'GenEff must be in the range [0, 1] (i.e., [0, 100] percent)', ErrStat, ErrMsg, RoutineName ) - END IF - - - ! checks for variable-speed torque control: - IF ( InputFileData%VSContrl == ControlMode_SIMPLE ) THEN - IF ( InputFileData%VS_RtGnSp <= 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'VS_RtGnSp must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - IF ( InputFileData%VS_RtTq < 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'VS_RtTq must not be negative.', ErrStat, ErrMsg, RoutineName ) - IF ( InputFileData%VS_Rgn2K < 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'VS_Rgn2K must not be negative.', ErrStat, ErrMsg, RoutineName ) - IF ( InputFileData%VS_Rgn2K*InputFileData%VS_RtGnSp**2 > InputFileData%VS_RtTq ) & - CALL SetErrStat( ErrID_Fatal, 'VS_Rgn2K*VS_RtGnSp^2 must not be greater than VS_RtTq.', ErrStat, ErrMsg, RoutineName ) - IF ( InputFileData%VS_SlPc <= 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'VS_SlPc must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - - ! checks for generator models (VSControl == 0): - ELSE IF ( InputFileData%VSContrl == ControlMode_NONE ) THEN - - IF ( InputFileData%GenModel /= ControlMode_SIMPLE .AND. InputFileData%GenModel /= ControlMode_ADVANCED .AND. InputFileData%GenModel /= ControlMode_USER ) THEN - CALL SetErrStat( ErrID_Fatal, 'GenModel must be either 1, 2, or 3.', ErrStat, ErrMsg, RoutineName ) - ENDIF - - ! checks for simple induction generator (VSControl=0 & GenModel=1): - IF ( InputFileData%GenModel == ControlMode_SIMPLE ) THEN - IF ( InputFileData%SIG_SlPc <= 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'SIG_SlPc must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - IF ( InputFileData%SIG_SySp <= 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'SIG_SySp must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - IF ( InputFileData%SIG_RtTq <= 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'SIG_RtTq must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - IF ( InputFileData%SIG_PORt < 1.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'SIG_PORt must not be less than 1.' , ErrStat, ErrMsg, RoutineName ) - - ! checks for Thevenin-equivalent induction generator (VSControl=0 & GenModel=2): - ELSE IF ( InputFileData%GenModel == ControlMode_ADVANCED ) THEN - IF ( InputFileData%TEC_Freq <= 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'TEC_Freq must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - IF ( InputFileData%TEC_NPol <= 0_IntKi .OR. MOD( InputFileData%TEC_NPol, 2_IntKi ) /= 0_IntKi ) & - CALL SetErrStat( ErrID_Fatal, 'TEC_NPol must be an even number greater than zero.', ErrStat, ErrMsg, RoutineName ) - IF ( InputFileData%TEC_SRes <= 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'TEC_SRes must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - IF ( InputFileData%TEC_RRes <= 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'TEC_RRes must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - IF ( InputFileData%TEC_VLL <= 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'TEC_VLL must be greater than zero.' , ErrStat, ErrMsg, RoutineName ) - IF ( InputFileData%TEC_SLR <= 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'TEC_SLR must be greater than zero.' , ErrStat, ErrMsg, RoutineName ) - IF ( InputFileData%TEC_RLR <= 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'TEC_RLR must be greater than zero.' , ErrStat, ErrMsg, RoutineName ) - IF ( InputFileData%TEC_MR <= 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'TEC_MR must be greater than zero.' , ErrStat, ErrMsg, RoutineName ) - END IF - - END IF - - END SUBROUTINE Torque_ValidateData - !------------------------------------------------------------------------------------------------------------------------------- - !> This routine performs the checks on inputs for the high-speed shaft brake. - SUBROUTINE HSSBr_ValidateData( ) - - ! Some special checks based on whether inputs will come from external source (e.g., Simulink, LabVIEW) - IF ( .NOT. Cmpl4SFun .AND. .NOT. Cmpl4LV ) THEN - - IF ( InputFileData%HSSBrMode == ControlMode_EXTERN ) THEN - CALL SetErrStat( ErrID_Fatal, 'HSSBrMode can be '//TRIM(Num2LStr(ControlMode_EXTERN))//' only when implemented in Simulink or LabVIEW.', ErrStat, ErrMsg, RoutineName ) - ENDIF - - END IF - - ! checks for high-speed shaft brake: - IF ( InputFileData%HSSBrMode /= ControlMode_NONE .and. & - InputFileData%HSSBrMode /= ControlMode_SIMPLE .and. InputFileData%HSSBrMode /= ControlMode_USER ) THEN - IF ( InputFileData%HSSBrMode /= ControlMode_DLL .and. InputFileData%HSSBrMode /= ControlMode_EXTERN ) & - CALL SetErrStat( ErrID_Fatal, 'HSSBrMode must be 0, 1, 3, 4, or 5.', ErrStat, ErrMsg, RoutineName ) - END IF - IF ( InputFileData%THSSBrDp < 0.0_DbKi ) CALL SetErrStat( ErrID_Fatal, 'THSSBrDp must not be negative.', ErrStat, ErrMsg, RoutineName ) - IF ( InputFileData%HSSBrDT < 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'HSSBrDT must not be negative.', ErrStat, ErrMsg, RoutineName ) - IF ( InputFileData%HSSBrTqF < 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'HSSBrTqF must not be negative.', ErrStat, ErrMsg, RoutineName ) - - END SUBROUTINE HSSBr_ValidateData - !------------------------------------------------------------------------------------------------------------------------------- -END SUBROUTINE ValidatePrimaryData -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine sets the parameters, based on the data stored in InputFileData. -SUBROUTINE SrvD_SetParameters( InputFileData, p, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(SrvD_InputFile), INTENT(INOUT) :: InputFileData !< Data stored in the module's input file (intent OUT for MOVE_ALLOC) - TYPE(SrvD_ParameterType), INTENT(INOUT) :: p !< The module's parameter data - INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error status code - CHARACTER(*), INTENT(OUT) :: ErrMsg !< The error message, if an error occurred - - ! Local variables - REAL(ReKi) :: ComDenom ! Common denominator of variables used in the TEC model - REAL(ReKi) :: SIG_RtSp ! Rated speed - REAL(ReKi) :: TEC_K1 ! K1 term for Thevenin-equivalent circuit - REAL(ReKi) :: TEC_K2 ! K2 term for Thevenin-equivalent circuit - - INTEGER(IntKi) :: ErrStat2 ! Temporary error ID - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary message describing error - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_SetParameters' - - - - ! Initialize variables - - ErrStat = ErrID_None - ErrMsg = '' - - - p%DT = InputFileData%DT - - !............................................. - ! Pitch control parameters - !............................................. - - p%PCMode = InputFileData%PCMode - p%TPCOn = InputFileData%TPCOn - - CALL AllocAry( p%TPitManS, p%NumBl, 'TPitManS', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName); p%TPitManS =0.0_DbKi - CALL AllocAry( p%BlPitchF, p%NumBl, 'BlPitchF', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName); p%BlPitchF =0.0_ReKi - CALL AllocAry( p%PitManRat, p%NumBl, 'PitManRat', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName); p%PitManRat=0.0_ReKi - IF (ErrStat >= AbortErrLev) RETURN - - - p%TPitManS = InputFileData%TPitManS( 1:min(p%NumBl,size(InputFileData%TPitManS))) - p%BlPitchF = InputFileData%BlPitchF( 1:min(p%NumBl,size(InputFileData%BlPitchF))) - p%PitManRat = InputFileData%PitManRat(1:min(p%NumBl,size(InputFileData%PitManRat))) - - !............................................. - ! Set generator and torque control parameters: - !............................................. - p%VSContrl = InputFileData%VSContrl - p%GenModel = InputFileData%GenModel - p%GenEff = InputFileData%GenEff - p%GenTiStr = InputFileData%GenTiStr - p%GenTiStp = InputFileData%GenTiStp - p%SpdGenOn = InputFileData%SpdGenOn - p%TimGenOn = InputFileData%TimGenOn - p%TimGenOf = InputFileData%TimGenOf - - - p%THSSBrFl = InputFileData%THSSBrDp + InputFileData%HSSBrDT ! Time at which shaft brake is fully deployed - - SELECT CASE ( p%VSContrl ) - CASE ( ControlMode_NONE ) ! None - - IF ( p%GenModel == ControlMode_SIMPLE ) THEN ! Simple induction generator - - SIG_RtSp = InputFileData%SIG_SySp*( 1.0 + InputFileData%SIG_SlPc ) ! Rated speed - p%SIG_POSl = InputFileData%SIG_PORt*( SIG_RtSp - InputFileData%SIG_SySp ) ! Pullout slip - p%SIG_POTq = InputFileData%SIG_RtTq*InputFileData%SIG_PORt ! Pullout torque - p%SIG_Slop = InputFileData%SIG_RtTq/( SIG_RtSp - InputFileData%SIG_SySp ) ! SIG torque/speed slope - - p%SIG_SySp = InputFileData%SIG_SySp - ELSEIF ( p%GenModel == ControlMode_ADVANCED ) THEN ! Thevenin-equivalent induction generator - - ComDenom = InputFileData%TEC_SRes**2 + ( InputFileData%TEC_SLR + InputFileData%TEC_MR )**2 ! common denominator used in many of the following equations - - p%TEC_Re1 = InputFileData%TEC_SRes*( InputFileData%TEC_MR**2 )/ComDenom ! Thevenin's equivalent stator resistance (ohms) - p%TEC_Xe1 = InputFileData%TEC_MR*( InputFileData%TEC_SRes**2 + InputFileData%TEC_SLR* & - ( InputFileData%TEC_SLR + InputFileData%TEC_MR) )/ComDenom ! Thevenin's equivalent stator leakage reactance (ohms) - p%TEC_V1a = InputFileData%TEC_MR*InputFileData%TEC_VLL/SQRT( 3.0*ComDenom ) ! Thevenin equivalent source voltage - p%TEC_SySp = 4.0*Pi*InputFileData%TEC_Freq/InputFileData%TEC_NPol ! Thevenin equivalent synchronous speed - TEC_K1 = ( p%TEC_Xe1 + InputFileData%TEC_RLR )**2 ! Thevenin equivalent K1 term - TEC_K2 = ( InputFileData%TEC_MR**2 )/ComDenom ! Thevenin equivalent K2 term - p%TEC_A0 = InputFileData%TEC_RRes*TEC_K2/p%TEC_SySp ! Thevenin equivalent A0 term - p%TEC_C0 = InputFileData%TEC_RRes**2 ! Thevenin equivalent C0 term - p%TEC_C1 = -2.0*p%TEC_Re1*InputFileData%TEC_RRes ! Thevenin equivalent C1 term - p%TEC_C2 = p%TEC_Re1**2 + TEC_K1 ! Thevenin equivalent C2 term - - p%TEC_MR = InputFileData%TEC_MR - p%TEC_RLR = InputFileData%TEC_RLR - p%TEC_RRes = InputFileData%TEC_RRes - p%TEC_SRes = InputFileData%TEC_SRes - p%TEC_VLL = InputFileData%TEC_VLL - - ENDIF - - - CASE ( ControlMode_SIMPLE ) ! Simple variable-speed control - - p%VS_SySp = InputFileData%VS_RtGnSp/( 1.0 + InputFileData%VS_SlPc ) ! Synchronous speed of region 2 1/2 induction generator. - IF ( InputFileData%VS_SlPc < SQRT(EPSILON(InputFileData%VS_SlPc) ) ) THEN ! We don't have a region 2 so we'll use VS_TrGnSp = VS_RtGnSp - p%VS_Slope = 9999.9 - p%VS_TrGnSp = InputFileData%VS_RtGnSp - ELSE - p%VS_Slope = InputFileData%VS_RtTq /( InputFileData%VS_RtGnSp - p%VS_SySp ) ! Torque/speed slope of region 2 1/2 induction generator. - IF ( ABS(InputFileData%VS_Rgn2K) < EPSILON(InputFileData%VS_SlPc) ) THEN ! .TRUE. if the Region 2 torque is flat, and thus, the denominator in the ELSE condition is zero - p%VS_TrGnSp = p%VS_SySp ! Transitional generator speed between regions 2 and 2 1/2. - ELSE ! .TRUE. if the Region 2 torque is quadratic with speed - p%VS_TrGnSp = ( p%VS_Slope - SQRT( p%VS_Slope*( p%VS_Slope - 4.0*InputFileData%VS_Rgn2K*p%VS_SySp ) ) ) & - / ( 2.0*InputFileData%VS_Rgn2K ) ! Transitional generator speed between regions 2 and 2 1/2. - ENDIF - END IF - - p%VS_Rgn2K = InputFileData%VS_Rgn2K - p%VS_RtGnSp = InputFileData%VS_RtGnSp - p%VS_RtTq = InputFileData%VS_RtTq - - END SELECT - - !............................................. - ! High-speed shaft brake parameters - !............................................. - p%HSSBrMode = InputFileData%HSSBrMode - p%THSSBrDp = InputFileData%THSSBrDp - p%HSSBrDT = InputFileData%HSSBrDT - p%HSSBrTqF = InputFileData%HSSBrTqF - - !............................................. - ! Nacelle-yaw control parameters - !............................................. - p%YCMode = InputFileData%YCMode - p%TYCOn = InputFileData%TYCOn - p%YawNeut = InputFileData%YawNeut !bjj: this should be renamed... - p%YawSpr = InputFileData%YawSpr - p%YawDamp = InputFileData%YawDamp - - p%TYawManS = InputFileData%TYawManS - p%NacYawF = InputFileData%NacYawF - p%YawManRat = InputFileData%YawManRat ! we change the sign of this variable later - - !............................................. - ! tip-brake parameters (not used in this version) - !............................................. - CALL AllocAry( p%TBDepISp, p%NumBl, 'TBDepISp', ErrStat2, ErrMsg2 ) ! Deployment-initiation speed for the tip brakes - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - p%TBDepISp = HUGE(p%TBDepISp) ! Deployment-initiation speed for the tip brakes: basically never deploy them. Eventually this will be added back? - !p%TBDepISp = InputFileData%TBDepISp*RPM2RPS - - p%TpBrDT = HUGE(p%TpBrDT) ! Time for tip brakes to reach full deployment, once deployed - p%TBDrConN = 0.0_ReKi ! tip-drag constant during normal operation - p%TBDrConD = 0.0_ReKi ! tip-drag constant during fully deployed operation - - - !............................................. - ! Tuned-mass damper parameters - !............................................. - p%NumBStC = InputFileData%NumBStC - p%NumNStC = InputFileData%NumNStC - p%NumTStC = InputFileData%NumTStC - p%NumSStC = InputFileData%NumSStC - - !............................................. - ! Determine if the BladedDLL should be called - !............................................. - - IF ( p%PCMode == ControlMode_DLL .OR. & - p%YCMode == ControlMode_DLL .OR. & - p%VSContrl == ControlMode_DLL .OR. & - p%HSSBrMode == ControlMode_DLL ) THEN - - p%UseBladedInterface = .TRUE. - - ELSE - p%UseBladedInterface = .FALSE. - END IF - - !............................................. - ! Parameters for file output (not including Bladed DLL logging outputs) - !............................................. - p%NumOuts = InputFileData%NumOuts - p%NumOuts_DLL = 0 ! set to zero and overwritten if/when the DLL uses it - - CALL SetOutParam(InputFileData%OutList, p, ErrStat2, ErrMsg2 ) ! requires: p%NumOuts, p%NumBl; sets: p%OutParam. - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF ( InputFileData%TabDelim ) THEN - p%Delim = TAB - ELSE - p%Delim = ' ' - END IF - - -END SUBROUTINE SrvD_SetParameters -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine for computing the yaw output: a yaw moment. This routine is used in both loose and tight coupling. -SUBROUTINE Yaw_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t - TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(SrvD_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- - !! nectivity information does not have to be recalculated) - 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 - - ! local variables - REAL(ReKi) :: YawPosCom ! Commanded yaw angle from user-defined routines, rad. - REAL(ReKi) :: YawRateCom ! Commanded yaw rate from user-defined routines, rad/s. - REAL(ReKi) :: YawPosComInt ! Integrated yaw commanded (from DLL), rad - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - !................................................................... - ! Override standard yaw control with a linear maneuver if necessary: - !................................................................... - - IF ( OtherState%BegYawMan ) THEN ! Override yaw maneuver is occuring. - - IF ( t >= OtherState%TYawManE ) THEN ! Override yaw maneuver has ended; yaw command is fixed at NacYawF - - YawPosCom = p%NacYawF - YawRateCom = 0.0_ReKi - - ELSE ! Override yaw maneuver in linear ramp - - ! Increment the command yaw and rate using YawManRat - YawRateCom = SIGN( p%YawManRat, p%NacYawF - OtherState%NacYawI ) ! Modify the sign of p%YawManRat based on the direction of the yaw maneuever - YawPosCom = OtherState%NacYawI + YawRateCom*( t - p%TYawManS ) - - ENDIF - - ELSE - - if (p%YCMode == ControlMode_DLL) then - if (m%dll_data%Yaw_Cntrl == GH_DISCON_YAW_CONTROL_TORQUE .or. m%dll_data%OverrideYawRateWithTorque) then - - y%YawMom = m%dll_data%YawTorqueDemand - - return - end if - end if - - !................................................................... - ! Calculate standard yaw position and rate commands: - !................................................................... - - YawPosComInt = OtherState%YawPosComInt ! get state value. We don't update the state here. - CALL CalculateStandardYaw(t, u, p, m, YawPosCom, YawRateCom, YawPosComInt, ErrStat, ErrMsg) - - END IF - !................................................................... - ! Calculate the yaw moment: - !................................................................... - - y%YawMom = - p%YawSpr *( u%Yaw - YawPosCom ) & ! {-f(qd,q,t)}SpringYaw - - p%YawDamp*( u%YawRate - YawRateCom ) ! {-f(qd,q,t)}DampYaw; - - - !................................................................... - ! Apply trim case for linearization: - ! prescribed yaw will be wrong in this case..... - !................................................................... - if (p%TrimCase==TrimCase_yaw) then - y%YawMom = y%YawMom + xd%CtrlOffset * p%YawSpr - end if - - -END SUBROUTINE Yaw_CalcOutput -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calculates standard yaw position and rate commands: YawPosCom and YawRateCom. -SUBROUTINE CalculateStandardYaw(t, u, p, m, YawPosCom, YawRateCom, YawPosComInt, ErrStat, ErrMsg) - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc (optimization) variables - REAL(ReKi), INTENT( OUT) :: YawPosCom !< Commanded yaw angle from user-defined routines, rad. - REAL(ReKi), INTENT( OUT) :: YawRateCom !< Commanded yaw rate from user-defined routines, rad/s. - REAL(ReKi), INTENT(INOUT) :: YawPosComInt !< Internal variable that integrates the commanded yaw rate and passes it to YawPosCom - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ErrStat = ErrID_None - ErrMsg = "" - - !................................................................... - ! Calculate standard yaw position and rate commands: - !................................................................... - - - IF ( t >= p%TYCOn .AND. p%YCMode /= ControlMode_NONE ) THEN ! Time now to enable active yaw control. - - - SELECT CASE ( p%YCMode ) ! Which yaw control mode are we using? (we already took care of ControlMode_None) - - CASE ( ControlMode_SIMPLE ) ! Simple ... BJJ: THIS will be NEW - - - CASE ( ControlMode_USER ) ! User-defined from routine UserYawCont(). - - CALL UserYawCont ( u%Yaw, u%YawRate, u%WindDir, u%YawErr, p%NumBl, t, p%DT, p%RootName, YawPosCom, YawRateCom ) - - CASE ( ControlMode_EXTERN ) ! User-defined from Simulink or LabVIEW - - YawPosCom = u%ExternalYawPosCom - YawRateCom = u%ExternalYawRateCom - - CASE ( ControlMode_DLL ) ! User-defined yaw control from Bladed-style DLL - - YawPosComInt = YawPosComInt + m%dll_data%YawRateCom*p%DT ! Integrated yaw position - YawPosCom = YawPosComInt !bjj: was this: LastYawPosCom + YawRateCom*( ZTime - LastTime ) - YawRateCom = m%dll_data%YawRateCom - - if (m%dll_data%OverrideYawRateWithTorque .or. m%dll_data%Yaw_Cntrl == GH_DISCON_YAW_CONTROL_TORQUE) then - call SetErrStat(ErrID_Fatal, "Unable to calculate yaw rate control because yaw torque control (or override) was requested from DLL.", ErrStat, ErrMsg, "CalculateStandardYaw") - return - end if - - END SELECT - - - ELSE ! Do not control yaw, maintain initial (neutral) yaw angles - - YawPosCom = p%YawNeut - YawRateCom = 0.0_ReKi - - ENDIF - -END SUBROUTINE CalculateStandardYaw -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine updates the other states associated with the yaw controller: BegYawMan, NacYawI, and TYawManE. -SUBROUTINE Yaw_UpdateStates( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< t+dt - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t+dt - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT(INOUT) :: x !< Input: Continuous states at t; - !! Output: Continuous states at t + dt - TYPE(SrvD_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t; - !! Output: Discrete states at t + dt - TYPE(SrvD_ConstraintStateType), INTENT(INOUT) :: z !< Input: Constraint states at t; - !! Output: Constraint states at t + dt - TYPE(SrvD_OtherStateType), INTENT(INOUT) :: OtherState !< Other states: Other states at t; - !! Output: Other states at t + dt - 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 - - ! local variables - REAL(ReKi) :: YawPosCom ! Commanded yaw angle from user-defined routines, rad. - REAL(ReKi) :: YawRateCom ! Commanded yaw rate from user-defined routines, rad/s. - REAL(ReKi) :: YawManRat ! Yaw maneuver rate, rad/s - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - - !................................................................... - ! Determine if override of standard yaw control with a linear maneuver is necessary: - !................................................................... - - IF ( t >= p%TYawManS ) THEN ! Override yaw maneuver is occuring. - - - IF ( .not. OtherState%BegYawMan ) THEN ! Override yaw maneuver is just beginning (possibly again). - - CALL CalculateStandardYaw(t, u, p, m, YawPosCom, YawRateCom, OtherState%YawPosComInt, ErrStat, ErrMsg) - - OtherState%NacYawI = YawPosCom !bjj: was u%Yaw ! Store the initial (current) yaw, at the start of the yaw maneuver - YawManRat = SIGN( p%YawManRat, p%NacYawF - OtherState%NacYawI ) ! Modify the sign of YawManRat based on the direction of the yaw maneuever - OtherState%TYawManE = p%TYawManS + ( p%NacYawF - OtherState%NacYawI ) / YawManRat ! Calculate the end time of the override yaw maneuver - - OtherState%BegYawMan = .TRUE. ! Let's remember when we stored this these values - - ENDIF - - ELSE - - !................................................................... - ! Update OtherState%YawPosComInt: - !................................................................... - CALL CalculateStandardYaw(t, u, p, m, YawPosCom, YawRateCom, OtherState%YawPosComInt, ErrStat, ErrMsg) - - ENDIF - - -END SUBROUTINE Yaw_UpdateStates -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine for computing the pitch output: blade pitch commands. This routine is used in both loose and tight coupling. -SUBROUTINE Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, BlPitchCom, ElecPwr, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t - TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - REAL(ReKi), INTENT(INOUT) :: BlPitchCom(:) !< pitch outputs computed at t (Input only so that mesh con- - !! nectivity information does not have to be recalculated) - REAL(ReKi), INTENT(IN ) :: ElecPwr !< Electrical power (watts) - 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 - - ! local variables - REAL(ReKi) :: factor - REAL(ReKi) :: PitManRat - INTEGER(IntKi) :: K ! counter for blades - - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - - !................................................................... - ! Calculate standard pitch position and rate commands: - !................................................................... - ! Control pitch if requested: - - IF ( t >= p%TPCOn .AND. p%PCMode /= ControlMode_NONE ) THEN ! Time now to enable active pitch control. - - - SELECT CASE ( p%PCMode ) ! Which pitch control mode are we using? - - CASE ( ControlMode_SIMPLE ) ! Simple, built-in pitch-control routine. - - ! bjj: add this! - - CASE ( ControlMode_USER ) ! User-defined from routine PitchCntrl(). - - CALL PitchCntrl ( u%BlPitch, ElecPwr, u%LSS_Spd, u%TwrAccel, p%NumBl, t, p%DT, p%RootName, BlPitchCom ) - - CASE ( ControlMode_EXTERN ) ! User-defined from Simulink or LabVIEW. - - BlPitchCom = u%ExternalBlPitchCom(1:p%NumBl) - - CASE ( ControlMode_DLL ) ! User-defined pitch control from Bladed-style DLL - - - if (p%DLL_Ramp) then - factor = (t - m%LastTimeCalled) / m%dll_data%DLL_DT - BlPitchCom = m%dll_data%PrevBlPitch(1:p%NumBl) + & - factor * ( m%dll_data%BlPitchCom(1:p%NumBl) - m%dll_data%PrevBlPitch(1:p%NumBl) ) - else - BlPitchCom = m%dll_data%BlPitchCom(1:p%NumBl) - end if - - ! update the filter state once per time step - IF ( EqualRealNos( t - p%DT, m%LastTimeFiltered ) ) THEN - m%xd_BlPitchFilter = p%BlAlpha * m%xd_BlPitchFilter + (1.0_ReKi - p%BlAlpha) * BlPitchCom - m%LastTimeFiltered = t - END IF - - BlPitchCom = p%BlAlpha * m%xd_BlPitchFilter + (1.0_ReKi - p%BlAlpha) * BlPitchCom - - END SELECT - - ELSE ! Do not control pitch yet, maintain initial pitch angles. - - ! Use the initial blade pitch angles: - - BlPitchCom = p%BlPitchInit - - ENDIF - - - !................................................................... - ! Override standard pitch control with a linear maneuver if necessary: - !................................................................... - - DO K = 1,p%NumBl ! Loop through all blades - - - IF ( OtherState%BegPitMan(K) ) THEN ! Override pitch maneuver is occuring for this blade. - - IF ( t >= OtherState%TPitManE(K) ) THEN ! Override pitch maneuver has ended, blade is locked at BlPitchF. - - BlPitchCom(K) = p%BlPitchF(K) - - ELSE - - PitManRat = SIGN( p%PitManRat(K), p%BlPitchF(K) - OtherState%BlPitchI(K) ) ! Modify the sign of PitManRat based on the direction of the pitch maneuever - BlPitchCom(K) = OtherState%BlPitchI(K) + PitManRat*( t - p%TPitManS(K) ) ! Increment the blade pitch using PitManRat - - END IF - - ENDIF - - - ENDDO ! K - blades - - !................................................................... - ! Apply trim case for linearization: - !................................................................... - if (p%TrimCase==TrimCase_pitch) then - BlPitchCom = BlPitchCom + xd%CtrlOffset - end if - - -END SUBROUTINE Pitch_CalcOutput -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine updates the continuous and other states associated with the pitch controller: BegPitMan, BlPitchI, and TPitManE. -SUBROUTINE Pitch_UpdateStates( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< t+dt - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t+dt - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT(INOUT) :: x !< Input: Continuous states at t; - !! Output: Continuous states at t + dt - TYPE(SrvD_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t; - !! Output: Discrete states at t + dt - TYPE(SrvD_ConstraintStateType), INTENT(INOUT) :: z !< Input: Constraint states at t; - !! Output: Constraint states at t + dt - TYPE(SrvD_OtherStateType), INTENT(INOUT) :: OtherState !< Other states: Other states at t; - !! Output: Other states at t + dt - 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 - - ! local variables - REAL(ReKi) :: PitManRat - INTEGER(IntKi) :: K ! counter for blades - - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - - !................................................................... - ! Override standard pitch control with a linear maneuver if necessary: - !................................................................... - - DO K = 1,p%NumBl ! Loop through all blades - - - IF ( t >= p%TPitManS(K) ) THEN ! Override pitch maneuver is occuring for this blade. - - - IF ( .not. OtherState%BegPitMan(K) ) THEN ! Override pitch maneuver is just beginning. - - OtherState%BlPitchI (K) = u%BlPitch(K) ! Store the initial (current) pitch, at the start of the pitch maneuver. - - PitManRat = SIGN( p%PitManRat(K), p%BlPitchF(K) - OtherState%BlPitchI(K) ) ! Modify the sign of PitManRat based on the direction of the pitch maneuever - OtherState%TPitManE (K) = p%TPitManS(K) + ( p%BlPitchF(K) - OtherState%BlPitchI(K) )/PitManRat ! Calculate the end time of the override pitch maneuver - - OtherState%BegPitMan(K) = .TRUE. - - ENDIF - - ENDIF - - ENDDO ! K - blades - - -END SUBROUTINE Pitch_UpdateStates -!---------------------------------------------------------------------------------------------------------------------------------- - -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine for computing the tip-brake output: TBDrCon. This routine is used in both loose and tight coupling. -SUBROUTINE TipBrake_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t - TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(SrvD_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- - !! nectivity information does not have to be recalculated) - 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 - - ! local variables - INTEGER(IntKi) :: K ! counter for blades - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - - !................................................................... - ! Calculate standard tip brake commands: - !................................................................... - - DO K = 1,p%NumBl - - IF ( OtherState%BegTpBr(K) ) THEN ! The tip brakes have been deployed. - - y%TBDrCon(K) = p%TBDrConN + ( p%TBDrConD - p%TBDrConN ) * TBFract( t, OtherState%TTpBrDp(K), OtherState%TTpBrFl(K) ) - - ELSE ! The tip brakes haven't been deployed yet. - - y%TBDrCon(K) = p%TBDrConN - - ENDIF - - END DO -!returns TBDrCon, or N and D part of ElastoDyn, return 0<=TBFrac<=1, consistant with other controllers - -END SUBROUTINE TipBrake_CalcOutput -!------------------------------------------------------------------------------------------------------------------------------- -!> A math S-function for the fraction of tip brake drag between normal and fully deployed operation. -!! (This function was formerly part of RtHS.) -FUNCTION TBFract( t, BrakStrt, BrakEnd ) -!............................................................................................................................... - - IMPLICIT NONE - - ! Passed Variables: - - REAL(DbKi), INTENT(IN ) :: t !< Current time - REAL(DbKi), INTENT(IN ) :: BrakEnd !< Time at which brakes are fully deployed - REAL(DbKi), INTENT(IN ) :: BrakStrt !< Time at which brakes are first deployed - REAL(ReKi) :: TBFract !< This function. - - - ! Local Variables. - - REAL(DbKi) :: TmpVar ! A temporary variable - - - - IF ( t <= BrakStrt ) THEN - - TBFract = 0.0 - - ELSEIF ( t < BrakEnd ) THEN - - TmpVar = ( ( t - BrakStrt )/( BrakStrt - BrakEnd ) )**2 - TBFract = TmpVar*( 2.0 - TmpVar ) - - ELSE - - TBFract = 1.0 - - ENDIF - - RETURN -END FUNCTION TBFract -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine updates the other states of the tip brakes: BegTpBr, TTpBrDp, and TTpBrFl -SUBROUTINE TipBrake_UpdateStates( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< t+dt - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t+dt - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT(INOUT) :: x !< Input: Continuous states at t; - !! Output: Continuous states at t + dt - TYPE(SrvD_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t; - !! Output: Discrete states at t + dt - TYPE(SrvD_ConstraintStateType), INTENT(INOUT) :: z !< Input: Constraint states at t; - !! Output: Constraint states at t + dt - TYPE(SrvD_OtherStateType), INTENT(INOUT) :: OtherState !< Other states: Other states at t; - !! Output: Other states at t + dt - 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 - - ! local variables - INTEGER(IntKi) :: K ! counter for blades - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - - !................................................................... - ! Determine if tip brakes should be deployed: - !................................................................... - - DO K = 1,p%NumBl - - IF ( .not. OtherState%BegTpBr(k) ) THEN ! The tip brakes have not been deployed yet - - IF ( u%RotSpeed >= p%TBDepISp(K) ) THEN ! The tip brakes deploy due to speed - - OtherState%BegTpBr(k) = .true. - OtherState%TTpBrDp(K) = t ! time first deployed (0%) - OtherState%TTpBrFl(K) = t + p%TpBrDT ! time fully deployed (100%) - - ENDIF - - END IF - - END DO - -END SUBROUTINE TipBrake_UpdateStates -!------------------------------------------------------------------------------------------------------------------------------- -!> This routine calculates the drive-train torque outputs: GenTrq, ElecPwr, and HSSBrTrqC -SUBROUTINE Torque_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t - TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(SrvD_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- - !! nectivity information does not have to be recalculated) - 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 - - ! Local variables: - - REAL(ReKi) :: HSSBrFrac ! Fraction of full braking torque {0 (off) <= HSSBrFrac <= 1 (full)} (-) - - - - ! Initialize variables - ErrStat = ErrID_None - ErrMsg = '' - - - - !................................................................................. - ! Calculate generator torque (y%GenTrq) and electrical power (y%ElecPwr): - !................................................................................. - - IF ( OtherState%GenOnLine .and. .not. OtherState%Off4Good ) THEN ! Generator is on line. - CALL CalculateTorque( t, u, p, m, y%GenTrq, y%ElecPwr, ErrStat, ErrMsg ) - if (ErrStat >= AbortErrLev) return - ELSE ! Generator is off line. - y%GenTrq = 0.0_ReKi - y%ElecPwr = 0.0_ReKi - ENDIF - - !................................................................... - ! Apply trim case for linearization: - !................................................................... - if (p%TrimCase == TrimCase_torque) then - y%GenTrq = y%GenTrq + xd%CtrlOffset - end if - - !................................................................................. - ! Calculate the magnitude of HSS brake torque from DLL controller - !................................................................................. - IF (p%HSSBrMode == ControlMode_DLL) THEN - - y%HSSBrTrqC = m%dll_data%HSSBrTrqDemand - - ELSE - - !................................................................................. - ! Calculate the fraction of applied HSS-brake torque, HSSBrFrac: - !................................................................................. - IF ( t <= p%THSSBrDp ) THEN ! HSS brake not deployed yet. - - HSSBrFrac = 0.0_ReKi - - ELSE ! HSS brake deployed. - - - SELECT CASE ( p%HSSBrMode ) ! Which HSS brake model are we using? - - CASE ( ControlMode_NONE) ! None - - HSSBrFrac = 0.0_ReKi - - CASE ( ControlMode_SIMPLE ) ! Simple built-in HSS brake model with linear ramp. - - IF ( t < p%THSSBrFl ) THEN ! Linear ramp - HSSBrFrac = ( t - p%THSSBrDp )/p%HSSBrDT - ELSE ! Full braking torque - HSSBrFrac = 1.0 - ENDIF - - CASE ( ControlMode_USER ) ! User-defined HSS brake model. - - CALL UserHSSBr ( y%GenTrq, y%ElecPwr, u%HSS_Spd, p%NumBl, t, p%DT, p%RootName, HSSBrFrac ) - - IF ( ( HSSBrFrac < 0.0_ReKi ) .OR. ( HSSBrFrac > 1.0_ReKi ) ) THEN ! 0 (off) <= HSSBrFrac <= 1 (full); else Abort. - ErrStat = ErrID_Fatal - ErrMsg = 'HSSBrFrac must be between 0.0 (off) and 1.0 (full) (inclusive). Fix logic in routine UserHSSBr().' - RETURN - END IF - - !!!CASE ( ControlMode_DLL ) ! User-defined HSS brake model from Bladed-style DLL - !!! - !!! HSSBrFrac = 1.0_ReKi ! just a placeholder, since it never reaches this case - - CASE ( ControlMode_EXTERN ) ! HSS brake model from LabVIEW. - - HSSBrFrac = u%ExternalHSSBrFrac - - ENDSELECT - - HSSBrFrac = MAX( MIN( HSSBrFrac, 1.0_ReKi ), 0.0_ReKi ) ! make sure we didn't get outside the acceptable range: 0 (off) <= HSSBrFrac <= 1 (full) - - ENDIF - - - ! Calculate the magnitude of HSS brake torque: - - !y%HSSBrTrqC = SIGN( HSSBrFrac*p%HSSBrTqF, u%HSS_Spd ) ! Scale the full braking torque by the brake torque fraction and make sure the brake torque resists motion. - y%HSSBrTrqC = HSSBrFrac*p%HSSBrTqF ! Scale the full braking torque by the brake torque fraction (don't worry about the sign here). - - END IF - - ! to avoid issues with ElastoDyn extrapolating between +/- p%HSSBrTqF, we're going to make this output always positive - y%HSSBrTrqC = ABS(y%HSSBrTrqC) - - RETURN - -END SUBROUTINE Torque_CalcOutput -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine updates the other states of the torque control: GenOnLine, and Off4Good -SUBROUTINE Torque_UpdateStates( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< t+dt - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t+dt - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT(INOUT) :: x !< Input: Continuous states at t; - !! Output: Continuous states at t + dt - TYPE(SrvD_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t; - !! Output: Discrete states at t + dt - TYPE(SrvD_ConstraintStateType), INTENT(INOUT) :: z !< Input: Constraint states at t; - !! Output: Constraint states at t + dt - TYPE(SrvD_OtherStateType), INTENT(INOUT) :: OtherState !< Other states: Other states at t; - !! Output: Other states at t + dt - 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 - - - ! Local variables: - REAL(ReKi) :: GenTrq !< generator torque - REAL(ReKi) :: ElecPwr !< electrical power - - - - ! Initialize variables - ErrStat = ErrID_None - ErrMsg = '' - - - ! See if the generator is on line. - IF ( .not. OtherState%Off4Good ) THEN - - ! The generator is either on-line or has never been turned online. - - IF ( OtherState%GenOnLine ) THEN ! The generator is on-line. - - IF ( ( p%GenTiStp ) .AND. ( t > p%TimGenOf .OR. EqualRealNos(t,p%TimGenOf) ) ) THEN ! Shut-down of generator determined by time, TimGenOf - OtherState%Off4Good = .true. - ENDIF - - ELSE ! The generator has never been turned online. - - IF ( p%GenTiStr ) THEN ! Start-up of generator determined by time, TimGenOn - IF ( t > p%TimGenOn .OR. EqualRealNos(t,p%TimGenOn) ) THEN - OtherState%GenOnLine = .true. - END IF - ELSE ! Start-up of generator determined by HSS speed, SpdGenOn - IF ( u%HSS_Spd > p%SpdGenOn .OR. EqualRealNos(u%HSS_Spd, p%SpdGenOn) ) THEN - OtherState%GenOnLine = .true. - END IF - ENDIF - - ENDIF - - ENDIF - - - IF ( OtherState%GenOnLine .and. .not. OtherState%Off4Good ) THEN ! Generator is on line. - - ! Lets turn the generator offline for good if ( GenTiStp = .FALSE. ) .AND. ( ElecPwr <= 0.0 ): - - IF ( ( .NOT. p%GenTiStp ) ) then - - CALL CalculateTorque( t, u, p, m, GenTrq, ElecPwr, ErrStat, ErrMsg ) - if (ErrStat >= AbortErrLev) return - - IF ( ElecPwr <= 0.0_ReKi ) THEN ! Shut-down of generator determined by generator power = 0 - OtherState%Off4Good = .true. - END IF - - END IF - - ENDIF - -END SUBROUTINE Torque_UpdateStates -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine calculates the drive-train torque (GenTrq, ElecPwr) assuming the generator is on. -SUBROUTINE CalculateTorque( t, u, p, m, GenTrq, ElecPwr, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc (optimization) variables - - REAL(ReKi), INTENT( OUT) :: GenTrq !< generator torque command - REAL(ReKi), INTENT( OUT) :: ElecPwr !< electrical power - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Local variables: - - COMPLEX(ReKi) :: Current1 ! Current passing through the stator (amps) - COMPLEX(ReKi) :: Current2 ! Current passing through the rotor (amps) - COMPLEX(ReKi) :: Currentm ! Magnitizing current (amps) - - REAL(ReKi) :: ComDenom ! Common denominator of variables used in the TEC model - REAL(ReKi) :: PwrLossS ! Power loss in the stator (watts) - REAL(ReKi) :: PwrLossR ! Power loss in the rotor (watts) - REAL(ReKi) :: PwrMech ! Mechanical power (watts) - REAL(ReKi) :: Slip ! Generator slip - REAL(ReKi) :: SlipRat ! Generator slip ratio - - REAL(ReKi) :: S2 ! SlipRat**2 - - character(*), parameter :: RoutineName = 'CalculateTorque' - - ! Initialize variables - ErrStat = ErrID_None - ErrMsg = '' - - GenTrq = 0.0_ReKi - ElecPwr = 0.0_ReKi - - - ! Are we doing simple variable-speed control, or using a generator model? - - SELECT CASE ( p%VSContrl ) ! Are we using variable-speed control? - - CASE ( ControlMode_NONE ) ! No variable-speed control. Using a generator model. - - - SELECT CASE ( p%GenModel ) ! Which generator model are we using? - - CASE ( ControlMode_SIMPLE ) ! Simple induction-generator model. - - - Slip = u%HSS_Spd - p%SIG_SySp - - IF ( ABS( Slip ) > p%SIG_POSl ) THEN - GenTrq = SIGN( p%SIG_POTq, Slip ) - ELSE - GenTrq = Slip*p%SIG_Slop - ENDIF - - ElecPwr = CalculateElecPwr( GenTrq, u, p ) - - - CASE ( ControlMode_ADVANCED ) ! Thevenin-equivalent generator model. - - - SlipRat = ( u%HSS_Spd - p%TEC_SySp )/p%TEC_SySp - - GenTrq = p%TEC_A0*(p%TEC_VLL**2)*SlipRat & - /( p%TEC_C0 + p%TEC_C1*SlipRat + p%TEC_C2*(SlipRat**2) ) - - ! trying to refactor so we don't divide by SlipRat, which may be 0 - ! jmj tells me I need not worry about ComDenom being zero because these equations behave nicely - S2 = SlipRat**2 - - ComDenom = ( SlipRat*p%TEC_Re1 - p%TEC_RRes )**2 + (SlipRat*( p%TEC_Xe1 + p%TEC_RLR ))**2 - Current2 = CMPLX( p%TEC_V1a*SlipRat*( SlipRat*p%TEC_Re1 - p%TEC_RRes )/ComDenom , & - -p%TEC_V1a*S2 *( p%TEC_Xe1 + p%TEC_RLR )/ComDenom ) - Currentm = CMPLX( 0.0_ReKi , -p%TEC_V1a/p%TEC_MR ) - Current1 = Current2 + Currentm - - PwrLossS = 3.0*( ( ABS( Current1 ) )**2 )*p%TEC_SRes - PwrLossR = 3.0*( ( ABS( Current2 ) )**2 )*p%TEC_RRes - - PwrMech = GenTrq*u%HSS_Spd - ElecPwr = PwrMech - PwrLossS - PwrLossR - - - CASE ( ControlMode_USER ) ! User-defined generator model. - - - ! CALL UserGen ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, DT, p%GenEff, DelGenTrq, DirRoot, GenTrq, ElecPwr ) - CALL UserGen ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, p%DT, p%GenEff, 0.0_ReKi, p%RootName, GenTrq, ElecPwr ) - - END SELECT - - - CASE ( ControlMode_SIMPLE ) ! Simple variable-speed control. - - - if ( u%HSS_Spd < 0.0_ReKi) then - if (.not. equalRealNos(u%HSS_Spd, 0.0_ReKi) ) then - call SetErrStat( ErrID_Fatal, "u%HSS_Spd is negative. Simple variable-speed control model "//& - "is not valid for motoring situations.", ErrStat, ErrMsg, RoutineName) - return - end if - end if - - ! Compute the generator torque, which depends on which region we are in: - - IF ( u%HSS_Spd >= p%VS_RtGnSp ) THEN ! We are in region 3 - torque is constant - GenTrq = p%VS_RtTq - ELSEIF ( u%HSS_Spd < p%VS_TrGnSp ) THEN ! We are in region 2 - torque is proportional to the square of the generator speed - GenTrq = p%VS_Rgn2K* (u%HSS_Spd**2) - ELSE ! We are in region 2 1/2 - simple induction generator transition region - GenTrq = p%VS_Slope*( u%HSS_Spd - p%VS_SySp ) - ENDIF - - - ! It's not possible to motor using this control scheme, so the generator efficiency is always subtractive. - - ElecPwr = GenTrq*u%HSS_Spd*p%GenEff - !y%ElecPwr = CalculateElecPwr( y%GenTrq, u, p ) - - CASE ( ControlMode_USER ) ! User-defined variable-speed control for routine UserVSCont(). - - - CALL UserVSCont ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, p%DT, p%GenEff, 0.0_ReKi, p%RootName, GenTrq, ElecPwr ) - - CASE ( ControlMode_DLL ) ! User-defined variable-speed control from Bladed-style DLL - - ! bjj: I believe this is how the old logic worked, but perhaps now we can be more clever about checking if the generator is off - - IF ( m%dll_data%GenState /= 0_IntKi ) THEN ! generator is on - - GenTrq = m%dll_data%GenTrq - ElecPwr = CalculateElecPwr( GenTrq, u, p ) - - ELSE ! generator is off - - GenTrq = 0.0_ReKi - ElecPwr = 0.0_ReKi - - END IF - - CASE ( ControlMode_EXTERN ) ! User-defined variable-speed control from Simulink or LabVIEW. - - GenTrq = u%ExternalGenTrq - ElecPwr = u%ExternalElecPwr - - END SELECT - - - ! Lets turn the generator offline for good if ( GenTiStp = .FALSE. ) .AND. ( ElecPwr <= 0.0 ): - - IF ( ( .NOT. p%GenTiStp ) .AND. ( ElecPwr <= 0.0_ReKi ) ) THEN ! Shut-down of generator determined by generator power = 0 - GenTrq = 0.0_ReKi - ElecPwr = 0.0_ReKi - ENDIF - - -END SUBROUTINE CalculateTorque -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine calculates the electrical power (ElecPwr) after the electrical generator torque (GenTrq) has been calculated. -FUNCTION CalculateElecPwr( GenTrq, u, p ) -!............................................................................................................................... -REAL(ReKi), INTENT(IN) :: GenTrq !< generator torque computed at t -TYPE(SrvD_InputType), INTENT(IN) :: u !< Inputs at t -TYPE(SrvD_ParameterType), INTENT(IN) :: p !< Parameters - -REAL(ReKi) :: CalculateElecPwr !< The result of this function - - !! The generator efficiency is either additive for motoring, - !! or subtractive for generating power. - - IF ( GenTrq >= 0.0_ReKi ) THEN - CalculateElecPwr = GenTrq * u%HSS_Spd * p%GenEff - ELSE - CalculateElecPwr = GenTrq * u%HSS_Spd / p%GenEff - ENDIF - -END FUNCTION CalculateElecPwr -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine calculates the partials with respect to inputs of the drive-train torque outputs: GenTrq and ElecPwr -SUBROUTINE Torque_JacobianPInput( t, u, p, x, xd, z, OtherState, m, GenTrq_du, ElecPwr_du, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t - TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc (optimization) variables - REAL(R8Ki), INTENT( OUT) :: GenTrq_du !< partial derivative of generator torque output with respect to HSS_Spd input - REAL(R8Ki), INTENT( OUT) :: ElecPwr_du !< partial derivative of electrical power output with respect to HSS_Spd input - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - - ! Initialize variables - ErrStat = ErrID_None - ErrMsg = '' - - !................................................................................. - ! Calculate generator torque (y%GenTrq) and electrical power (y%ElecPwr): - !................................................................................. - - IF ( OtherState%GenOnLine .and. .not. OtherState%Off4Good ) THEN ! Generator is on line. - CALL CalculateTorqueJacobian( t, u, p, m, GenTrq_du, ElecPwr_du, ErrStat, ErrMsg ) - if (ErrStat >= AbortErrLev) return - ELSE ! Generator is off line. - GenTrq_du = 0.0_R8Ki - ElecPwr_du = 0.0_R8Ki - ENDIF - - - !................................................................................. - ! Calculate the fraction of applied HSS-brake torque, HSSBrFrac: - !................................................................................. - ! we're ignorming HSSBrFrac in linearization - - RETURN - -END SUBROUTINE Torque_JacobianPInput -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine calculates jacobians (with respect to u%HSS_Spd) of the drive-train torque (GenTrq, ElecPwr) assuming the generator is on. -SUBROUTINE CalculateTorqueJacobian( t, u, p, m, GenTrq_du, ElecPwr_du, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc (optimization) variables - - REAL(R8Ki), INTENT( OUT) :: GenTrq_du !< partial generator torque / partial u%HSS_Spd - REAL(R8Ki), INTENT( OUT) :: ElecPwr_du !< partialelectrical power / partial u%HSS_Spd - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Local variables: - - REAL(R8Ki) :: Current1_r, Current1_r_du ! Current passing through the stator (amps) and its derivative w.r.t. u%HSS_Spd - REAL(R8Ki) :: Current1_i, Current1_i_du ! Current passing through the stator (amps) and its derivative w.r.t. u%HSS_Spd - REAL(R8Ki) :: Current2_r, Current2_r_du ! Current passing through the rotor (amps) and its derivative w.r.t. u%HSS_Spd - REAL(R8Ki) :: Current2_i, Current2_i_du ! Current passing through the rotor (amps) and its derivative w.r.t. u%HSS_Spd - - REAL(R8Ki) :: GenTrq ! generator torque - - REAL(R8Ki) :: ComDenom, ComDenom_du ! temporary variable (common denominator) - REAL(R8Ki) :: PwrLossS_du ! Power loss in the stator (watts) and its derivative w.r.t. u%HSS_Spd - REAL(R8Ki) :: PwrLossR_du ! Power loss in the rotor (watts) and its derivative w.r.t. u%HSS_Spd - REAL(R8Ki) :: PwrMech_du ! partial derivative of Mechanical power (watts) w.r.t. u%HSS_Spd - REAL(R8Ki) :: Slip ! Generator slip - REAL(R8Ki) :: SlipRat ! Generator slip ratio - - REAL(R8Ki) :: A, B, dAdu, dBdu - REAL(R8Ki) :: SlipRat_du ! temporary variables for computing derivatives - - !REAL(ReKi) :: S2 ! SlipRat**2 - - character(*), parameter :: RoutineName = 'CalculateTorqueJacobian' - - ! Initialize variables - ErrStat = ErrID_None - ErrMsg = '' - - GenTrq_du = 0.0_R8Ki - ElecPwr_du = 0.0_R8Ki - - - ! Are we doing simple variable-speed control, or using a generator model? - - SELECT CASE ( p%VSContrl ) ! Are we using variable-speed control? - - CASE ( ControlMode_NONE ) ! No variable-speed control. Using a generator model. - - - SELECT CASE ( p%GenModel ) ! Which generator model are we using? - - CASE ( ControlMode_SIMPLE ) ! Simple induction-generator model. - - Slip = u%HSS_Spd - p%SIG_SySp - - IF ( ABS( Slip ) > p%SIG_POSl ) THEN - GenTrq = SIGN( real(p%SIG_POTq,R8Ki), Slip ) - GenTrq_du = 0.0_R8Ki - ELSE - GenTrq = Slip*p%SIG_Slop - GenTrq_du = p%SIG_Slop - ENDIF - - ! Calculate the electrical powerF - ! As generator: ElecPwr = GenTrq * u%HSS_Spd * m%GenEff - ! As motor: ElecPwr = GenTrq * u%HSS_Spd / m%GenEff - IF ( GenTrq >= 0.0_R8Ki ) THEN - !ElecPwr = GenTrq * u%HSS_Spd * p%GenEff - ElecPwr_du = (GenTrq_du * u%HSS_Spd + GenTrq) * p%GenEff - ELSE - !ElecPwr = GenTrq * u%HSS_Spd / p%GenEff - ElecPwr_du = (GenTrq_du * u%HSS_Spd + GenTrq) / p%GenEff - ENDIF - - CASE ( ControlMode_ADVANCED ) ! Thevenin-equivalent generator model. - - SlipRat = ( u%HSS_Spd - p%TEC_SySp )/p%TEC_SySp - SlipRat_du = 1.0_R8Ki / p%TEC_SySp - - A = p%TEC_A0*(p%TEC_VLL**2)*SlipRat - B = p%TEC_C0 + p%TEC_C1*SlipRat + p%TEC_C2*(SlipRat**2) - - dAdu = p%TEC_A0*(p%TEC_VLL**2)*SlipRat_du - dBdu = p%TEC_C1*SlipRat_du + 2.0_R8Ki*p%TEC_C2*SlipRat*SlipRat_du - - GenTrq = A / B - GenTrq_du = dAdu / B - A/B**2 * dBdu - - - A = SlipRat*p%TEC_Re1 - p%TEC_RRes - B = SlipRat*( p%TEC_Xe1 + p%TEC_RLR ) - dAdu = SlipRat_du * p%TEC_Re1 - dBdu = SlipRat_du * (p%TEC_Xe1 + p%TEC_RLR) - - ComDenom = A**2 + B**2 - ComDenom_du = 2.0_R8Ki * A * dAdu + 2.0_R8Ki * B * dBdu - - - A = SlipRat**2*p%TEC_Re1 - SlipRat*p%TEC_RRes - dAdu = 2.0_R8Ki * SlipRat * SlipRat_du * p%TEC_Re1 - SlipRat_du * p%TEC_RRes - Current2_r = p%TEC_V1a*A/ComDenom - Current2_r_du = p%TEC_V1a*(dAdu/ComDenom - A/ComDenom**2 * ComDenom_du) - - Current2_i = -p%TEC_V1a*( p%TEC_Xe1 + p%TEC_RLR )*SlipRat**2/ComDenom - Current2_i_du = -p%TEC_V1a*( p%TEC_Xe1 + p%TEC_RLR ) * ( 2.0_R8Ki*SlipRat*SlipRat_du / ComDenom - SlipRat**2/(ComDenom**2) * ComDenom_du) - - Current1_r = Current2_r - Current1_i = Current2_i - p%TEC_V1a/p%TEC_MR - Current1_r_du = Current2_r_du - Current1_i_du = Current2_i_du - - - !PwrLossS = 3.0*( Current1_r**2 + Current1_i**2 )*p%TEC_SRes - PwrLossS_du = 3.0_R8Ki*p%TEC_SRes*( 2.0_R8Ki*Current1_r*Current1_r_du + 2.0_R8Ki*Current1_i*Current1_i_du ) - - !PwrLossR = 3.0*( Current2_r**2 + Current2_i**2 )*p%TEC_RRes - PwrLossR_du = 3.0_R8Ki*p%TEC_RRes*( 2.0_R8Ki*Current2_r*Current2_r_du + 2.0_R8Ki*Current2_i*Current2_i_du ) - - !PwrMech = GenTrq*u%HSS_Spd - PwrMech_du = GenTrq_du * u%HSS_Spd + GenTrq - - !ElecPwr = PwrMech - PwrLossS - PwrLossR - ElecPwr_du = PwrMech_du - PwrLossS_du - PwrLossR_du - - CASE ( ControlMode_USER ) ! User-defined generator model. - - ! we should not get here (initialization should have caught this issue) - - GenTrq_du = 0.0_R8Ki - ElecPwr_du = 0.0_R8Ki - - END SELECT - - - CASE ( ControlMode_SIMPLE ) ! Simple variable-speed control. - - - if ( u%HSS_Spd < 0.0_ReKi) then - if (.not. equalRealNos(u%HSS_Spd, 0.0_ReKi) ) then - call SetErrStat( ErrID_Fatal, "u%HSS_Spd is negative. Simple variable-speed control model "//& - "is not valid for motoring situations.", ErrStat, ErrMsg, RoutineName) - return - end if - end if - - ! Compute the generator torque, which depends on which region we are in: - - IF ( u%HSS_Spd >= p%VS_RtGnSp ) THEN ! We are in region 3 - torque is constant - GenTrq = p%VS_RtTq - GenTrq_du = 0.0_R8Ki - ELSEIF ( u%HSS_Spd < p%VS_TrGnSp ) THEN ! We are in region 2 - torque is proportional to the square of the generator speed - GenTrq = p%VS_Rgn2K* (u%HSS_Spd**2) - GenTrq_du = 2.0_R8Ki * p%VS_Rgn2K * u%HSS_Spd - ELSE ! We are in region 2 1/2 - simple induction generator transition region - GenTrq = p%VS_Slope*( u%HSS_Spd - p%VS_SySp ) - GenTrq_du = p%VS_Slope - ENDIF - - ! It's not possible to motor using this control scheme, so the generator efficiency is always subtractive. - - ElecPwr_du = (GenTrq_du * u%HSS_Spd + GenTrq) * p%GenEff - - - CASE ( ControlMode_USER , & ! User-defined variable-speed control for routine UserVSCont(). - ControlMode_DLL , & ! User-defined variable-speed control from Bladed-style DLL - ControlMode_EXTERN ) ! User-defined variable-speed control from Simulink or LabVIEW. - - ! we should not get here (initialization should have caught this issue) - - GenTrq_du = 0.0_R8Ki - ElecPwr_du = 0.0_R8Ki - - END SELECT - -END SUBROUTINE CalculateTorqueJacobian -!---------------------------------------------------------------------------------------------------------------------------------- - - - -END MODULE ServoDyn -!********************************************************************************************************************************** diff --git a/OpenFAST/modules/servodyn/src/ServoDyn_Driver.f90 b/OpenFAST/modules/servodyn/src/ServoDyn_Driver.f90 deleted file mode 100644 index 3d9734eaa..000000000 --- a/OpenFAST/modules/servodyn/src/ServoDyn_Driver.f90 +++ /dev/null @@ -1,219 +0,0 @@ -!********************************************************************************************************************************** -!> ## ServoDyn_DriverCode: This code tests the template modules -!!.................................................................................................................................. -!! LICENSING -!! Copyright (C) 2016 National Renewable Energy Laboratory -!! -!! This file is part of ServoDyn. -!! -!! 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. -!********************************************************************************************************************************** -PROGRAM SrvD_Driver - - USE NWTC_Library - USE ServoDyn - USE ServoDyn_Types - - IMPLICIT NONE - - INTEGER(IntKi), PARAMETER :: NumInp = 3 !< Number of inputs sent to SrvD_UpdateStates - - ! Program variables - - REAL(DbKi) :: Time !< Variable for storing time, in seconds - REAL(DbKi) :: TimeInterval !< Interval between time steps, in seconds - REAL(DbKi) :: InputTime(NumInp) !< Variable for storing time associated with inputs, in seconds - - TYPE(SrvD_InitInputType) :: InitInData !< Input data for initialization - TYPE(SrvD_InitOutputType) :: InitOutData !< Output data from initialization - - TYPE(SrvD_ContinuousStateType) :: x !< Continuous states - TYPE(SrvD_DiscreteStateType) :: xd !< Discrete states - TYPE(SrvD_ConstraintStateType) :: z !< Constraint states - TYPE(SrvD_ConstraintStateType) :: Z_residual !< Residual of the constraint state functions (Z) - TYPE(SrvD_OtherStateType) :: OtherState !< Other states - TYPE(SrvD_MiscVarType) :: misc !< Optimization variables - - TYPE(SrvD_ParameterType) :: p !< Parameters - TYPE(SrvD_InputType) :: u(NumInp) !< System inputs - TYPE(SrvD_OutputType) :: y !< System outputs - - - - INTEGER(IntKi) :: n !< Loop counter (for time step) - INTEGER(IntKi) :: j !< Loop counter (for interpolation time history) - INTEGER(IntKi) :: ErrStat !< Status of error message - CHARACTER(ErrMsgLen) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - REAL(R8Ki), allocatable :: dYdu(:,:) - INTEGER(IntKi) :: Un - INTEGER(IntKi) :: nMax - CHARACTER(1024) :: OutFile - CHARACTER(20) :: FlagArg !< Flag argument from command line - - TYPE(ProgDesc), PARAMETER :: version = ProgDesc( 'ServoDyn_driver', '', '' ) - - !............................................................................................................................... - ! Routines called in initialization - !............................................................................................................................... - - CALL NWTC_Init( ProgNameIN=version%Name ) - - ! Populate the InitInData data structure here: - - ! Check for command line arguments. - InitInData%InputFile = '' !'ServoDyn_input.dat' - CALL CheckArgs( InitInData%InputFile, Flag=FlagArg ) - IF ( LEN( TRIM(FlagArg) ) > 0 ) CALL NormStop() - - CALL GetRoot( InitInData%InputFile, OutFile ) - OutFile = trim(OutFile)//'.out' - - CALL GetNewUnit( Un, ErrStat, ErrMsg) - call OpenFOutFile ( Un, OutFile, ErrStat, ErrMsg ) - - ! Set the driver's request for time interval here: - - TimeInterval = 0.01 ! s - InitInData%InputFile = 'ServoDyn.dat' - InitInData%RootName = OutFile(1:(len_trim(OutFile)-4)) - InitInData%NumBl = 3 - InitInData%gravity = 9.81 !m/s^2 -!FIXME: why are these hard coded!!!? - ! StrucCtrl nacelle position - InitInData%NacPosition = (/ 90.0, 0.0, 0.0 /) ! m, position of nacelle (for NStC) - InitInData%NacOrientation= 0.0_R8Ki - do j=1,3 - InitInData%NacOrientation(j,j) = 1.0_R8Ki - enddo - ! StrucCtrl tower - InitInData%TwrBasePos = (/ 0.0, 0.0, 0.0 /) ! m, position of tower base (for TStC) - InitInData%TwrBaseOrient = 0.0_R8Ki - do j=1,3 - InitInData%TwrBaseOrient(j,j) = 1.0_R8Ki - enddo - ! StrucCtrl single blade - call AllocAry(InitInData%BladeRootPosition, 3,1, 'InitInData%BladeRootPosition', ErrStat,ErrMsg) - IF ( ErrStat /= ErrID_None ) THEN - CALL WrScr( ErrMsg ) - IF (ErrStat >= AbortErrLev) call ProgAbort('') - END IF - call AllocAry(InitInData%BladeRootOrientation, 3,3,1, 'InitInData%BladeRootOrientation',ErrStat,ErrMsg) - IF ( ErrStat /= ErrID_None ) THEN - CALL WrScr( ErrMsg ) - IF (ErrStat >= AbortErrLev) call ProgAbort('') - END IF - InitInData%BladeRootPosition(1:3,1) = (/ 0.0, 0.0, 0.0 /) ! m, position of blade root (for BStC) - InitInData%BladeRootOrientation = 0.0_R8Ki - do j=1,3 - InitInData%BladeRootOrientation(j,j,1) = 1.0_R8Ki - enddo - InitInData%TMax = 10.0 !s - InitInData%AirDens = 1.225 !kg/m^3 - InitInData%AvgWindSpeed = 10.0 !m/s - InitInData%Linearize = .false. - InitInData%NumSC2Ctrl = 0 ! SuperController - InitInData%NumCtrl2SC = 0 ! SuperController - - CALL AllocAry(InitInData%BlPitchInit, InitInData%NumBl, 'BlPitchInit', ErrStat, ErrMsg) - IF ( ErrStat /= ErrID_None ) THEN - CALL WrScr( ErrMsg ) - IF (ErrStat >= AbortErrLev) call ProgAbort('') - END IF - InitInData%BlPitchInit = 5.0*pi/180.0 ! radians - - - ! Initialize the module - - CALL SrvD_Init( InitInData, u(1), p, x, xd, z, OtherState, y, misc, TimeInterval, InitOutData, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - IF (ErrStat >= AbortErrLev) call ProgAbort('') - END IF - - nMax = nint(InitInData%TMax/TimeInterval) - - - ! Destroy initialization data - - CALL SrvD_DestroyInitInput( InitInData, ErrStat, ErrMsg ) - CALL SrvD_DestroyInitOutput( InitOutData, ErrStat, ErrMsg ) - - - Time = 0.0_ReKi - DO j = 1, NumInp - InputTime(j) = Time - j*TimeInterval - END DO - DO j = 2, NumInp - CALL SrvD_CopyInput (u(1), u(j), MESH_NEWCOPY, ErrStat, ErrMsg) - END DO - - !............................................................................................................................... - ! Check the results of the Jacobian routines - !............................................................................................................................... - - - CALL SrvD_CalcOutput( Time, u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - write(Un,'(600(ES15.5,1x))') Time, y%BlPitchCom, y%WriteOutput - - - - DO n = 0,nMax - - ! Modify u for inputs at n (likely from the outputs of another module or a set of test conditions) here: - DO j = NumInp-1, 1, -1 - CALL SrvD_CopyInput (u(j), u(j+1), MESH_UPDATECOPY, ErrStat, ErrMsg) - InputTime(j+1) = InputTime(j) - END DO - InputTime(1) = Time - u(1)%BlPitch = y%BlPitchCom - - !u(1)%HSS_Spd = (2000.0_ReKi)/nMax * RPM2RPS * n - - CALL SrvD_UpdateStates( Time, n, u, InputTime, p, x, xd, z, OtherState, misc, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - - ! Calculate outputs at n - Time = (n+1)*TimeInterval - CALL SrvD_CalcOutput( Time, u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - - !call SrvD_JacobianPInput( Time, u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg, dYdu) - - !write(Un,'(100(ES15.5,1x))') u(1)%Yaw, u(1)%YawRate, u(1)%HSS_Spd, y%YawMom, y%GenTrq, y%ElecPwr, dYdu(4,1), dYdu(4,2), dYdu(5,3), dYdu(6,3) - write(Un,'(600(ES15.5,1x))') Time, y%BlPitchCom, y%WriteOutput - - END DO - close (un) - - - !............................................................................................................................... - ! Routine to terminate program execution - !............................................................................................................................... - CALL SrvD_End( u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ) - - IF ( ErrStat /= ErrID_None ) THEN - CALL WrScr( ErrMsg ) - END IF - - -END PROGRAM SrvD_Driver diff --git a/OpenFAST/modules/servodyn/src/ServoDyn_IO.f90 b/OpenFAST/modules/servodyn/src/ServoDyn_IO.f90 deleted file mode 100644 index b9e01b6e7..000000000 --- a/OpenFAST/modules/servodyn/src/ServoDyn_IO.f90 +++ /dev/null @@ -1,2306 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2013-2016 National Renewable Energy Laboratory -! -! This file is part of FAST's Controls and Electrical Drive Module, "ServoDyn". -! -! 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. -! -!********************************************************************************************************************************** -!> Control and electrical drive dynamics module for FAST -MODULE ServoDyn_IO - - USE ServoDyn_Types - USE NWTC_Library - USE StrucCtrl_Types - - - IMPLICIT NONE - - -! =================================================================================================== -! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" -! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these -! lines should be modified in the Matlab script and/or Excel worksheet as necessary. -! =================================================================================================== -! This code was generated by Write_ChckOutLst.m at 04-Feb-2021 08:42:27. - - - ! Parameters related to output length (number of characters allowed in the output data headers): - - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 1 - - - ! Indices for computing output channels: - ! NOTES: - ! (1) These parameters are in the order stored in "OutListParameters.xlsx" - ! (2) Array AllOuts() must be dimensioned to the value of the largest output parameter - - ! Time: - - INTEGER(IntKi), PARAMETER :: Time = 0 - - - ! Airfoil control: - - INTEGER(IntKi), PARAMETER :: BlAirFlC1 = 1 - INTEGER(IntKi), PARAMETER :: BlAirFlC2 = 2 - INTEGER(IntKi), PARAMETER :: BlAirFlC3 = 3 - - - ! Pitch Control: - - INTEGER(IntKi), PARAMETER :: BlPitchC1 = 4 - INTEGER(IntKi), PARAMETER :: BlPitchC2 = 5 - INTEGER(IntKi), PARAMETER :: BlPitchC3 = 6 - - - ! Generator and Torque Control: - - INTEGER(IntKi), PARAMETER :: GenTq = 7 - INTEGER(IntKi), PARAMETER :: GenPwr = 8 - - - ! High Speed Shaft Brake: - - INTEGER(IntKi), PARAMETER :: HSSBrTqC = 9 - - - ! Nacelle Yaw Control: - - INTEGER(IntKi), PARAMETER :: YawMomCom = 10 - - - ! Nacelle Structural Control (StC): - - INTEGER(IntKi), PARAMETER :: NStC1_XQ = 11 - INTEGER(IntKi), PARAMETER :: NStC1_XQD = 12 - INTEGER(IntKi), PARAMETER :: NStC1_YQ = 13 - INTEGER(IntKi), PARAMETER :: NStC1_YQD = 14 - INTEGER(IntKi), PARAMETER :: NStC1_ZQ = 15 - INTEGER(IntKi), PARAMETER :: NStC1_ZQD = 16 - INTEGER(IntKi), PARAMETER :: NStC1_Fxi = 17 - INTEGER(IntKi), PARAMETER :: NStC1_Fyi = 18 - INTEGER(IntKi), PARAMETER :: NStC1_Fzi = 19 - INTEGER(IntKi), PARAMETER :: NStC1_Mxi = 20 - INTEGER(IntKi), PARAMETER :: NStC1_Myi = 21 - INTEGER(IntKi), PARAMETER :: NStC1_Mzi = 22 - INTEGER(IntKi), PARAMETER :: NStC1_Fxl = 23 - INTEGER(IntKi), PARAMETER :: NStC1_Fyl = 24 - INTEGER(IntKi), PARAMETER :: NStC1_Fzl = 25 - INTEGER(IntKi), PARAMETER :: NStC1_Mxl = 26 - INTEGER(IntKi), PARAMETER :: NStC1_Myl = 27 - INTEGER(IntKi), PARAMETER :: NStC1_Mzl = 28 - INTEGER(IntKi), PARAMETER :: NStC2_XQ = 29 - INTEGER(IntKi), PARAMETER :: NStC2_XQD = 30 - INTEGER(IntKi), PARAMETER :: NStC2_YQ = 31 - INTEGER(IntKi), PARAMETER :: NStC2_YQD = 32 - INTEGER(IntKi), PARAMETER :: NStC2_ZQ = 33 - INTEGER(IntKi), PARAMETER :: NStC2_ZQD = 34 - INTEGER(IntKi), PARAMETER :: NStC2_Fxi = 35 - INTEGER(IntKi), PARAMETER :: NStC2_Fyi = 36 - INTEGER(IntKi), PARAMETER :: NStC2_Fzi = 37 - INTEGER(IntKi), PARAMETER :: NStC2_Mxi = 38 - INTEGER(IntKi), PARAMETER :: NStC2_Myi = 39 - INTEGER(IntKi), PARAMETER :: NStC2_Mzi = 40 - INTEGER(IntKi), PARAMETER :: NStC2_Fxl = 41 - INTEGER(IntKi), PARAMETER :: NStC2_Fyl = 42 - INTEGER(IntKi), PARAMETER :: NStC2_Fzl = 43 - INTEGER(IntKi), PARAMETER :: NStC2_Mxl = 44 - INTEGER(IntKi), PARAMETER :: NStC2_Myl = 45 - INTEGER(IntKi), PARAMETER :: NStC2_Mzl = 46 - INTEGER(IntKi), PARAMETER :: NStC3_XQ = 47 - INTEGER(IntKi), PARAMETER :: NStC3_XQD = 48 - INTEGER(IntKi), PARAMETER :: NStC3_YQ = 49 - INTEGER(IntKi), PARAMETER :: NStC3_YQD = 50 - INTEGER(IntKi), PARAMETER :: NStC3_ZQ = 51 - INTEGER(IntKi), PARAMETER :: NStC3_ZQD = 52 - INTEGER(IntKi), PARAMETER :: NStC3_Fxi = 53 - INTEGER(IntKi), PARAMETER :: NStC3_Fyi = 54 - INTEGER(IntKi), PARAMETER :: NStC3_Fzi = 55 - INTEGER(IntKi), PARAMETER :: NStC3_Mxi = 56 - INTEGER(IntKi), PARAMETER :: NStC3_Myi = 57 - INTEGER(IntKi), PARAMETER :: NStC3_Mzi = 58 - INTEGER(IntKi), PARAMETER :: NStC3_Fxl = 59 - INTEGER(IntKi), PARAMETER :: NStC3_Fyl = 60 - INTEGER(IntKi), PARAMETER :: NStC3_Fzl = 61 - INTEGER(IntKi), PARAMETER :: NStC3_Mxl = 62 - INTEGER(IntKi), PARAMETER :: NStC3_Myl = 63 - INTEGER(IntKi), PARAMETER :: NStC3_Mzl = 64 - INTEGER(IntKi), PARAMETER :: NStC4_XQ = 65 - INTEGER(IntKi), PARAMETER :: NStC4_XQD = 66 - INTEGER(IntKi), PARAMETER :: NStC4_YQ = 67 - INTEGER(IntKi), PARAMETER :: NStC4_YQD = 68 - INTEGER(IntKi), PARAMETER :: NStC4_ZQ = 69 - INTEGER(IntKi), PARAMETER :: NStC4_ZQD = 70 - INTEGER(IntKi), PARAMETER :: NStC4_Fxi = 71 - INTEGER(IntKi), PARAMETER :: NStC4_Fyi = 72 - INTEGER(IntKi), PARAMETER :: NStC4_Fzi = 73 - INTEGER(IntKi), PARAMETER :: NStC4_Mxi = 74 - INTEGER(IntKi), PARAMETER :: NStC4_Myi = 75 - INTEGER(IntKi), PARAMETER :: NStC4_Mzi = 76 - INTEGER(IntKi), PARAMETER :: NStC4_Fxl = 77 - INTEGER(IntKi), PARAMETER :: NStC4_Fyl = 78 - INTEGER(IntKi), PARAMETER :: NStC4_Fzl = 79 - INTEGER(IntKi), PARAMETER :: NStC4_Mxl = 80 - INTEGER(IntKi), PARAMETER :: NStC4_Myl = 81 - INTEGER(IntKi), PARAMETER :: NStC4_Mzl = 82 - - - ! Tower Structural Control (StC): - - INTEGER(IntKi), PARAMETER :: TStC1_XQ = 83 - INTEGER(IntKi), PARAMETER :: TStC1_XQD = 84 - INTEGER(IntKi), PARAMETER :: TStC1_YQ = 85 - INTEGER(IntKi), PARAMETER :: TStC1_YQD = 86 - INTEGER(IntKi), PARAMETER :: TStC1_ZQ = 87 - INTEGER(IntKi), PARAMETER :: TStC1_ZQD = 88 - INTEGER(IntKi), PARAMETER :: TStC1_Fxi = 89 - INTEGER(IntKi), PARAMETER :: TStC1_Fyi = 90 - INTEGER(IntKi), PARAMETER :: TStC1_Fzi = 91 - INTEGER(IntKi), PARAMETER :: TStC1_Mxi = 92 - INTEGER(IntKi), PARAMETER :: TStC1_Myi = 93 - INTEGER(IntKi), PARAMETER :: TStC1_Mzi = 94 - INTEGER(IntKi), PARAMETER :: TStC1_Fxl = 95 - INTEGER(IntKi), PARAMETER :: TStC1_Fyl = 96 - INTEGER(IntKi), PARAMETER :: TStC1_Fzl = 97 - INTEGER(IntKi), PARAMETER :: TStC1_Mxl = 98 - INTEGER(IntKi), PARAMETER :: TStC1_Myl = 99 - INTEGER(IntKi), PARAMETER :: TStC1_Mzl = 100 - INTEGER(IntKi), PARAMETER :: TStC2_XQ = 101 - INTEGER(IntKi), PARAMETER :: TStC2_XQD = 102 - INTEGER(IntKi), PARAMETER :: TStC2_YQ = 103 - INTEGER(IntKi), PARAMETER :: TStC2_YQD = 104 - INTEGER(IntKi), PARAMETER :: TStC2_ZQ = 105 - INTEGER(IntKi), PARAMETER :: TStC2_ZQD = 106 - INTEGER(IntKi), PARAMETER :: TStC2_Fxi = 107 - INTEGER(IntKi), PARAMETER :: TStC2_Fyi = 108 - INTEGER(IntKi), PARAMETER :: TStC2_Fzi = 109 - INTEGER(IntKi), PARAMETER :: TStC2_Mxi = 110 - INTEGER(IntKi), PARAMETER :: TStC2_Myi = 111 - INTEGER(IntKi), PARAMETER :: TStC2_Mzi = 112 - INTEGER(IntKi), PARAMETER :: TStC2_Fxl = 113 - INTEGER(IntKi), PARAMETER :: TStC2_Fyl = 114 - INTEGER(IntKi), PARAMETER :: TStC2_Fzl = 115 - INTEGER(IntKi), PARAMETER :: TStC2_Mxl = 116 - INTEGER(IntKi), PARAMETER :: TStC2_Myl = 117 - INTEGER(IntKi), PARAMETER :: TStC2_Mzl = 118 - INTEGER(IntKi), PARAMETER :: TStC3_XQ = 119 - INTEGER(IntKi), PARAMETER :: TStC3_XQD = 120 - INTEGER(IntKi), PARAMETER :: TStC3_YQ = 121 - INTEGER(IntKi), PARAMETER :: TStC3_YQD = 122 - INTEGER(IntKi), PARAMETER :: TStC3_ZQ = 123 - INTEGER(IntKi), PARAMETER :: TStC3_ZQD = 124 - INTEGER(IntKi), PARAMETER :: TStC3_Fxi = 125 - INTEGER(IntKi), PARAMETER :: TStC3_Fyi = 126 - INTEGER(IntKi), PARAMETER :: TStC3_Fzi = 127 - INTEGER(IntKi), PARAMETER :: TStC3_Mxi = 128 - INTEGER(IntKi), PARAMETER :: TStC3_Myi = 129 - INTEGER(IntKi), PARAMETER :: TStC3_Mzi = 130 - INTEGER(IntKi), PARAMETER :: TStC3_Fxl = 131 - INTEGER(IntKi), PARAMETER :: TStC3_Fyl = 132 - INTEGER(IntKi), PARAMETER :: TStC3_Fzl = 133 - INTEGER(IntKi), PARAMETER :: TStC3_Mxl = 134 - INTEGER(IntKi), PARAMETER :: TStC3_Myl = 135 - INTEGER(IntKi), PARAMETER :: TStC3_Mzl = 136 - INTEGER(IntKi), PARAMETER :: TStC4_XQ = 137 - INTEGER(IntKi), PARAMETER :: TStC4_XQD = 138 - INTEGER(IntKi), PARAMETER :: TStC4_YQ = 139 - INTEGER(IntKi), PARAMETER :: TStC4_YQD = 140 - INTEGER(IntKi), PARAMETER :: TStC4_ZQ = 141 - INTEGER(IntKi), PARAMETER :: TStC4_ZQD = 142 - INTEGER(IntKi), PARAMETER :: TStC4_Fxi = 143 - INTEGER(IntKi), PARAMETER :: TStC4_Fyi = 144 - INTEGER(IntKi), PARAMETER :: TStC4_Fzi = 145 - INTEGER(IntKi), PARAMETER :: TStC4_Mxi = 146 - INTEGER(IntKi), PARAMETER :: TStC4_Myi = 147 - INTEGER(IntKi), PARAMETER :: TStC4_Mzi = 148 - INTEGER(IntKi), PARAMETER :: TStC4_Fxl = 149 - INTEGER(IntKi), PARAMETER :: TStC4_Fyl = 150 - INTEGER(IntKi), PARAMETER :: TStC4_Fzl = 151 - INTEGER(IntKi), PARAMETER :: TStC4_Mxl = 152 - INTEGER(IntKi), PARAMETER :: TStC4_Myl = 153 - INTEGER(IntKi), PARAMETER :: TStC4_Mzl = 154 - - - ! Blade Structural Control (StC): - - INTEGER(IntKi), PARAMETER :: BStC1_B1_XQ = 155 - INTEGER(IntKi), PARAMETER :: BStC1_B1_XQD = 156 - INTEGER(IntKi), PARAMETER :: BStC1_B1_YQ = 157 - INTEGER(IntKi), PARAMETER :: BStC1_B1_YQD = 158 - INTEGER(IntKi), PARAMETER :: BStC1_B1_ZQ = 159 - INTEGER(IntKi), PARAMETER :: BStC1_B1_ZQD = 160 - INTEGER(IntKi), PARAMETER :: BStC1_B1_Fxi = 161 - INTEGER(IntKi), PARAMETER :: BStC1_B1_Fyi = 162 - INTEGER(IntKi), PARAMETER :: BStC1_B1_Fzi = 163 - INTEGER(IntKi), PARAMETER :: BStC1_B1_Mxi = 164 - INTEGER(IntKi), PARAMETER :: BStC1_B1_Myi = 165 - INTEGER(IntKi), PARAMETER :: BStC1_B1_Mzi = 166 - INTEGER(IntKi), PARAMETER :: BStC1_B1_Fxl = 167 - INTEGER(IntKi), PARAMETER :: BStC1_B1_Fyl = 168 - INTEGER(IntKi), PARAMETER :: BStC1_B1_Fzl = 169 - INTEGER(IntKi), PARAMETER :: BStC1_B1_Mxl = 170 - INTEGER(IntKi), PARAMETER :: BStC1_B1_Myl = 171 - INTEGER(IntKi), PARAMETER :: BStC1_B1_Mzl = 172 - INTEGER(IntKi), PARAMETER :: BStC2_B1_XQ = 173 - INTEGER(IntKi), PARAMETER :: BStC2_B1_XQD = 174 - INTEGER(IntKi), PARAMETER :: BStC2_B1_YQ = 175 - INTEGER(IntKi), PARAMETER :: BStC2_B1_YQD = 176 - INTEGER(IntKi), PARAMETER :: BStC2_B1_ZQ = 177 - INTEGER(IntKi), PARAMETER :: BStC2_B1_ZQD = 178 - INTEGER(IntKi), PARAMETER :: BStC2_B1_Fxi = 179 - INTEGER(IntKi), PARAMETER :: BStC2_B1_Fyi = 180 - INTEGER(IntKi), PARAMETER :: BStC2_B1_Fzi = 181 - INTEGER(IntKi), PARAMETER :: BStC2_B1_Mxi = 182 - INTEGER(IntKi), PARAMETER :: BStC2_B1_Myi = 183 - INTEGER(IntKi), PARAMETER :: BStC2_B1_Mzi = 184 - INTEGER(IntKi), PARAMETER :: BStC2_B1_Fxl = 185 - INTEGER(IntKi), PARAMETER :: BStC2_B1_Fyl = 186 - INTEGER(IntKi), PARAMETER :: BStC2_B1_Fzl = 187 - INTEGER(IntKi), PARAMETER :: BStC2_B1_Mxl = 188 - INTEGER(IntKi), PARAMETER :: BStC2_B1_Myl = 189 - INTEGER(IntKi), PARAMETER :: BStC2_B1_Mzl = 190 - INTEGER(IntKi), PARAMETER :: BStC3_B1_XQ = 191 - INTEGER(IntKi), PARAMETER :: BStC3_B1_XQD = 192 - INTEGER(IntKi), PARAMETER :: BStC3_B1_YQ = 193 - INTEGER(IntKi), PARAMETER :: BStC3_B1_YQD = 194 - INTEGER(IntKi), PARAMETER :: BStC3_B1_ZQ = 195 - INTEGER(IntKi), PARAMETER :: BStC3_B1_ZQD = 196 - INTEGER(IntKi), PARAMETER :: BStC3_B1_Fxi = 197 - INTEGER(IntKi), PARAMETER :: BStC3_B1_Fyi = 198 - INTEGER(IntKi), PARAMETER :: BStC3_B1_Fzi = 199 - INTEGER(IntKi), PARAMETER :: BStC3_B1_Mxi = 200 - INTEGER(IntKi), PARAMETER :: BStC3_B1_Myi = 201 - INTEGER(IntKi), PARAMETER :: BStC3_B1_Mzi = 202 - INTEGER(IntKi), PARAMETER :: BStC3_B1_Fxl = 203 - INTEGER(IntKi), PARAMETER :: BStC3_B1_Fyl = 204 - INTEGER(IntKi), PARAMETER :: BStC3_B1_Fzl = 205 - INTEGER(IntKi), PARAMETER :: BStC3_B1_Mxl = 206 - INTEGER(IntKi), PARAMETER :: BStC3_B1_Myl = 207 - INTEGER(IntKi), PARAMETER :: BStC3_B1_Mzl = 208 - INTEGER(IntKi), PARAMETER :: BStC4_B1_XQ = 209 - INTEGER(IntKi), PARAMETER :: BStC4_B1_XQD = 210 - INTEGER(IntKi), PARAMETER :: BStC4_B1_YQ = 211 - INTEGER(IntKi), PARAMETER :: BStC4_B1_YQD = 212 - INTEGER(IntKi), PARAMETER :: BStC4_B1_ZQ = 213 - INTEGER(IntKi), PARAMETER :: BStC4_B1_ZQD = 214 - INTEGER(IntKi), PARAMETER :: BStC4_B1_Fxi = 215 - INTEGER(IntKi), PARAMETER :: BStC4_B1_Fyi = 216 - INTEGER(IntKi), PARAMETER :: BStC4_B1_Fzi = 217 - INTEGER(IntKi), PARAMETER :: BStC4_B1_Mxi = 218 - INTEGER(IntKi), PARAMETER :: BStC4_B1_Myi = 219 - INTEGER(IntKi), PARAMETER :: BStC4_B1_Mzi = 220 - INTEGER(IntKi), PARAMETER :: BStC4_B1_Fxl = 221 - INTEGER(IntKi), PARAMETER :: BStC4_B1_Fyl = 222 - INTEGER(IntKi), PARAMETER :: BStC4_B1_Fzl = 223 - INTEGER(IntKi), PARAMETER :: BStC4_B1_Mxl = 224 - INTEGER(IntKi), PARAMETER :: BStC4_B1_Myl = 225 - INTEGER(IntKi), PARAMETER :: BStC4_B1_Mzl = 226 - INTEGER(IntKi), PARAMETER :: BStC1_B2_XQ = 227 - INTEGER(IntKi), PARAMETER :: BStC1_B2_XQD = 228 - INTEGER(IntKi), PARAMETER :: BStC1_B2_YQ = 229 - INTEGER(IntKi), PARAMETER :: BStC1_B2_YQD = 230 - INTEGER(IntKi), PARAMETER :: BStC1_B2_ZQ = 231 - INTEGER(IntKi), PARAMETER :: BStC1_B2_ZQD = 232 - INTEGER(IntKi), PARAMETER :: BStC1_B2_Fxi = 233 - INTEGER(IntKi), PARAMETER :: BStC1_B2_Fyi = 234 - INTEGER(IntKi), PARAMETER :: BStC1_B2_Fzi = 235 - INTEGER(IntKi), PARAMETER :: BStC1_B2_Mxi = 236 - INTEGER(IntKi), PARAMETER :: BStC1_B2_Myi = 237 - INTEGER(IntKi), PARAMETER :: BStC1_B2_Mzi = 238 - INTEGER(IntKi), PARAMETER :: BStC1_B2_Fxl = 239 - INTEGER(IntKi), PARAMETER :: BStC1_B2_Fyl = 240 - INTEGER(IntKi), PARAMETER :: BStC1_B2_Fzl = 241 - INTEGER(IntKi), PARAMETER :: BStC1_B2_Mxl = 242 - INTEGER(IntKi), PARAMETER :: BStC1_B2_Myl = 243 - INTEGER(IntKi), PARAMETER :: BStC1_B2_Mzl = 244 - INTEGER(IntKi), PARAMETER :: BStC2_B2_XQ = 245 - INTEGER(IntKi), PARAMETER :: BStC2_B2_XQD = 246 - INTEGER(IntKi), PARAMETER :: BStC2_B2_YQ = 247 - INTEGER(IntKi), PARAMETER :: BStC2_B2_YQD = 248 - INTEGER(IntKi), PARAMETER :: BStC2_B2_ZQ = 249 - INTEGER(IntKi), PARAMETER :: BStC2_B2_ZQD = 250 - INTEGER(IntKi), PARAMETER :: BStC2_B2_Fxi = 251 - INTEGER(IntKi), PARAMETER :: BStC2_B2_Fyi = 252 - INTEGER(IntKi), PARAMETER :: BStC2_B2_Fzi = 253 - INTEGER(IntKi), PARAMETER :: BStC2_B2_Mxi = 254 - INTEGER(IntKi), PARAMETER :: BStC2_B2_Myi = 255 - INTEGER(IntKi), PARAMETER :: BStC2_B2_Mzi = 256 - INTEGER(IntKi), PARAMETER :: BStC2_B2_Fxl = 257 - INTEGER(IntKi), PARAMETER :: BStC2_B2_Fyl = 258 - INTEGER(IntKi), PARAMETER :: BStC2_B2_Fzl = 259 - INTEGER(IntKi), PARAMETER :: BStC2_B2_Mxl = 260 - INTEGER(IntKi), PARAMETER :: BStC2_B2_Myl = 261 - INTEGER(IntKi), PARAMETER :: BStC2_B2_Mzl = 262 - INTEGER(IntKi), PARAMETER :: BStC3_B2_XQ = 263 - INTEGER(IntKi), PARAMETER :: BStC3_B2_XQD = 264 - INTEGER(IntKi), PARAMETER :: BStC3_B2_YQ = 265 - INTEGER(IntKi), PARAMETER :: BStC3_B2_YQD = 266 - INTEGER(IntKi), PARAMETER :: BStC3_B2_ZQ = 267 - INTEGER(IntKi), PARAMETER :: BStC3_B2_ZQD = 268 - INTEGER(IntKi), PARAMETER :: BStC3_B2_Fxi = 269 - INTEGER(IntKi), PARAMETER :: BStC3_B2_Fyi = 270 - INTEGER(IntKi), PARAMETER :: BStC3_B2_Fzi = 271 - INTEGER(IntKi), PARAMETER :: BStC3_B2_Mxi = 272 - INTEGER(IntKi), PARAMETER :: BStC3_B2_Myi = 273 - INTEGER(IntKi), PARAMETER :: BStC3_B2_Mzi = 274 - INTEGER(IntKi), PARAMETER :: BStC3_B2_Fxl = 275 - INTEGER(IntKi), PARAMETER :: BStC3_B2_Fyl = 276 - INTEGER(IntKi), PARAMETER :: BStC3_B2_Fzl = 277 - INTEGER(IntKi), PARAMETER :: BStC3_B2_Mxl = 278 - INTEGER(IntKi), PARAMETER :: BStC3_B2_Myl = 279 - INTEGER(IntKi), PARAMETER :: BStC3_B2_Mzl = 280 - INTEGER(IntKi), PARAMETER :: BStC4_B2_XQ = 281 - INTEGER(IntKi), PARAMETER :: BStC4_B2_XQD = 282 - INTEGER(IntKi), PARAMETER :: BStC4_B2_YQ = 283 - INTEGER(IntKi), PARAMETER :: BStC4_B2_YQD = 284 - INTEGER(IntKi), PARAMETER :: BStC4_B2_ZQ = 285 - INTEGER(IntKi), PARAMETER :: BStC4_B2_ZQD = 286 - INTEGER(IntKi), PARAMETER :: BStC4_B2_Fxi = 287 - INTEGER(IntKi), PARAMETER :: BStC4_B2_Fyi = 288 - INTEGER(IntKi), PARAMETER :: BStC4_B2_Fzi = 289 - INTEGER(IntKi), PARAMETER :: BStC4_B2_Mxi = 290 - INTEGER(IntKi), PARAMETER :: BStC4_B2_Myi = 291 - INTEGER(IntKi), PARAMETER :: BStC4_B2_Mzi = 292 - INTEGER(IntKi), PARAMETER :: BStC4_B2_Fxl = 293 - INTEGER(IntKi), PARAMETER :: BStC4_B2_Fyl = 294 - INTEGER(IntKi), PARAMETER :: BStC4_B2_Fzl = 295 - INTEGER(IntKi), PARAMETER :: BStC4_B2_Mxl = 296 - INTEGER(IntKi), PARAMETER :: BStC4_B2_Myl = 297 - INTEGER(IntKi), PARAMETER :: BStC4_B2_Mzl = 298 - INTEGER(IntKi), PARAMETER :: BStC1_B3_XQ = 299 - INTEGER(IntKi), PARAMETER :: BStC1_B3_XQD = 300 - INTEGER(IntKi), PARAMETER :: BStC1_B3_YQ = 301 - INTEGER(IntKi), PARAMETER :: BStC1_B3_YQD = 302 - INTEGER(IntKi), PARAMETER :: BStC1_B3_ZQ = 303 - INTEGER(IntKi), PARAMETER :: BStC1_B3_ZQD = 304 - INTEGER(IntKi), PARAMETER :: BStC1_B3_Fxi = 305 - INTEGER(IntKi), PARAMETER :: BStC1_B3_Fyi = 306 - INTEGER(IntKi), PARAMETER :: BStC1_B3_Fzi = 307 - INTEGER(IntKi), PARAMETER :: BStC1_B3_Mxi = 308 - INTEGER(IntKi), PARAMETER :: BStC1_B3_Myi = 309 - INTEGER(IntKi), PARAMETER :: BStC1_B3_Mzi = 310 - INTEGER(IntKi), PARAMETER :: BStC1_B3_Fxl = 311 - INTEGER(IntKi), PARAMETER :: BStC1_B3_Fyl = 312 - INTEGER(IntKi), PARAMETER :: BStC1_B3_Fzl = 313 - INTEGER(IntKi), PARAMETER :: BStC1_B3_Mxl = 314 - INTEGER(IntKi), PARAMETER :: BStC1_B3_Myl = 315 - INTEGER(IntKi), PARAMETER :: BStC1_B3_Mzl = 316 - INTEGER(IntKi), PARAMETER :: BStC2_B3_XQ = 317 - INTEGER(IntKi), PARAMETER :: BStC2_B3_XQD = 318 - INTEGER(IntKi), PARAMETER :: BStC2_B3_YQ = 319 - INTEGER(IntKi), PARAMETER :: BStC2_B3_YQD = 320 - INTEGER(IntKi), PARAMETER :: BStC2_B3_ZQ = 321 - INTEGER(IntKi), PARAMETER :: BStC2_B3_ZQD = 322 - INTEGER(IntKi), PARAMETER :: BStC2_B3_Fxi = 323 - INTEGER(IntKi), PARAMETER :: BStC2_B3_Fyi = 324 - INTEGER(IntKi), PARAMETER :: BStC2_B3_Fzi = 325 - INTEGER(IntKi), PARAMETER :: BStC2_B3_Mxi = 326 - INTEGER(IntKi), PARAMETER :: BStC2_B3_Myi = 327 - INTEGER(IntKi), PARAMETER :: BStC2_B3_Mzi = 328 - INTEGER(IntKi), PARAMETER :: BStC2_B3_Fxl = 329 - INTEGER(IntKi), PARAMETER :: BStC2_B3_Fyl = 330 - INTEGER(IntKi), PARAMETER :: BStC2_B3_Fzl = 331 - INTEGER(IntKi), PARAMETER :: BStC2_B3_Mxl = 332 - INTEGER(IntKi), PARAMETER :: BStC2_B3_Myl = 333 - INTEGER(IntKi), PARAMETER :: BStC2_B3_Mzl = 334 - INTEGER(IntKi), PARAMETER :: BStC3_B3_XQ = 335 - INTEGER(IntKi), PARAMETER :: BStC3_B3_XQD = 336 - INTEGER(IntKi), PARAMETER :: BStC3_B3_YQ = 337 - INTEGER(IntKi), PARAMETER :: BStC3_B3_YQD = 338 - INTEGER(IntKi), PARAMETER :: BStC3_B3_ZQ = 339 - INTEGER(IntKi), PARAMETER :: BStC3_B3_ZQD = 340 - INTEGER(IntKi), PARAMETER :: BStC3_B3_Fxi = 341 - INTEGER(IntKi), PARAMETER :: BStC3_B3_Fyi = 342 - INTEGER(IntKi), PARAMETER :: BStC3_B3_Fzi = 343 - INTEGER(IntKi), PARAMETER :: BStC3_B3_Mxi = 344 - INTEGER(IntKi), PARAMETER :: BStC3_B3_Myi = 345 - INTEGER(IntKi), PARAMETER :: BStC3_B3_Mzi = 346 - INTEGER(IntKi), PARAMETER :: BStC3_B3_Fxl = 347 - INTEGER(IntKi), PARAMETER :: BStC3_B3_Fyl = 348 - INTEGER(IntKi), PARAMETER :: BStC3_B3_Fzl = 349 - INTEGER(IntKi), PARAMETER :: BStC3_B3_Mxl = 350 - INTEGER(IntKi), PARAMETER :: BStC3_B3_Myl = 351 - INTEGER(IntKi), PARAMETER :: BStC3_B3_Mzl = 352 - INTEGER(IntKi), PARAMETER :: BStC4_B3_XQ = 353 - INTEGER(IntKi), PARAMETER :: BStC4_B3_XQD = 354 - INTEGER(IntKi), PARAMETER :: BStC4_B3_YQ = 355 - INTEGER(IntKi), PARAMETER :: BStC4_B3_YQD = 356 - INTEGER(IntKi), PARAMETER :: BStC4_B3_ZQ = 357 - INTEGER(IntKi), PARAMETER :: BStC4_B3_ZQD = 358 - INTEGER(IntKi), PARAMETER :: BStC4_B3_Fxi = 359 - INTEGER(IntKi), PARAMETER :: BStC4_B3_Fyi = 360 - INTEGER(IntKi), PARAMETER :: BStC4_B3_Fzi = 361 - INTEGER(IntKi), PARAMETER :: BStC4_B3_Mxi = 362 - INTEGER(IntKi), PARAMETER :: BStC4_B3_Myi = 363 - INTEGER(IntKi), PARAMETER :: BStC4_B3_Mzi = 364 - INTEGER(IntKi), PARAMETER :: BStC4_B3_Fxl = 365 - INTEGER(IntKi), PARAMETER :: BStC4_B3_Fyl = 366 - INTEGER(IntKi), PARAMETER :: BStC4_B3_Fzl = 367 - INTEGER(IntKi), PARAMETER :: BStC4_B3_Mxl = 368 - INTEGER(IntKi), PARAMETER :: BStC4_B3_Myl = 369 - INTEGER(IntKi), PARAMETER :: BStC4_B3_Mzl = 370 - INTEGER(IntKi), PARAMETER :: BStC1_B4_XQ = 371 - INTEGER(IntKi), PARAMETER :: BStC1_B4_XQD = 372 - INTEGER(IntKi), PARAMETER :: BStC1_B4_YQ = 373 - INTEGER(IntKi), PARAMETER :: BStC1_B4_YQD = 374 - INTEGER(IntKi), PARAMETER :: BStC1_B4_ZQ = 375 - INTEGER(IntKi), PARAMETER :: BStC1_B4_ZQD = 376 - INTEGER(IntKi), PARAMETER :: BStC1_B4_Fxi = 377 - INTEGER(IntKi), PARAMETER :: BStC1_B4_Fyi = 378 - INTEGER(IntKi), PARAMETER :: BStC1_B4_Fzi = 379 - INTEGER(IntKi), PARAMETER :: BStC1_B4_Mxi = 380 - INTEGER(IntKi), PARAMETER :: BStC1_B4_Myi = 381 - INTEGER(IntKi), PARAMETER :: BStC1_B4_Mzi = 382 - INTEGER(IntKi), PARAMETER :: BStC1_B4_Fxl = 383 - INTEGER(IntKi), PARAMETER :: BStC1_B4_Fyl = 384 - INTEGER(IntKi), PARAMETER :: BStC1_B4_Fzl = 385 - INTEGER(IntKi), PARAMETER :: BStC1_B4_Mxl = 386 - INTEGER(IntKi), PARAMETER :: BStC1_B4_Myl = 387 - INTEGER(IntKi), PARAMETER :: BStC1_B4_Mzl = 388 - INTEGER(IntKi), PARAMETER :: BStC2_B4_XQ = 389 - INTEGER(IntKi), PARAMETER :: BStC2_B4_XQD = 390 - INTEGER(IntKi), PARAMETER :: BStC2_B4_YQ = 391 - INTEGER(IntKi), PARAMETER :: BStC2_B4_YQD = 392 - INTEGER(IntKi), PARAMETER :: BStC2_B4_ZQ = 393 - INTEGER(IntKi), PARAMETER :: BStC2_B4_ZQD = 394 - INTEGER(IntKi), PARAMETER :: BStC2_B4_Fxi = 395 - INTEGER(IntKi), PARAMETER :: BStC2_B4_Fyi = 396 - INTEGER(IntKi), PARAMETER :: BStC2_B4_Fzi = 397 - INTEGER(IntKi), PARAMETER :: BStC2_B4_Mxi = 398 - INTEGER(IntKi), PARAMETER :: BStC2_B4_Myi = 399 - INTEGER(IntKi), PARAMETER :: BStC2_B4_Mzi = 400 - INTEGER(IntKi), PARAMETER :: BStC2_B4_Fxl = 401 - INTEGER(IntKi), PARAMETER :: BStC2_B4_Fyl = 402 - INTEGER(IntKi), PARAMETER :: BStC2_B4_Fzl = 403 - INTEGER(IntKi), PARAMETER :: BStC2_B4_Mxl = 404 - INTEGER(IntKi), PARAMETER :: BStC2_B4_Myl = 405 - INTEGER(IntKi), PARAMETER :: BStC2_B4_Mzl = 406 - INTEGER(IntKi), PARAMETER :: BStC3_B4_XQ = 407 - INTEGER(IntKi), PARAMETER :: BStC3_B4_XQD = 408 - INTEGER(IntKi), PARAMETER :: BStC3_B4_YQ = 409 - INTEGER(IntKi), PARAMETER :: BStC3_B4_YQD = 410 - INTEGER(IntKi), PARAMETER :: BStC3_B4_ZQ = 411 - INTEGER(IntKi), PARAMETER :: BStC3_B4_ZQD = 412 - INTEGER(IntKi), PARAMETER :: BStC3_B4_Fxi = 413 - INTEGER(IntKi), PARAMETER :: BStC3_B4_Fyi = 414 - INTEGER(IntKi), PARAMETER :: BStC3_B4_Fzi = 415 - INTEGER(IntKi), PARAMETER :: BStC3_B4_Mxi = 416 - INTEGER(IntKi), PARAMETER :: BStC3_B4_Myi = 417 - INTEGER(IntKi), PARAMETER :: BStC3_B4_Mzi = 418 - INTEGER(IntKi), PARAMETER :: BStC3_B4_Fxl = 419 - INTEGER(IntKi), PARAMETER :: BStC3_B4_Fyl = 420 - INTEGER(IntKi), PARAMETER :: BStC3_B4_Fzl = 421 - INTEGER(IntKi), PARAMETER :: BStC3_B4_Mxl = 422 - INTEGER(IntKi), PARAMETER :: BStC3_B4_Myl = 423 - INTEGER(IntKi), PARAMETER :: BStC3_B4_Mzl = 424 - INTEGER(IntKi), PARAMETER :: BStC4_B4_XQ = 425 - INTEGER(IntKi), PARAMETER :: BStC4_B4_XQD = 426 - INTEGER(IntKi), PARAMETER :: BStC4_B4_YQ = 427 - INTEGER(IntKi), PARAMETER :: BStC4_B4_YQD = 428 - INTEGER(IntKi), PARAMETER :: BStC4_B4_ZQ = 429 - INTEGER(IntKi), PARAMETER :: BStC4_B4_ZQD = 430 - INTEGER(IntKi), PARAMETER :: BStC4_B4_Fxi = 431 - INTEGER(IntKi), PARAMETER :: BStC4_B4_Fyi = 432 - INTEGER(IntKi), PARAMETER :: BStC4_B4_Fzi = 433 - INTEGER(IntKi), PARAMETER :: BStC4_B4_Mxi = 434 - INTEGER(IntKi), PARAMETER :: BStC4_B4_Myi = 435 - INTEGER(IntKi), PARAMETER :: BStC4_B4_Mzi = 436 - INTEGER(IntKi), PARAMETER :: BStC4_B4_Fxl = 437 - INTEGER(IntKi), PARAMETER :: BStC4_B4_Fyl = 438 - INTEGER(IntKi), PARAMETER :: BStC4_B4_Fzl = 439 - INTEGER(IntKi), PARAMETER :: BStC4_B4_Mxl = 440 - INTEGER(IntKi), PARAMETER :: BStC4_B4_Myl = 441 - INTEGER(IntKi), PARAMETER :: BStC4_B4_Mzl = 442 - - - ! Substructure Structural Control (StC): - - INTEGER(IntKi), PARAMETER :: SStC1_XQ = 443 - INTEGER(IntKi), PARAMETER :: SStC1_XQD = 444 - INTEGER(IntKi), PARAMETER :: SStC1_YQ = 445 - INTEGER(IntKi), PARAMETER :: SStC1_YQD = 446 - INTEGER(IntKi), PARAMETER :: SStC1_ZQ = 447 - INTEGER(IntKi), PARAMETER :: SStC1_ZQD = 448 - INTEGER(IntKi), PARAMETER :: SStC1_Fxi = 449 - INTEGER(IntKi), PARAMETER :: SStC1_Fyi = 450 - INTEGER(IntKi), PARAMETER :: SStC1_Fzi = 451 - INTEGER(IntKi), PARAMETER :: SStC1_Mxi = 452 - INTEGER(IntKi), PARAMETER :: SStC1_Myi = 453 - INTEGER(IntKi), PARAMETER :: SStC1_Mzi = 454 - INTEGER(IntKi), PARAMETER :: SStC1_Fxl = 455 - INTEGER(IntKi), PARAMETER :: SStC1_Fyl = 456 - INTEGER(IntKi), PARAMETER :: SStC1_Fzl = 457 - INTEGER(IntKi), PARAMETER :: SStC1_Mxl = 458 - INTEGER(IntKi), PARAMETER :: SStC1_Myl = 459 - INTEGER(IntKi), PARAMETER :: SStC1_Mzl = 460 - INTEGER(IntKi), PARAMETER :: SStC2_XQ = 461 - INTEGER(IntKi), PARAMETER :: SStC2_XQD = 462 - INTEGER(IntKi), PARAMETER :: SStC2_YQ = 463 - INTEGER(IntKi), PARAMETER :: SStC2_YQD = 464 - INTEGER(IntKi), PARAMETER :: SStC2_ZQ = 465 - INTEGER(IntKi), PARAMETER :: SStC2_ZQD = 466 - INTEGER(IntKi), PARAMETER :: SStC2_Fxi = 467 - INTEGER(IntKi), PARAMETER :: SStC2_Fyi = 468 - INTEGER(IntKi), PARAMETER :: SStC2_Fzi = 469 - INTEGER(IntKi), PARAMETER :: SStC2_Mxi = 470 - INTEGER(IntKi), PARAMETER :: SStC2_Myi = 471 - INTEGER(IntKi), PARAMETER :: SStC2_Mzi = 472 - INTEGER(IntKi), PARAMETER :: SStC2_Fxl = 473 - INTEGER(IntKi), PARAMETER :: SStC2_Fyl = 474 - INTEGER(IntKi), PARAMETER :: SStC2_Fzl = 475 - INTEGER(IntKi), PARAMETER :: SStC2_Mxl = 476 - INTEGER(IntKi), PARAMETER :: SStC2_Myl = 477 - INTEGER(IntKi), PARAMETER :: SStC2_Mzl = 478 - INTEGER(IntKi), PARAMETER :: SStC3_XQ = 479 - INTEGER(IntKi), PARAMETER :: SStC3_XQD = 480 - INTEGER(IntKi), PARAMETER :: SStC3_YQ = 481 - INTEGER(IntKi), PARAMETER :: SStC3_YQD = 482 - INTEGER(IntKi), PARAMETER :: SStC3_ZQ = 483 - INTEGER(IntKi), PARAMETER :: SStC3_ZQD = 484 - INTEGER(IntKi), PARAMETER :: SStC3_Fxi = 485 - INTEGER(IntKi), PARAMETER :: SStC3_Fyi = 486 - INTEGER(IntKi), PARAMETER :: SStC3_Fzi = 487 - INTEGER(IntKi), PARAMETER :: SStC3_Mxi = 488 - INTEGER(IntKi), PARAMETER :: SStC3_Myi = 489 - INTEGER(IntKi), PARAMETER :: SStC3_Mzi = 490 - INTEGER(IntKi), PARAMETER :: SStC3_Fxl = 491 - INTEGER(IntKi), PARAMETER :: SStC3_Fyl = 492 - INTEGER(IntKi), PARAMETER :: SStC3_Fzl = 493 - INTEGER(IntKi), PARAMETER :: SStC3_Mxl = 494 - INTEGER(IntKi), PARAMETER :: SStC3_Myl = 495 - INTEGER(IntKi), PARAMETER :: SStC3_Mzl = 496 - INTEGER(IntKi), PARAMETER :: SStC4_XQ = 497 - INTEGER(IntKi), PARAMETER :: SStC4_XQD = 498 - INTEGER(IntKi), PARAMETER :: SStC4_YQ = 499 - INTEGER(IntKi), PARAMETER :: SStC4_YQD = 500 - INTEGER(IntKi), PARAMETER :: SStC4_ZQ = 501 - INTEGER(IntKi), PARAMETER :: SStC4_ZQD = 502 - INTEGER(IntKi), PARAMETER :: SStC4_Fxi = 503 - INTEGER(IntKi), PARAMETER :: SStC4_Fyi = 504 - INTEGER(IntKi), PARAMETER :: SStC4_Fzi = 505 - INTEGER(IntKi), PARAMETER :: SStC4_Mxi = 506 - INTEGER(IntKi), PARAMETER :: SStC4_Myi = 507 - INTEGER(IntKi), PARAMETER :: SStC4_Mzi = 508 - INTEGER(IntKi), PARAMETER :: SStC4_Fxl = 509 - INTEGER(IntKi), PARAMETER :: SStC4_Fyl = 510 - INTEGER(IntKi), PARAMETER :: SStC4_Fzl = 511 - INTEGER(IntKi), PARAMETER :: SStC4_Mxl = 512 - INTEGER(IntKi), PARAMETER :: SStC4_Myl = 513 - INTEGER(IntKi), PARAMETER :: SStC4_Mzl = 514 - - - ! The maximum number of output channels which can be output by the code. - INTEGER(IntKi), PARAMETER :: MaxOutPts = 514 - -!End of code generated by Matlab script -! =================================================================================================== - INTEGER(IntKi), PARAMETER :: BlPitchC (3) = (/ BlPitchC1, BlPitchC2, BlPitchC3 /) - INTEGER(IntKi), PARAMETER :: BlAirfoilC (3) = (/ BlAirFlC1, BlAirFlC2, BlAirFlC3 /) - - ! Structural Control outputs -- these arrays simplify the output a little. The MaxBlOuts and MaxStC - ! must be set according to what is in the OutListParameters and auto - ! generated code above. - INTEGER(IntKi), PARAMETER :: MaxBlOuts = 4 ! maximum number of blades that we can output for - INTEGER(IntKi), PARAMETER :: MaxStC = 4 ! maximum number of StC outputs of type - ! StC nacelle outputs -- maximum of 4 for now. Expand if more needed - INTEGER(IntKi), PARAMETER :: NStC_XQ(MaxStC) = (/ NStC1_XQ, NStC2_XQ, NStC3_XQ, NStC4_XQ /) - INTEGER(IntKi), PARAMETER :: NStC_XQD(MaxStC) = (/ NStC1_XQD, NStC2_XQD, NStC3_XQD, NStC4_XQD /) - INTEGER(IntKi), PARAMETER :: NStC_YQ(MaxStC) = (/ NStC1_YQ, NStC2_YQ, NStC3_YQ, NStC4_YQ /) - INTEGER(IntKi), PARAMETER :: NStC_YQD(MaxStC) = (/ NStC1_YQD, NStC2_YQD, NStC3_YQD, NStC4_YQD /) - INTEGER(IntKi), PARAMETER :: NStC_ZQ(MaxStC) = (/ NStC1_ZQ, NStC2_ZQ, NStC3_ZQ, NStC4_ZQ /) - INTEGER(IntKi), PARAMETER :: NStC_ZQD(MaxStC) = (/ NStC1_ZQD, NStC2_ZQD, NStC3_ZQD, NStC4_ZQD /) - INTEGER(IntKi), PARAMETER :: NStC_Fxi(MaxStC) = (/ NStC1_Fxi, NStC2_Fxi, NStC3_Fxi, NStC4_Fxi /) - INTEGER(IntKi), PARAMETER :: NStC_Fyi(MaxStC) = (/ NStC1_Fyi, NStC2_Fyi, NStC3_Fyi, NStC4_Fyi /) - INTEGER(IntKi), PARAMETER :: NStC_Fzi(MaxStC) = (/ NStC1_Fzi, NStC2_Fzi, NStC3_Fzi, NStC4_Fzi /) - INTEGER(IntKi), PARAMETER :: NStC_Mxi(MaxStC) = (/ NStC1_Mxi, NStC2_Mxi, NStC3_Mxi, NStC4_Mxi /) - INTEGER(IntKi), PARAMETER :: NStC_Myi(MaxStC) = (/ NStC1_Myi, NStC2_Myi, NStC3_Myi, NStC4_Myi /) - INTEGER(IntKi), PARAMETER :: NStC_Mzi(MaxStC) = (/ NStC1_Mzi, NStC2_Mzi, NStC3_Mzi, NStC4_Mzi /) - INTEGER(IntKi), PARAMETER :: NStC_Fxl(MaxStC) = (/ NStC1_Fxl, NStC2_Fxl, NStC3_Fxl, NStC4_Fxl /) - INTEGER(IntKi), PARAMETER :: NStC_Fyl(MaxStC) = (/ NStC1_Fyl, NStC2_Fyl, NStC3_Fyl, NStC4_Fyl /) - INTEGER(IntKi), PARAMETER :: NStC_Fzl(MaxStC) = (/ NStC1_Fzl, NStC2_Fzl, NStC3_Fzl, NStC4_Fzl /) - INTEGER(IntKi), PARAMETER :: NStC_Mxl(MaxStC) = (/ NStC1_Mxl, NStC2_Mxl, NStC3_Mxl, NStC4_Mxl /) - INTEGER(IntKi), PARAMETER :: NStC_Myl(MaxStC) = (/ NStC1_Myl, NStC2_Myl, NStC3_Myl, NStC4_Myl /) - INTEGER(IntKi), PARAMETER :: NStC_Mzl(MaxStC) = (/ NStC1_Mzl, NStC2_Mzl, NStC3_Mzl, NStC4_Mzl /) - ! StC tower outputs -- maximum of 4 for now. Expand if more needed - INTEGER(IntKi), PARAMETER :: TStC_XQ(MaxStC) = (/ TStC1_XQ, TStC2_XQ, TStC3_XQ, TStC4_XQ /) - INTEGER(IntKi), PARAMETER :: TStC_XQD(MaxStC) = (/ TStC1_XQD, TStC2_XQD, TStC3_XQD, TStC4_XQD /) - INTEGER(IntKi), PARAMETER :: TStC_YQ(MaxStC) = (/ TStC1_YQ, TStC2_YQ, TStC3_YQ, TStC4_YQ /) - INTEGER(IntKi), PARAMETER :: TStC_YQD(MaxStC) = (/ TStC1_YQD, TStC2_YQD, TStC3_YQD, TStC4_YQD /) - INTEGER(IntKi), PARAMETER :: TStC_ZQ(MaxStC) = (/ TStC1_ZQ, TStC2_ZQ, TStC3_ZQ, TStC4_ZQ /) - INTEGER(IntKi), PARAMETER :: TStC_ZQD(MaxStC) = (/ TStC1_ZQD, TStC2_ZQD, TStC3_ZQD, TStC4_ZQD /) - INTEGER(IntKi), PARAMETER :: TStC_Fxi(MaxStC) = (/ TStC1_Fxi, TStC2_Fxi, TStC3_Fxi, TStC4_Fxi /) - INTEGER(IntKi), PARAMETER :: TStC_Fyi(MaxStC) = (/ TStC1_Fyi, TStC2_Fyi, TStC3_Fyi, TStC4_Fyi /) - INTEGER(IntKi), PARAMETER :: TStC_Fzi(MaxStC) = (/ TStC1_Fzi, TStC2_Fzi, TStC3_Fzi, TStC4_Fzi /) - INTEGER(IntKi), PARAMETER :: TStC_Mxi(MaxStC) = (/ TStC1_Mxi, TStC2_Mxi, TStC3_Mxi, TStC4_Mxi /) - INTEGER(IntKi), PARAMETER :: TStC_Myi(MaxStC) = (/ TStC1_Myi, TStC2_Myi, TStC3_Myi, TStC4_Myi /) - INTEGER(IntKi), PARAMETER :: TStC_Mzi(MaxStC) = (/ TStC1_Mzi, TStC2_Mzi, TStC3_Mzi, TStC4_Mzi /) - INTEGER(IntKi), PARAMETER :: TStC_Fxl(MaxStC) = (/ TStC1_Fxl, TStC2_Fxl, TStC3_Fxl, TStC4_Fxl /) - INTEGER(IntKi), PARAMETER :: TStC_Fyl(MaxStC) = (/ TStC1_Fyl, TStC2_Fyl, TStC3_Fyl, TStC4_Fyl /) - INTEGER(IntKi), PARAMETER :: TStC_Fzl(MaxStC) = (/ TStC1_Fzl, TStC2_Fzl, TStC3_Fzl, TStC4_Fzl /) - INTEGER(IntKi), PARAMETER :: TStC_Mxl(MaxStC) = (/ TStC1_Mxl, TStC2_Mxl, TStC3_Mxl, TStC4_Mxl /) - INTEGER(IntKi), PARAMETER :: TStC_Myl(MaxStC) = (/ TStC1_Myl, TStC2_Myl, TStC3_Myl, TStC4_Myl /) - INTEGER(IntKi), PARAMETER :: TStC_Mzl(MaxStC) = (/ TStC1_Mzl, TStC2_Mzl, TStC3_Mzl, TStC4_Mzl /) - ! StC blade outputs -- maximum of 4 for now. Expand if more needed - INTEGER(IntKi), PARAMETER :: BStC_XQ(MaxStC,MaxBlOuts) = reshape((/ & - BStC1_B1_XQ, BStC2_B1_XQ, BStC3_B1_XQ, BStC4_B1_XQ, & - BStC1_B2_XQ, BStC2_B2_XQ, BStC3_B2_XQ, BStC4_B2_XQ, & - BStC1_B3_XQ, BStC2_B3_XQ, BStC3_B3_XQ, BStC4_B3_XQ, & - BStC1_B4_XQ, BStC2_B4_XQ, BStC3_B4_XQ, BStC4_B4_XQ /),(/4,MaxBlOuts/)) - INTEGER(IntKi), PARAMETER :: BStC_XQD(MaxStC,MaxBlOuts)= reshape((/ & - BStC1_B1_XQD, BStC2_B1_XQD, BStC3_B1_XQD, BStC4_B1_XQD, & - BStC1_B2_XQD, BStC2_B2_XQD, BStC3_B2_XQD, BStC4_B2_XQD, & - BStC1_B3_XQD, BStC2_B3_XQD, BStC3_B3_XQD, BStC4_B3_XQD, & - BStC1_B4_XQD, BStC2_B4_XQD, BStC3_B4_XQD, BStC4_B4_XQD /),(/4,MaxBlOuts/)) - INTEGER(IntKi), PARAMETER :: BStC_YQ(MaxStC,MaxBlOuts) = reshape((/ & - BStC1_B1_YQ, BStC2_B1_YQ, BStC3_B1_YQ, BStC4_B1_YQ, & - BStC1_B2_YQ, BStC2_B2_YQ, BStC3_B2_YQ, BStC4_B2_YQ, & - BStC1_B3_YQ, BStC2_B3_YQ, BStC3_B3_YQ, BStC4_B3_YQ, & - BStC1_B4_YQ, BStC2_B4_YQ, BStC3_B4_YQ, BStC4_B4_YQ /),(/4,MaxBlOuts/)) - INTEGER(IntKi), PARAMETER :: BStC_YQD(MaxStC,MaxBlOuts)= reshape((/ & - BStC1_B1_YQD, BStC2_B1_YQD, BStC3_B1_YQD, BStC4_B1_YQD, & - BStC1_B2_YQD, BStC2_B2_YQD, BStC3_B2_YQD, BStC4_B2_YQD, & - BStC1_B3_YQD, BStC2_B3_YQD, BStC3_B3_YQD, BStC4_B3_YQD, & - BStC1_B4_YQD, BStC2_B4_YQD, BStC3_B4_YQD, BStC4_B4_YQD /),(/4,MaxBlOuts/)) - INTEGER(IntKi), PARAMETER :: BStC_ZQ(MaxStC,MaxBlOuts) = reshape((/ & - BStC1_B1_ZQ, BStC2_B1_ZQ, BStC3_B1_ZQ, BStC4_B1_ZQ, & - BStC1_B2_ZQ, BStC2_B2_ZQ, BStC3_B2_ZQ, BStC4_B2_ZQ, & - BStC1_B3_ZQ, BStC2_B3_ZQ, BStC3_B3_ZQ, BStC4_B3_ZQ, & - BStC1_B4_ZQ, BStC2_B4_ZQ, BStC3_B4_ZQ, BStC4_B4_ZQ /),(/4,MaxBlOuts/)) - INTEGER(IntKi), PARAMETER :: BStC_ZQD(MaxStC,MaxBlOuts)= reshape((/ & - BStC1_B1_ZQD, BStC2_B1_ZQD, BStC3_B1_ZQD, BStC4_B1_ZQD, & - BStC1_B2_ZQD, BStC2_B2_ZQD, BStC3_B2_ZQD, BStC4_B2_ZQD, & - BStC1_B3_ZQD, BStC2_B3_ZQD, BStC3_B3_ZQD, BStC4_B3_ZQD, & - BStC1_B4_ZQD, BStC2_B4_ZQD, BStC3_B4_ZQD, BStC4_B4_ZQD /),(/4,MaxBlOuts/)) - INTEGER(IntKi), PARAMETER :: BStC_Fxi(MaxStC,MaxBlOuts)= reshape((/ & - BStC1_B1_Fxi, BStC2_B1_Fxi, BStC3_B1_Fxi, BStC4_B1_Fxi, & - BStC1_B2_Fxi, BStC2_B2_Fxi, BStC3_B2_Fxi, BStC4_B2_Fxi, & - BStC1_B3_Fxi, BStC2_B3_Fxi, BStC3_B3_Fxi, BStC4_B3_Fxi, & - BStC1_B4_Fxi, BStC2_B4_Fxi, BStC3_B4_Fxi, BStC4_B4_Fxi /),(/4,MaxBlOuts/)) - INTEGER(IntKi), PARAMETER :: BStC_Fyi(MaxStC,MaxBlOuts)= reshape((/ & - BStC1_B1_Fyi, BStC2_B1_Fyi, BStC3_B1_Fyi, BStC4_B1_Fyi, & - BStC1_B2_Fyi, BStC2_B2_Fyi, BStC3_B2_Fyi, BStC4_B2_Fyi, & - BStC1_B3_Fyi, BStC2_B3_Fyi, BStC3_B3_Fyi, BStC4_B3_Fyi, & - BStC1_B4_Fyi, BStC2_B4_Fyi, BStC3_B4_Fyi, BStC4_B4_Fyi /),(/4,MaxBlOuts/)) - INTEGER(IntKi), PARAMETER :: BStC_Fzi(MaxStC,MaxBlOuts)= reshape((/ & - BStC1_B1_Fzi, BStC2_B1_Fzi, BStC3_B1_Fzi, BStC4_B1_Fzi, & - BStC1_B2_Fzi, BStC2_B2_Fzi, BStC3_B2_Fzi, BStC4_B2_Fzi, & - BStC1_B3_Fzi, BStC2_B3_Fzi, BStC3_B3_Fzi, BStC4_B3_Fzi, & - BStC1_B4_Fzi, BStC2_B4_Fzi, BStC3_B4_Fzi, BStC4_B4_Fzi /),(/4,MaxBlOuts/)) - INTEGER(IntKi), PARAMETER :: BStC_Mxi(MaxStC,MaxBlOuts)= reshape((/ & - BStC1_B1_Mxi, BStC2_B1_Mxi, BStC3_B1_Mxi, BStC4_B1_Mxi, & - BStC1_B2_Mxi, BStC2_B2_Mxi, BStC3_B2_Mxi, BStC4_B2_Mxi, & - BStC1_B3_Mxi, BStC2_B3_Mxi, BStC3_B3_Mxi, BStC4_B3_Mxi, & - BStC1_B4_Mxi, BStC2_B4_Mxi, BStC3_B4_Mxi, BStC4_B4_Mxi /),(/4,MaxBlOuts/)) - INTEGER(IntKi), PARAMETER :: BStC_Myi(MaxStC,MaxBlOuts)= reshape((/ & - BStC1_B1_Myi, BStC2_B1_Myi, BStC3_B1_Myi, BStC4_B1_Myi, & - BStC1_B2_Myi, BStC2_B2_Myi, BStC3_B2_Myi, BStC4_B2_Myi, & - BStC1_B3_Myi, BStC2_B3_Myi, BStC3_B3_Myi, BStC4_B3_Myi, & - BStC1_B4_Myi, BStC2_B4_Myi, BStC3_B4_Myi, BStC4_B4_Myi /),(/4,MaxBlOuts/)) - INTEGER(IntKi), PARAMETER :: BStC_Mzi(MaxStC,MaxBlOuts)= reshape((/ & - BStC1_B1_Mzi, BStC2_B1_Mzi, BStC3_B1_Mzi, BStC4_B1_Mzi, & - BStC1_B2_Mzi, BStC2_B2_Mzi, BStC3_B2_Mzi, BStC4_B2_Mzi, & - BStC1_B3_Mzi, BStC2_B3_Mzi, BStC3_B3_Mzi, BStC4_B3_Mzi, & - BStC1_B4_Mzi, BStC2_B4_Mzi, BStC3_B4_Mzi, BStC4_B4_Mzi /),(/4,MaxBlOuts/)) - INTEGER(IntKi), PARAMETER :: BStC_Fxl(MaxStC,MaxBlOuts)= reshape((/ & - BStC1_B1_Fxl, BStC2_B1_Fxl, BStC3_B1_Fxl, BStC4_B1_Fxl, & - BStC1_B2_Fxl, BStC2_B2_Fxl, BStC3_B2_Fxl, BStC4_B2_Fxl, & - BStC1_B3_Fxl, BStC2_B3_Fxl, BStC3_B3_Fxl, BStC4_B3_Fxl, & - BStC1_B4_Fxl, BStC2_B4_Fxl, BStC3_B4_Fxl, BStC4_B4_Fxl /),(/4,MaxBlOuts/)) - INTEGER(IntKi), PARAMETER :: BStC_Fyl(MaxStC,MaxBlOuts)= reshape((/ & - BStC1_B1_Fyl, BStC2_B1_Fyl, BStC3_B1_Fyl, BStC4_B1_Fyl, & - BStC1_B2_Fyl, BStC2_B2_Fyl, BStC3_B2_Fyl, BStC4_B2_Fyl, & - BStC1_B3_Fyl, BStC2_B3_Fyl, BStC3_B3_Fyl, BStC4_B3_Fyl, & - BStC1_B1_Fyl, BStC2_B1_Fyl, BStC3_B1_Fyl, BStC4_B1_Fyl /),(/4,MaxBlOuts/)) - INTEGER(IntKi), PARAMETER :: BStC_Fzl(MaxStC,MaxBlOuts)= reshape((/ & - BStC1_B1_Fzl, BStC2_B1_Fzl, BStC3_B1_Fzl, BStC4_B1_Fzl, & - BStC1_B2_Fzl, BStC2_B2_Fzl, BStC3_B2_Fzl, BStC4_B2_Fzl, & - BStC1_B3_Fzl, BStC2_B3_Fzl, BStC3_B3_Fzl, BStC4_B3_Fzl, & - BStC1_B4_Fzl, BStC2_B4_Fzl, BStC3_B4_Fzl, BStC4_B4_Fzl /),(/4,MaxBlOuts/)) - INTEGER(IntKi), PARAMETER :: BStC_Mxl(MaxStC,MaxBlOuts)= reshape((/ & - BStC1_B1_Mxl, BStC2_B1_Mxl, BStC3_B1_Mxl, BStC4_B1_Mxl, & - BStC1_B2_Mxl, BStC2_B2_Mxl, BStC3_B2_Mxl, BStC4_B2_Mxl, & - BStC1_B3_Mxl, BStC2_B3_Mxl, BStC3_B3_Mxl, BStC4_B3_Mxl, & - BStC1_B4_Mxl, BStC2_B4_Mxl, BStC3_B4_Mxl, BStC4_B4_Mxl /),(/4,MaxBlOuts/)) - INTEGER(IntKi), PARAMETER :: BStC_Myl(MaxStC,MaxBlOuts)= reshape((/ & - BStC1_B1_Myl, BStC2_B1_Myl, BStC3_B1_Myl, BStC4_B1_Myl, & - BStC1_B2_Myl, BStC2_B2_Myl, BStC3_B2_Myl, BStC4_B2_Myl, & - BStC1_B3_Myl, BStC2_B3_Myl, BStC3_B3_Myl, BStC4_B3_Myl, & - BStC1_B4_Myl, BStC2_B4_Myl, BStC3_B4_Myl, BStC4_B4_Myl /),(/4,MaxBlOuts/)) - INTEGER(IntKi), PARAMETER :: BStC_Mzl(MaxStC,MaxBlOuts)= reshape((/ & - BStC1_B1_Mzl, BStC2_B1_Mzl, BStC3_B1_Mzl, BStC4_B1_Mzl, & - BStC1_B2_Mzl, BStC2_B2_Mzl, BStC3_B2_Mzl, BStC4_B2_Mzl, & - BStC1_B3_Mzl, BStC2_B3_Mzl, BStC3_B3_Mzl, BStC4_B3_Mzl, & - BStC1_B4_Mzl, BStC2_B4_Mzl, BStC3_B4_Mzl, BStC4_B4_Mzl /),(/4,MaxBlOuts/)) - ! StC Platform outputs -- maximum of 4 for now. Expand if more needed - INTEGER(IntKi), PARAMETER :: SStC_XQ(MaxStC) = (/ SStC1_XQ, SStC2_XQ, SStC3_XQ, SStC4_XQ /) - INTEGER(IntKi), PARAMETER :: SStC_XQD(MaxStC) = (/ SStC1_XQD, SStC2_XQD, SStC3_XQD, SStC4_XQD /) - INTEGER(IntKi), PARAMETER :: SStC_YQ(MaxStC) = (/ SStC1_YQ, SStC2_YQ, SStC3_YQ, SStC4_YQ /) - INTEGER(IntKi), PARAMETER :: SStC_YQD(MaxStC) = (/ SStC1_YQD, SStC2_YQD, SStC3_YQD, SStC4_YQD /) - INTEGER(IntKi), PARAMETER :: SStC_ZQ(MaxStC) = (/ SStC1_ZQ, SStC2_ZQ, SStC3_ZQ, SStC4_ZQ /) - INTEGER(IntKi), PARAMETER :: SStC_ZQD(MaxStC) = (/ SStC1_ZQD, SStC2_ZQD, SStC3_ZQD, SStC4_ZQD /) - INTEGER(IntKi), PARAMETER :: SStC_Fxi(MaxStC) = (/ SStC1_Fxi, SStC2_Fxi, SStC3_Fxi, SStC4_Fxi /) - INTEGER(IntKi), PARAMETER :: SStC_Fyi(MaxStC) = (/ SStC1_Fyi, SStC2_Fyi, SStC3_Fyi, SStC4_Fyi /) - INTEGER(IntKi), PARAMETER :: SStC_Fzi(MaxStC) = (/ SStC1_Fzi, SStC2_Fzi, SStC3_Fzi, SStC4_Fzi /) - INTEGER(IntKi), PARAMETER :: SStC_Mxi(MaxStC) = (/ SStC1_Mxi, SStC2_Mxi, SStC3_Mxi, SStC4_Mxi /) - INTEGER(IntKi), PARAMETER :: SStC_Myi(MaxStC) = (/ SStC1_Myi, SStC2_Myi, SStC3_Myi, SStC4_Myi /) - INTEGER(IntKi), PARAMETER :: SStC_Mzi(MaxStC) = (/ SStC1_Mzi, SStC2_Mzi, SStC3_Mzi, SStC4_Mzi /) - INTEGER(IntKi), PARAMETER :: SStC_Fxl(MaxStC) = (/ SStC1_Fxl, SStC2_Fxl, SStC3_Fxl, SStC4_Fxl /) - INTEGER(IntKi), PARAMETER :: SStC_Fyl(MaxStC) = (/ SStC1_Fyl, SStC2_Fyl, SStC3_Fyl, SStC4_Fyl /) - INTEGER(IntKi), PARAMETER :: SStC_Fzl(MaxStC) = (/ SStC1_Fzl, SStC2_Fzl, SStC3_Fzl, SStC4_Fzl /) - INTEGER(IntKi), PARAMETER :: SStC_Mxl(MaxStC) = (/ SStC1_Mxl, SStC2_Mxl, SStC3_Mxl, SStC4_Mxl /) - INTEGER(IntKi), PARAMETER :: SStC_Myl(MaxStC) = (/ SStC1_Myl, SStC2_Myl, SStC3_Myl, SStC4_Myl /) - INTEGER(IntKi), PARAMETER :: SStC_Mzl(MaxStC) = (/ SStC1_Mzl, SStC2_Mzl, SStC3_Mzl, SStC4_Mzl /) - - - -CONTAINS -!--------------------------- -subroutine Set_SrvD_Outs( p, y, m, AllOuts ) - type(SrvD_ParameterType), intent(in ) :: p !< Parameters - type(SrvD_OutputType), intent(in ) :: y !< Outputs computed at Time - type(SrvD_MiscVarType), intent(inout) :: m !< Misc (optimization) variables - real(ReKi), intent(inout) :: AllOuts(0:MaxOutPts) ! All the the available output channels - integer :: K - - !............................................................................................................................... - ! Calculate all of the available output channels: - !............................................................................................................................... - ! This is overwriting the values if it was called from UpdateStates, but they - ! should be the same and this sets the values if we called the DLL above. - m%dll_data%ElecPwr_prev = y%ElecPwr - m%dll_data%GenTrq_prev = y%GenTrq - - !............................................................................................................................... - ! Calculate all of the available output channels: - !............................................................................................................................... -! AllOuts(Time) = t - - AllOuts(GenTq) = 0.001*y%GenTrq - AllOuts(GenPwr) = 0.001*y%ElecPwr - AllOuts(HSSBrTqC)= 0.001*y%HSSBrTrqC - - DO K=1,p%NumBl - AllOuts( BlPitchC(K) ) = y%BlPitchCom(K)*R2D - AllOuts( BlAirfoilC(K) ) = y%BlAirfoilCom(K) - END DO - - AllOuts(YawMomCom) = -0.001*y%YawMom - -end subroutine Set_SrvD_Outs -!--------------------------- -subroutine Set_NStC_Outs( p_SrvD, x, m, y, AllOuts ) ! Nacelle - type(SrvD_ParameterType), intent(in ) :: p_SrvD !< Parameters - type(StC_ContinuousStateType), allocatable,intent(in ) :: x(:) !< Continuous states at t - type(StC_MiscVarType), allocatable,intent(in ) :: m(:) !< Misc (optimization) variables - type(StC_OutputType), allocatable,intent(in ) :: y(:) !< Outputs computed at Time - real(ReKi), intent(inout) :: AllOuts(0:MaxOutPts) ! All the the available output channels - integer :: i,j - j=1 - if (allocated(x) .and. allocated(m) .and. allocated(y)) then - do i=1,min(p_SrvD%NumNStC,MaxStC) ! in case we have more Nacelle StCs than the outputs are set for - AllOuts(NStC_XQ( i)) = x(i)%StC_x(1,1) ! x - AllOuts(NStC_XQD(i)) = x(i)%StC_x(2,1) ! x-dot - AllOuts(NStC_YQ( i)) = x(i)%StC_x(3,1) ! y - AllOuts(NStC_YQD(i)) = x(i)%StC_x(4,1) ! y-dot - AllOuts(NStC_ZQ( i)) = x(i)%StC_x(5,1) ! z - AllOuts(NStC_ZQD(i)) = x(i)%StC_x(6,1) ! z-dot - AllOuts(NStC_Fxi(i)) = 0.001*y(i)%Mesh(j)%Force(1,1) ! only one mesh per NStC instance - AllOuts(NStC_Fyi(i)) = 0.001*y(i)%Mesh(j)%Force(2,1) ! only one mesh per NStC instance - AllOuts(NStC_Fzi(i)) = 0.001*y(i)%Mesh(j)%Force(3,1) ! only one mesh per NStC instance - AllOuts(NStC_Mxi(i)) = 0.001*y(i)%Mesh(j)%Moment(1,1) ! only one mesh per NStC instance - AllOuts(NStC_Myi(i)) = 0.001*y(i)%Mesh(j)%Moment(2,1) ! only one mesh per NStC instance - AllOuts(NStC_Mzi(i)) = 0.001*y(i)%Mesh(j)%Moment(3,1) ! only one mesh per NStC instance - AllOuts(NStC_Fxl(i)) = 0.001*m(i)%F_P(1,j) - AllOuts(NStC_Fyl(i)) = 0.001*m(i)%F_P(2,j) - AllOuts(NStC_Fzl(i)) = 0.001*m(i)%F_P(3,j) - AllOuts(NStC_Mxl(i)) = 0.001*m(i)%M_P(1,j) - AllOuts(NStC_Myl(i)) = 0.001*m(i)%M_P(2,j) - AllOuts(NStC_Mzl(i)) = 0.001*m(i)%M_P(3,j) - enddo - endif -end subroutine Set_NStC_Outs -!--------------------------- -subroutine Set_TStC_Outs( p_SrvD, x, m, y, AllOuts ) ! Tower - type(SrvD_ParameterType), intent(in ) :: p_SrvD !< Parameters - type(StC_ContinuousStateType), allocatable,intent(in ) :: x(:) !< Continuous states at t - type(StC_MiscVarType), allocatable,intent(in ) :: m(:) !< Misc (optimization) variables - type(StC_OutputType), allocatable,intent(in ) :: y(:) !< Outputs computed at Time - real(ReKi), intent(inout) :: AllOuts(0:MaxOutPts) ! All the the available output channels - integer :: i,j - j=1 - if (allocated(x) .and. allocated(m) .and. allocated(y)) then - do i=1,min(p_SrvD%NumTStC,MaxStC) ! in case we have more Nacelle StCs than the outputs are set for - AllOuts(TStC_XQ( i)) = x(i)%StC_x(1,1) ! x - AllOuts(TStC_XQD(i)) = x(i)%StC_x(2,1) ! x-dot - AllOuts(TStC_YQ( i)) = x(i)%StC_x(3,1) ! y - AllOuts(TStC_YQD(i)) = x(i)%StC_x(4,1) ! y-dot - AllOuts(TStC_ZQ( i)) = x(i)%StC_x(5,1) ! z - AllOuts(TStC_ZQD(i)) = x(i)%StC_x(6,1) ! z-dot - AllOuts(TStC_Fxi(i)) = 0.001*y(i)%Mesh(j)%Force(1,1) ! only one mesh per TStC instance - AllOuts(TStC_Fyi(i)) = 0.001*y(i)%Mesh(j)%Force(2,1) ! only one mesh per TStC instance - AllOuts(TStC_Fzi(i)) = 0.001*y(i)%Mesh(j)%Force(3,1) ! only one mesh per TStC instance - AllOuts(TStC_Mxi(i)) = 0.001*y(i)%Mesh(j)%Moment(1,1) ! only one mesh per TStC instance - AllOuts(TStC_Myi(i)) = 0.001*y(i)%Mesh(j)%Moment(2,1) ! only one mesh per TStC instance - AllOuts(TStC_Mzi(i)) = 0.001*y(i)%Mesh(j)%Moment(3,1) ! only one mesh per TStC instance - AllOuts(TStC_Fxl(i)) = 0.001*m(i)%F_P(1,j) - AllOuts(TStC_Fyl(i)) = 0.001*m(i)%F_P(2,j) - AllOuts(TStC_Fzl(i)) = 0.001*m(i)%F_P(3,j) - AllOuts(TStC_Mxl(i)) = 0.001*m(i)%M_P(1,j) - AllOuts(TStC_Myl(i)) = 0.001*m(i)%M_P(2,j) - AllOuts(TStC_Mzl(i)) = 0.001*m(i)%M_P(3,j) - enddo - endif -end subroutine Set_TStC_Outs -!--------------------------- -subroutine Set_BStC_Outs( p_SrvD, x, m, y, AllOuts ) ! Blades - type(SrvD_ParameterType), intent(in ) :: p_SrvD !< Parameters - type(StC_ContinuousStateType), allocatable,intent(in ) :: x(:) !< Continuous states at t - type(StC_MiscVarType), allocatable,intent(in ) :: m(:) !< Misc (optimization) variables - type(StC_OutputType), allocatable,intent(in ) :: y(:) !< Outputs computed at Time - real(ReKi), intent(inout) :: AllOuts(0:MaxOutPts) ! All the the available output channels - integer :: i,j - if (allocated(x) .and. allocated(m) .and. allocated(y)) then - do j=1,min(p_SrvD%NumBl,MaxBlOuts) - do i=1,min(p_SrvD%NumBStC,MaxStC) ! in case we have more Nacelle StCs than the outputs are set for - AllOuts(BStC_XQ( i,j)) = x(i)%StC_x(1,j) ! x - AllOuts(BStC_XQD(i,j)) = x(i)%StC_x(2,j) ! x-dot - AllOuts(BStC_YQ( i,j)) = x(i)%StC_x(3,j) ! y - AllOuts(BStC_YQD(i,j)) = x(i)%StC_x(4,j) ! y-dot - AllOuts(BStC_ZQ( i,j)) = x(i)%StC_x(5,j) ! z - AllOuts(BStC_ZQD(i,j)) = x(i)%StC_x(6,j) ! z-dot - AllOuts(BStC_Fxi(i,j)) = 0.001*y(i)%Mesh(j)%Force(1,1) ! only one mesh per BStC instance - AllOuts(BStC_Fyi(i,j)) = 0.001*y(i)%Mesh(j)%Force(2,1) ! only one mesh per BStC instance - AllOuts(BStC_Fzi(i,j)) = 0.001*y(i)%Mesh(j)%Force(3,1) ! only one mesh per BStC instance - AllOuts(BStC_Mxi(i,j)) = 0.001*y(i)%Mesh(j)%Moment(1,1) ! only one mesh per BStC instance - AllOuts(BStC_Myi(i,j)) = 0.001*y(i)%Mesh(j)%Moment(2,1) ! only one mesh per BStC instance - AllOuts(BStC_Mzi(i,j)) = 0.001*y(i)%Mesh(j)%Moment(3,1) ! only one mesh per BStC instance - AllOuts(BStC_Fxl(i,j)) = 0.001*m(i)%F_P(1,j) - AllOuts(BStC_Fyl(i,j)) = 0.001*m(i)%F_P(2,j) - AllOuts(BStC_Fzl(i,j)) = 0.001*m(i)%F_P(3,j) - AllOuts(BStC_Mxl(i,j)) = 0.001*m(i)%M_P(1,j) - AllOuts(BStC_Myl(i,j)) = 0.001*m(i)%M_P(2,j) - AllOuts(BStC_Mzl(i,j)) = 0.001*m(i)%M_P(3,j) - enddo - enddo - endif -end subroutine Set_BStC_Outs -!--------------------------- -subroutine Set_SStC_Outs( p_SrvD, x, m, y, AllOuts ) ! Platform - type(SrvD_ParameterType), intent(in ) :: p_SrvD !< Parameters - type(StC_ContinuousStateType), allocatable,intent(in ) :: x(:) !< Continuous states at t - type(StC_MiscVarType), allocatable,intent(in ) :: m(:) !< Misc (optimization) variables - type(StC_OutputType), allocatable,intent(in ) :: y(:) !< Outputs computed at Time - real(ReKi), intent(inout) :: AllOuts(0:MaxOutPts) ! All the the available output channels - integer :: i,j - j=1 - if (allocated(x) .and. allocated(m) .and. allocated(y)) then - do i=1,min(p_SrvD%NumSStC,MaxStC) ! in case we have more Nacelle StCs than the outputs are set for - AllOuts(SStC_XQ( i)) = x(i)%StC_x(1,1) ! x - AllOuts(SStC_XQD(i)) = x(i)%StC_x(2,1) ! x-dot - AllOuts(SStC_YQ( i)) = x(i)%StC_x(3,1) ! y - AllOuts(SStC_YQD(i)) = x(i)%StC_x(4,1) ! y-dot - AllOuts(SStC_ZQ( i)) = x(i)%StC_x(5,1) ! z - AllOuts(SStC_ZQD(i)) = x(i)%StC_x(6,1) ! z-dot - AllOuts(SStC_Fxi(i)) = 0.001*y(i)%Mesh(j)%Force(1,1) ! only one mesh per SStC instance - AllOuts(SStC_Fyi(i)) = 0.001*y(i)%Mesh(j)%Force(2,1) ! only one mesh per SStC instance - AllOuts(SStC_Fzi(i)) = 0.001*y(i)%Mesh(j)%Force(3,1) ! only one mesh per SStC instance - AllOuts(SStC_Mxi(i)) = 0.001*y(i)%Mesh(j)%Moment(1,1) ! only one mesh per SStC instance - AllOuts(SStC_Myi(i)) = 0.001*y(i)%Mesh(j)%Moment(2,1) ! only one mesh per SStC instance - AllOuts(SStC_Mzi(i)) = 0.001*y(i)%Mesh(j)%Moment(3,1) ! only one mesh per SStC instance - AllOuts(SStC_Fxl(i)) = 0.001*m(i)%F_P(1,j) - AllOuts(SStC_Fyl(i)) = 0.001*m(i)%F_P(2,j) - AllOuts(SStC_Fzl(i)) = 0.001*m(i)%F_P(3,j) - AllOuts(SStC_Mxl(i)) = 0.001*m(i)%M_P(1,j) - AllOuts(SStC_Myl(i)) = 0.001*m(i)%M_P(2,j) - AllOuts(SStC_Mzl(i)) = 0.001*m(i)%M_P(3,j) - enddo - endif -end subroutine Set_SStC_Outs -!--------------------------- - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine parses the input file and stores all the data in the SrvD_InputFile structure. -!! It does not perform data validation. -subroutine ParseInputFileInfo( PriPath, InputFile, OutFileRoot, FileInfo_In, InputFileData, Default_DT, ErrStat, ErrMsg ) - - implicit none - - ! Passed variables - character(*), intent(in ) :: PriPath ! Path name of the primary file - character(*), intent(in ) :: InputFile !< Name of the file containing the primary input data - character(*), intent(in ) :: OutFileRoot !< The rootname of the echo file, possibly opened in this routine - type(SrvD_InputFile), intent( out) :: InputFileData !< All the data in the StrucCtrl input file - type(FileInfoType), intent(in ) :: FileInfo_In !< The derived type for holding the file information. - real(DbKi), intent(in ) :: Default_DT !< The default DT (from glue code) - integer(IntKi), intent( out) :: ErrStat !< Error status - character(ErrMsgLen), intent( out) :: ErrMsg !< Error message - - ! Local variables: - integer(IntKi) :: i !< generic counter - character(20) :: TmpChr !< Temporary char array - integer(IntKi) :: UnEcho - integer(IntKi) :: ErrStat2 !< Temporary Error status - character(ErrMsgLen) :: ErrMsg2 !< Temporary Error message - integer(IntKi) :: CurLine !< current entry in FileInfo_In%Lines array - real(ReKi) :: TmpRe2(2) !< temporary 2 number array for reading values in - character(*), parameter :: RoutineName = 'ParseInputFileInfo' - - - ! Initialization - ErrStat = ErrID_None - ErrMsg = "" - UnEcho = -1 ! Echo file unit. >0 when used - - call AllocAry( InputFileData%OutList, MaxOutPts, "ServoDyn Input File's Outlist", ErrStat2, ErrMsg2 ) - if (Failed()) return; - - ! Give verbose info on what we are reading - if (NWTC_VerboseLevel == NWTC_Verbose) THEN - call WrScr( ' Heading of the ServoDyn input file: ' ) - call WrScr( ' '//trim( FileInfo_In%Lines(2) ) ) - end if - - !------------------------------------------------------------------------------------------------- - ! General settings - !------------------------------------------------------------------------------------------------- - CurLine = 4 ! Skip the first three lines as they are known to be header lines and separators - call ParseVar( FileInfo_In, CurLine, 'Echo', InputFileData%Echo, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - if ( InputFileData%Echo ) then - CALL OpenEcho ( UnEcho, TRIM(OutFileRoot)//'.ech', ErrStat2, ErrMsg2 ) - if (Failed()) return; - WRITE(UnEcho, '(A)') 'Echo file for ServoDyn input file: '//trim(InputFile) - ! Write the first three lines into the echo file - WRITE(UnEcho, '(A)') FileInfo_In%Lines(1) - WRITE(UnEcho, '(A)') FileInfo_In%Lines(2) - WRITE(UnEcho, '(A)') FileInfo_In%Lines(3) - - CurLine = 4 - call ParseVar( FileInfo_In, CurLine, 'Echo', InputFileData%Echo, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return - endif - - ! DT - Communication interval for controllers (s) (or "default") - call ParseVarWDefault ( FileInfo_In, CurLine, 'DT', InputFileData%DT, Default_DT, ErrStat2, ErrMsg2, UnEcho ) - - - !---------------------- PITCH CONTROL ------------------------------------------- - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - ! PCMode (switch) - Pitch control mode { 0: none - ! 3: user-defined from routine PitchCntrl, - ! 4: user-defined from Simulink/Labview - ! 5: user-defined from Bladed-style DLL} (switch) - call ParseVar( FileInfo_In, CurLine, 'PCMode', InputFileData%PCMode, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! TPCOn - Time to enable active pitch control (s) [unused when PCMode=0] - call ParseVar( FileInfo_In, CurLine, 'TPCOn', InputFileData%TPCOn, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - - ! TPitManS - Time to start override pitch maneuver for blade 1 and end standard pitch control (s) - do i=1,size(InputFileData%TPitManS) - TmpChr='TPitManS('//trim(Num2LStr(i))//')' - call ParseVar( FileInfo_In, CurLine, trim(TmpChr), InputFileData%TPitManS(i), ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - enddo - - ! PitManRat - Pitch rate at which override pitch maneuver heads toward final pitch angle for blade 1 (deg/s) - do i=1,size(InputFileData%PitManRat) - TmpChr='PitManRat('//trim(Num2LStr(i))//')' - call ParseVar( FileInfo_In, CurLine, trim(TmpChr), InputFileData%PitManRat(i), ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - enddo - InputFileData%PitManRat = InputFileData%PitManRat*D2R - - ! BlPitchF - Blade 1 final pitch for pitch maneuvers (degrees) - do i=1,size(InputFileData%BlPitchF) - TmpChr='BlPitchF('//trim(Num2LStr(i))//')' - call ParseVar( FileInfo_In, CurLine, trim(TmpChr), InputFileData%BlPitchF(i), ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - enddo - InputFileData%BlPitchF = InputFileData%BlPitchF*D2R - - - !---------------------- GENERATOR AND TORQUE CONTROL ---------------------------- - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - ! VSContrl (switch) - Variable-speed control mode { - ! 0: none - ! 1: simple VS, - ! 3: user-defined from routine UserVSCont, - ! 4: user-defined from Simulink/Labview, - ! 5: user-defined from Bladed-style DLL} - call ParseVar( FileInfo_In, CurLine, 'VSContrl', InputFileData%VSContrl, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! GenModel - Generator model {1: simple, 2: Thevenin, 3: user-defined from routine UserGen} (switch) [used only when VSContrl=0] - call ParseVar( FileInfo_In, CurLine, 'GenModel', InputFileData%GenModel, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! GenEff - Generator efficiency [ignored by the Thevenin and user-defined generator models] ( - call ParseVar( FileInfo_In, CurLine, 'GenEff', InputFileData%GenEff, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%GenEff = InputFileData%GenEff*0.01 - ! GenTiStr - Method to start the generator {T: timed using TimGenOn, F: generator speed using SpdGenOn} (flag) - call ParseVar( FileInfo_In, CurLine, 'GenTiStr', InputFileData%GenTiStr, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! GenTiStp - Method to stop the generator {T: timed using TimGenOf, F: when generator power = 0} (flag) - call ParseVar( FileInfo_In, CurLine, 'GenTiStp', InputFileData%GenTiStp, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! SpdGenOn - Generator speed to turn on the generator for a startup (HSS speed) (rpm) [used only when GenTiStr=False] - call ParseVar( FileInfo_In, CurLine, 'SpdGenOn', InputFileData%SpdGenOn, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%SpdGenOn = InputFileData%SpdGenOn*RPM2RPS - ! TimGenOn - Time to turn on the generator for a startup (s) [used only when GenTiStr=True] - call ParseVar( FileInfo_In, CurLine, 'TimGenOn', InputFileData%TimGenOn, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! TimGenOf - Time to turn off the generator (s) [used only when GenTiStp=True] - call ParseVar( FileInfo_In, CurLine, 'TimGenOf', InputFileData%TimGenOf, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - - - !---------------------- SIMPLE VARIABLE-SPEED TORQUE CONTROL -------------------- - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - ! VS_RtGnSp - Rated generator speed for simple variable-speed generator control (HSS side) (rpm) [used only when VSContrl=1] - call ParseVar( FileInfo_In, CurLine, 'VS_RtGnSp', InputFileData%VS_RtGnSp, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%VS_RtGnSp = InputFileData%VS_RtGnSp*RPM2RPS - ! VS_RtTq - Rated generator torque/constant generator torque in Region 3 for simple variable-speed generator control (HSS side) (N-m) [used only when VSContrl=1] - call ParseVar( FileInfo_In, CurLine, 'VS_RtTq', InputFileData%VS_RtTq, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! VS_Rgn2K - Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) (N-m/rpm^2) [used only when VSContrl=1] - call ParseVar( FileInfo_In, CurLine, 'VS_Rgn2K', InputFileData%VS_Rgn2K, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%VS_Rgn2K = InputFileData%VS_Rgn2K/( RPM2RPS**2 ) - ! VS_SlPc - Rated generator slip percentage in Region 2 1/2 for simple variable-speed generator control ( - call ParseVar( FileInfo_In, CurLine, 'VS_SlPc', InputFileData%VS_SlPc, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%VS_SlPc = InputFileData%VS_SlPc*.01 - - - !---------------------- SIMPLE INDUCTION GENERATOR ------------------------------ - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - ! SIG_SlPc - Rated generator slip percentage ( - call ParseVar( FileInfo_In, CurLine, 'SIG_SlPc', InputFileData%SIG_SlPc, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%SIG_SlPc = InputFileData%SIG_SlPc*.01 - ! SIG_SySp - Synchronous (zero-torque) generator speed (rpm) [used only when VSContrl=0 and GenModel=1] - call ParseVar( FileInfo_In, CurLine, 'SIG_SySp', InputFileData%SIG_SySp, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%SIG_SySp = InputFileData%SIG_SySp*RPM2RPS - ! SIG_RtTq - Rated torque (N-m) [used only when VSContrl=0 and GenModel=1] - call ParseVar( FileInfo_In, CurLine, 'SIG_RtTq', InputFileData%SIG_RtTq, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! SIG_PORt - Pull-out ratio (Tpullout/Trated) (-) [used only when VSContrl=0 and GenModel=1] - call ParseVar( FileInfo_In, CurLine, 'SIG_PORt', InputFileData%SIG_PORt, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - - - !---------------------- THEVENIN-EQUIVALENT INDUCTION GENERATOR ----------------- - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - ! TEC_Freq - Line frequency [50 or 60] (Hz) [used only when VSContrl=0 and GenModel=2] - call ParseVar( FileInfo_In, CurLine, 'TEC_Freq', InputFileData%TEC_Freq, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! TEC_NPol - Number of poles [even integer > 0] (-) [used only when VSContrl=0 and GenModel=2] - call ParseVar( FileInfo_In, CurLine, 'TEC_NPol', InputFileData%TEC_NPol, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! TEC_SRes - Stator resistance (ohms) [used only when VSContrl=0 and GenModel=2] - call ParseVar( FileInfo_In, CurLine, 'TEC_SRes', InputFileData%TEC_SRes, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! TEC_RRes - Rotor resistance (ohms) [used only when VSContrl=0 and GenModel=2] - call ParseVar( FileInfo_In, CurLine, 'TEC_RRes', InputFileData%TEC_RRes, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! TEC_VLL - Line-to-line RMS voltage (volts) [used only when VSContrl=0 and GenModel=2] - call ParseVar( FileInfo_In, CurLine, 'TEC_VLL', InputFileData%TEC_VLL, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! TEC_SLR - Stator leakage reactance (ohms) [used only when VSContrl=0 and GenModel=2] - call ParseVar( FileInfo_In, CurLine, 'TEC_SLR', InputFileData%TEC_SLR, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! TEC_RLR - Rotor leakage reactance (ohms) [used only when VSContrl=0 and GenModel=2] - call ParseVar( FileInfo_In, CurLine, 'TEC_RLR', InputFileData%TEC_RLR, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! TEC_MR - Magnetizing reactance (ohms) [used only when VSContrl=0 and GenModel=2] - call ParseVar( FileInfo_In, CurLine, 'TEC_MR', InputFileData%TEC_MR, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - - - !---------------------- HIGH-SPEED SHAFT BRAKE ---------------------------------- - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - ! HSSBrMode (switch) - HSS brake model { - ! 0: none, - ! 1: simple, - ! 3: user-defined from routine UserHSSBr, - ! 4: user-defined from Simulink/Labview, - ! 5: user-defined from Bladed-style DLL} - call ParseVar( FileInfo_In, CurLine, 'HSSBrMode', InputFileData%HSSBrMode, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! THSSBrDp - Time to initiate deployment of the HSS brake (s) - call ParseVar( FileInfo_In, CurLine, 'THSSBrDp', InputFileData%THSSBrDp, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! HSSBrDT - Time for HSS-brake to reach full deployment once initiated (sec) [used only when HSSBrMode=1] - call ParseVar( FileInfo_In, CurLine, 'HSSBrDT', InputFileData%HSSBrDT, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! HSSBrTqF - Fully deployed HSS-brake torque (N-m) - call ParseVar( FileInfo_In, CurLine, 'HSSBrTqF', InputFileData%HSSBrTqF, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - - - !---------------------- YAW CONTROL --------------------------------------------- - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - ! YCMode (switch) - Yaw control mode { - ! 0: none, - ! 3: user-defined from routine UserYawCont, - ! 4: user-defined from Simulink/Labview, - ! 5: user-defined from Bladed-style DLL} - call ParseVar( FileInfo_In, CurLine, 'YCMode', InputFileData%YCMode, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! TYCOn - Time to enable active yaw control (s) [unused when YCMode=0] - call ParseVar( FileInfo_In, CurLine, 'TYCOn', InputFileData%TYCOn, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! YawNeut - Neutral yaw position--yaw spring force is zero at this yaw (degrees) - call ParseVar( FileInfo_In, CurLine, 'YawNeut', InputFileData%YawNeut, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%YawNeut = InputFileData%YawNeut*D2R - ! YawSpr - Nacelle-yaw spring constant (N-m/rad) - call ParseVar( FileInfo_In, CurLine, 'YawSpr', InputFileData%YawSpr, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! YawDamp - Nacelle-yaw damping constant (N-m/(rad/s)) - call ParseVar( FileInfo_In, CurLine, 'YawDamp', InputFileData%YawDamp, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! TYawManS - Time to start override yaw maneuver and end standard yaw control (s) - call ParseVar( FileInfo_In, CurLine, 'TYawManS', InputFileData%TYawManS, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! YawManRat - Yaw maneuver rate (in absolute value) (deg/s) - call ParseVar( FileInfo_In, CurLine, 'YawManRat', InputFileData%YawManRat, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%YawManRat = InputFileData%YawManRat*D2R - ! NacYawF - Final yaw angle for override yaw maneuvers (degrees) - call ParseVar( FileInfo_In, CurLine, 'NacYawF', InputFileData%NacYawF, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%NacYawF = InputFileData%NacYawF*D2R - - - !---------------------- TUNED MASS DAMPER ---------------------------------------- - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - ! NumBStC - Number of blade structural controllers (integer) - call ParseVar( FileInfo_In, CurLine, 'NumBStC', InputFileData%NumBStC, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! BStCfiles - Name of the files for blade structural controllers (quoted strings) [unused when NumBStC==0] - call AllocAry( InputFileData%BStCfiles, InputFileData%NumBStC, 'BStCfile', ErrStat2, ErrMsg2 ) - if (Failed()) return; - call ParseAry( FileInfo_In, CurLine, 'BStCfile', InputFileData%BStCfiles, InputFileData%NumBStC, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - do i=1,InputFileData%NumBStC - if ( PathIsRelative( InputFileData%BStCfiles(i) ) ) InputFileData%BStCfiles(i) = TRIM(PriPath)//TRIM(InputFileData%BStCfiles(i)) - enddo - - ! NumNStC - Number of nacelle structural controllers (integer) - call ParseVar( FileInfo_In, CurLine, 'NumNStC', InputFileData%NumNStC, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! NStCfiles - Name of the files for nacelle structural controllers (quoted strings) [unused when NumNStC==0] - call AllocAry( InputFileData%NStCfiles, InputFileData%NumNStC, 'NStCfile', ErrStat2, ErrMsg2 ) - if (Failed()) return; - call ParseAry( FileInfo_In, CurLine, 'NStCfile', InputFileData%NStCfiles, InputFileData%NumNStC, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - do i=1,InputFileData%NumNStC - if ( PathIsRelative( InputFileData%NStCfiles(i) ) ) InputFileData%NStCfiles(i) = TRIM(PriPath)//TRIM(InputFileData%NStCfiles(i)) - enddo - - ! NumTStC - Number of tower structural controllers (integer) - call ParseVar( FileInfo_In, CurLine, 'NumTStC', InputFileData%NumTStC, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! TStCfiles - Name of the files for tower structural controllers (quoted strings) [unused when NumTStC==0] - call AllocAry( InputFileData%TStCfiles, InputFileData%NumTStC, 'TStCfile', ErrStat2, ErrMsg2 ) - if (Failed()) return; - call ParseAry( FileInfo_In, CurLine, 'TStCfile', InputFileData%TStCfiles, InputFileData%NumTStC, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - do i=1,InputFileData%NumTStC - if ( PathIsRelative( InputFileData%TStCfiles(i) ) ) InputFileData%TStCfiles(i) = TRIM(PriPath)//TRIM(InputFileData%TStCfiles(i)) - enddo - - ! NumSStC - Number of platform structural controllers (integer) - call ParseVar( FileInfo_In, CurLine, 'NumSStC', InputFileData%NumSStC, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! SStCfiles - Name of the files for blade structural controllers (quoted strings) [unused when NumSStC==0] - call AllocAry( InputFileData%SStCfiles, InputFileData%NumSStC, 'SStCfile', ErrStat2, ErrMsg2 ) - if (Failed()) return; - call ParseAry( FileInfo_In, CurLine, 'SStCfile', InputFileData%SStCfiles, InputFileData%NumSStC, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - do i=1,InputFileData%NumSStC - if ( PathIsRelative( InputFileData%SStCfiles(i) ) ) InputFileData%SStCfiles(i) = TRIM(PriPath)//TRIM(InputFileData%SStCfiles(i)) - enddo - - - !---------------------- BLADED INTERFACE ---------------------------------------- - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - ! DLL_FileName - Name/location of the dynamic library {.dll [Windows] or .so [Linux]} in the Bladed-DLL format (-) [used only with Bladed Interface] - call ParseVar( FileInfo_In, CurLine, 'DLL_FileName', InputFileData%DLL_FileName, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - IF ( PathIsRelative( InputFileData%DLL_FileName ) ) InputFileData%DLL_FileName = TRIM(PriPath)//TRIM(InputFileData%DLL_FileName) - ! DLL_InFile - Name of input file sent to the DLL (-) [used only with Bladed Interface] - call ParseVar( FileInfo_In, CurLine, 'DLL_InFile', InputFileData%DLL_InFile, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - IF ( PathIsRelative( InputFileData%DLL_InFile ) ) InputFileData%DLL_InFile = TRIM(PriPath)//TRIM(InputFileData%DLL_InFile) - ! DLL_ProcName - Name of procedure in DLL to be called (-) [case sensitive; used only with DLL Interface] - call ParseVar( FileInfo_In, CurLine, 'DLL_ProcName', InputFileData%DLL_ProcName, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! DLL_DT - Communication interval for dynamic library (s) (or "default") [used only with Bladed Interface] - call ParseVarWDefault( FileInfo_In, CurLine, 'DLL_DT', InputFileData%DLL_DT, InputFileData%DT, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! DLL_Ramp - Whether a linear ramp should be used between DLL_DT time steps [introduces time shift when true] (flag) [used only with Bladed Interface] - call ParseVar( FileInfo_In, CurLine, 'DLL_Ramp', InputFileData%DLL_Ramp, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! BPCutoff - Cuttoff frequency for low-pass filter on blade pitch from DLL (Hz) [used only with Bladed Interface] - call ParseVar( FileInfo_In, CurLine, 'BPCutoff', InputFileData%BPCutoff, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! NacYaw_North - Reference yaw angle of the nacelle when the upwind end points due North (deg) [used only with Bladed Interface] - call ParseVar( FileInfo_In, CurLine, 'NacYaw_North', InputFileData%NacYaw_North, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%NacYaw_North = InputFileData%NacYaw_North*D2R - ! Ptch_Cntrl - Record 28: Use individual pitch control {0: collective pitch; 1: individual pitch control} (switch) [used only with Bladed Interface] - call ParseVar( FileInfo_In, CurLine, 'Ptch_Cntrl', InputFileData%Ptch_Cntrl, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! Ptch_SetPnt - Record 5: Below-rated pitch angle set-point (deg) [used only with Bladed Interface] - call ParseVar( FileInfo_In, CurLine, 'Ptch_SetPnt', InputFileData%Ptch_SetPnt, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%Ptch_SetPnt = InputFileData%Ptch_SetPnt*D2R - ! Ptch_Min - Record 6: Minimum pitch angle (deg) [used only with Bladed Interface] - call ParseVar( FileInfo_In, CurLine, 'Ptch_Min', InputFileData%Ptch_Min, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%Ptch_Min = InputFileData%Ptch_Min*D2R - ! Ptch_Max - Record 7: Maximum pitch angle (deg) [used only with Bladed Interface] - call ParseVar( FileInfo_In, CurLine, 'Ptch_Max', InputFileData%Ptch_Max, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%Ptch_Max = InputFileData%Ptch_Max*D2R - ! PtchRate_Min - Record 8: Minimum pitch rate (most negative value allowed) (deg/s) [used only with Bladed Interface] - call ParseVar( FileInfo_In, CurLine, 'PtchRate_Min', InputFileData%PtchRate_Min, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%PtchRate_Min = InputFileData%PtchRate_Min*D2R - ! PtchRate_Max - Record 9: Maximum pitch rate (deg/s) [used only with Bladed Interface] - call ParseVar( FileInfo_In, CurLine, 'PtchRate_Max', InputFileData%PtchRate_Max, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%PtchRate_Max = InputFileData%PtchRate_Max*D2R - ! Gain_OM - Record 16: Optimal mode gain (Nm/(rad/s)^2) [used only with Bladed Interface] - call ParseVar( FileInfo_In, CurLine, 'Gain_OM', InputFileData%Gain_OM, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! GenSpd_MinOM - Record 17: Minimum generator speed (rpm) [used only with Bladed Interface] - call ParseVar( FileInfo_In, CurLine, 'GenSpd_MinOM', InputFileData%GenSpd_MinOM, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%GenSpd_MinOM = InputFileData%GenSpd_MinOM*RPM2RPS - ! GenSpd_MaxOM - Record 18: Optimal mode maximum speed (rpm) [used only with Bladed Interface] - call ParseVar( FileInfo_In, CurLine, 'GenSpd_MaxOM', InputFileData%GenSpd_MaxOM, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%GenSpd_MaxOM = InputFileData%GenSpd_MaxOM*RPM2RPS - ! GenSpd_Dem - Record 19: Demanded generator speed above rated (rpm) [used only with Bladed Interface] - call ParseVar( FileInfo_In, CurLine, 'GenSpd_Dem', InputFileData%GenSpd_Dem, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%GenSpd_Dem = InputFileData%GenSpd_Dem*RPM2RPS - ! GenTrq_Dem - Record 22: Demanded generator torque above rated (Nm) [used only with Bladed Interface] - call ParseVar( FileInfo_In, CurLine, 'GenTrq_Dem', InputFileData%GenTrq_Dem, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! GenPwr_Dem - Record 13: Demanded power (W) [used only with Bladed Interface] - call ParseVar( FileInfo_In, CurLine, 'GenPwr_Dem', InputFileData%GenPwr_Dem, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - - - !---------------------- BLADED INTERFACE TORQUE-SPEED LOOK-UP TABLE ------------- - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - ! NKInpSt - Number of spring force input stations - call ParseVar( FileInfo_In, CurLine, 'DLL_NumTrq', InputFileData%DLL_NumTrq, ErrStat2, ErrMsg2, UnEcho) - if (Failed()) return - ! Section break -- GenSpd_TLU GenTrq_TLU - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') ' Table Header: '//FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') ' Table Units: '//FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - - if (InputFileData%DLL_NumTrq > 0) then - CALL AllocAry( InputFileData%GenSpd_TLU, InputFileData%DLL_NumTrq, 'GenSpd_TLU', ErrStat2, ErrMsg2 ) - if (Failed()) return; - CALL AllocAry( InputFileData%GenTrq_TLU, InputFileData%DLL_NumTrq, 'GenTrq_TLU',ErrStat2, ErrMsg2 ) - if (Failed()) return; - ! TABLE read - do i=1,InputFileData%DLL_NumTrq - call ParseAry ( FileInfo_In, CurLine, 'Coordinates', TmpRe2, 2, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%GenSpd_TLU(i) = TmpRe2(1)*RPM2RPS ! GenSpd_TLU - Records R:2:R+2*DLL_NumTrq-2: Generator speed values in look-up table (rpm) (read from file in rpm and converted to rad/s here) - InputFileData%GenTrq_TLU(i) = TmpRe2(2) ! GenTrq_TLU - Records R+1:2:R+2*DLL_NumTrq-1: Generator torque values in look-up table (Nm) - enddo - endif - - - - !---------------------- OUTPUT -------------------------------------------------- - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - ! SumPrint - Print summary data to .sum (flag) (currently unused) - call ParseVar( FileInfo_In, CurLine, 'SumPrint', InputFileData%SumPrint, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! OutFile - Switch to determine where output will be placed: {1: in module output file only; 2: in glue code output file only; 3: both} (currently unused) - call ParseVar( FileInfo_In, CurLine, 'OutFile', InputFileData%OutFile, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - !PLACEHOLDER: OutFileFmt - Format for module tabular (time-marching) output: (1: text file [.out], 2: binary file [.outb], 3: both): - ! TabDelim - Use tab delimiters in text tabular output file? (flag) (currently unused) - call ParseVar( FileInfo_In, CurLine, 'TabDelim', InputFileData%TabDelim, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! OutFmt - Format used for text tabular output (except time). Resulting field should be 10 characters. (quoted string) (currently unused) - call ParseVar( FileInfo_In, CurLine, 'OutFmt', InputFileData%OutFmt, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - ! TStart - Time to begin tabular output (s) (currently unused) - call ParseVar( FileInfo_In, CurLine, 'TStart', InputFileData%TStart, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - !PLACEHOLDER: DecFact - Decimation factor for module's tabular output (1=output every step) (-): - - !---------------------- OUTLIST -------------------------------------------- - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - call ReadOutputListFromFileInfo( FileInfo_In, CurLine, InputFileData%OutList, & - InputFileData%NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - - - call Cleanup() - return - -contains - !------------------------------------------------------------------------------------------------- - logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - ! This fixes a strange compile issue with gfortran 9.1.0 on Mac where the CurLine and ErrStat end up sharing stack - ! space due to the -fstack_reuse="all" is set for any optimization. Can workaround with -fstack_reuse="none", but - ! have not found any other viable workaround other than using CurLine here in the Failed function - CurLine = CurLine - if (Failed) call Cleanup() - end function Failed - !------------------------------------------------------------------------------------------------- - subroutine Cleanup() - if (UnEcho > -1_IntKi) CLOSE( UnEcho ) - end subroutine Cleanup -end subroutine ParseInputFileInfo -!---------------------------------------------------------------------------------------------------------------------------------- - - - -!********************************************************************************************************************************** -! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" -! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these -! lines should be modified in the Matlab script and/or Excel worksheet as necessary. -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine checks to see if any requested output channel names (stored in the OutList(:)) are invalid. It returns a -!! warning if any of the channels are not available outputs from the module. -!! It assigns the settings for OutParam(:) (i.e, the index, name, and units of the output channels, WriteOutput(:)). -!! the sign is set to 0 if the channel is invalid. -!! It sets assumes the value p%NumOuts has been set before this routine has been called, and it sets the values of p%OutParam here. -!! -!! This routine was generated by Write_ChckOutLst.m using the parameters listed in OutListParameters.xlsx at 04-Feb-2021 08:42:27. -SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) -!.................................................................................................................................. - - IMPLICIT NONE - - ! Passed variables - - CHARACTER(ChanLen), INTENT(IN) :: OutList(:) !< The list out user-requested outputs - TYPE(SrvD_ParameterType), INTENT(INOUT) :: p !< The module parameters - INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error status code - CHARACTER(*), INTENT(OUT) :: ErrMsg !< The error message, if an error occurred - - ! Local variables - - INTEGER :: ErrStat2 ! temporary (local) error status - INTEGER :: I ! Generic loop-counting index - INTEGER :: J ! Generic loop-counting index - INTEGER :: INDX ! Index for valid arrays - - LOGICAL :: CheckOutListAgain ! Flag used to determine if output parameter starting with "M" is valid (or the negative of another parameter) - LOGICAL :: InvalidOutput(0:MaxOutPts) ! This array determines if the output channel is valid for this configuration - CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I) - CHARACTER(*), PARAMETER :: RoutineName = "SetOutParam" - - CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(518) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically - "BLAIRFLC1 ","BLAIRFLC2 ","BLAIRFLC3 ","BLFLAP1 ","BLFLAP2 ","BLFLAP3 ", & - "BLPITCHC1 ","BLPITCHC2 ","BLPITCHC3 ","BSTC1_B1_FXI","BSTC1_B1_FXL","BSTC1_B1_FYI", & - "BSTC1_B1_FYL","BSTC1_B1_FZI","BSTC1_B1_FZL","BSTC1_B1_MXI","BSTC1_B1_MXL","BSTC1_B1_MYI", & - "BSTC1_B1_MYL","BSTC1_B1_MZI","BSTC1_B1_MZL","BSTC1_B1_XQ ","BSTC1_B1_XQD","BSTC1_B1_YQ ", & - "BSTC1_B1_YQD","BSTC1_B1_ZQ ","BSTC1_B1_ZQD","BSTC1_B2_FXI","BSTC1_B2_FXL","BSTC1_B2_FYI", & - "BSTC1_B2_FYL","BSTC1_B2_FZI","BSTC1_B2_FZL","BSTC1_B2_MXI","BSTC1_B2_MXL","BSTC1_B2_MYI", & - "BSTC1_B2_MYL","BSTC1_B2_MZI","BSTC1_B2_MZL","BSTC1_B2_XQ ","BSTC1_B2_XQD","BSTC1_B2_YQ ", & - "BSTC1_B2_YQD","BSTC1_B2_ZQ ","BSTC1_B2_ZQD","BSTC1_B3_FXI","BSTC1_B3_FXL","BSTC1_B3_FYI", & - "BSTC1_B3_FYL","BSTC1_B3_FZI","BSTC1_B3_FZL","BSTC1_B3_MXI","BSTC1_B3_MXL","BSTC1_B3_MYI", & - "BSTC1_B3_MYL","BSTC1_B3_MZI","BSTC1_B3_MZL","BSTC1_B3_XQ ","BSTC1_B3_XQD","BSTC1_B3_YQ ", & - "BSTC1_B3_YQD","BSTC1_B3_ZQ ","BSTC1_B3_ZQD","BSTC1_B4_FXI","BSTC1_B4_FXL","BSTC1_B4_FYI", & - "BSTC1_B4_FYL","BSTC1_B4_FZI","BSTC1_B4_FZL","BSTC1_B4_MXI","BSTC1_B4_MXL","BSTC1_B4_MYI", & - "BSTC1_B4_MYL","BSTC1_B4_MZI","BSTC1_B4_MZL","BSTC1_B4_XQ ","BSTC1_B4_XQD","BSTC1_B4_YQ ", & - "BSTC1_B4_YQD","BSTC1_B4_ZQ ","BSTC1_B4_ZQD","BSTC2_B1_FXI","BSTC2_B1_FXL","BSTC2_B1_FYI", & - "BSTC2_B1_FYL","BSTC2_B1_FZI","BSTC2_B1_FZL","BSTC2_B1_MXI","BSTC2_B1_MXL","BSTC2_B1_MYI", & - "BSTC2_B1_MYL","BSTC2_B1_MZI","BSTC2_B1_MZL","BSTC2_B1_XQ ","BSTC2_B1_XQD","BSTC2_B1_YQ ", & - "BSTC2_B1_YQD","BSTC2_B1_ZQ ","BSTC2_B1_ZQD","BSTC2_B2_FXI","BSTC2_B2_FXL","BSTC2_B2_FYI", & - "BSTC2_B2_FYL","BSTC2_B2_FZI","BSTC2_B2_FZL","BSTC2_B2_MXI","BSTC2_B2_MXL","BSTC2_B2_MYI", & - "BSTC2_B2_MYL","BSTC2_B2_MZI","BSTC2_B2_MZL","BSTC2_B2_XQ ","BSTC2_B2_XQD","BSTC2_B2_YQ ", & - "BSTC2_B2_YQD","BSTC2_B2_ZQ ","BSTC2_B2_ZQD","BSTC2_B3_FXI","BSTC2_B3_FXL","BSTC2_B3_FYI", & - "BSTC2_B3_FYL","BSTC2_B3_FZI","BSTC2_B3_FZL","BSTC2_B3_MXI","BSTC2_B3_MXL","BSTC2_B3_MYI", & - "BSTC2_B3_MYL","BSTC2_B3_MZI","BSTC2_B3_MZL","BSTC2_B3_XQ ","BSTC2_B3_XQD","BSTC2_B3_YQ ", & - "BSTC2_B3_YQD","BSTC2_B3_ZQ ","BSTC2_B3_ZQD","BSTC2_B4_FXI","BSTC2_B4_FXL","BSTC2_B4_FYI", & - "BSTC2_B4_FYL","BSTC2_B4_FZI","BSTC2_B4_FZL","BSTC2_B4_MXI","BSTC2_B4_MXL","BSTC2_B4_MYI", & - "BSTC2_B4_MYL","BSTC2_B4_MZI","BSTC2_B4_MZL","BSTC2_B4_XQ ","BSTC2_B4_XQD","BSTC2_B4_YQ ", & - "BSTC2_B4_YQD","BSTC2_B4_ZQ ","BSTC2_B4_ZQD","BSTC3_B1_FXI","BSTC3_B1_FXL","BSTC3_B1_FYI", & - "BSTC3_B1_FYL","BSTC3_B1_FZI","BSTC3_B1_FZL","BSTC3_B1_MXI","BSTC3_B1_MXL","BSTC3_B1_MYI", & - "BSTC3_B1_MYL","BSTC3_B1_MZI","BSTC3_B1_MZL","BSTC3_B1_XQ ","BSTC3_B1_XQD","BSTC3_B1_YQ ", & - "BSTC3_B1_YQD","BSTC3_B1_ZQ ","BSTC3_B1_ZQD","BSTC3_B2_FXI","BSTC3_B2_FXL","BSTC3_B2_FYI", & - "BSTC3_B2_FYL","BSTC3_B2_FZI","BSTC3_B2_FZL","BSTC3_B2_MXI","BSTC3_B2_MXL","BSTC3_B2_MYI", & - "BSTC3_B2_MYL","BSTC3_B2_MZI","BSTC3_B2_MZL","BSTC3_B2_XQ ","BSTC3_B2_XQD","BSTC3_B2_YQ ", & - "BSTC3_B2_YQD","BSTC3_B2_ZQ ","BSTC3_B2_ZQD","BSTC3_B3_FXI","BSTC3_B3_FXL","BSTC3_B3_FYI", & - "BSTC3_B3_FYL","BSTC3_B3_FZI","BSTC3_B3_FZL","BSTC3_B3_MXI","BSTC3_B3_MXL","BSTC3_B3_MYI", & - "BSTC3_B3_MYL","BSTC3_B3_MZI","BSTC3_B3_MZL","BSTC3_B3_XQ ","BSTC3_B3_XQD","BSTC3_B3_YQ ", & - "BSTC3_B3_YQD","BSTC3_B3_ZQ ","BSTC3_B3_ZQD","BSTC3_B4_FXI","BSTC3_B4_FXL","BSTC3_B4_FYI", & - "BSTC3_B4_FYL","BSTC3_B4_FZI","BSTC3_B4_FZL","BSTC3_B4_MXI","BSTC3_B4_MXL","BSTC3_B4_MYI", & - "BSTC3_B4_MYL","BSTC3_B4_MZI","BSTC3_B4_MZL","BSTC3_B4_XQ ","BSTC3_B4_XQD","BSTC3_B4_YQ ", & - "BSTC3_B4_YQD","BSTC3_B4_ZQ ","BSTC3_B4_ZQD","BSTC4_B1_FXI","BSTC4_B1_FXL","BSTC4_B1_FYI", & - "BSTC4_B1_FYL","BSTC4_B1_FZI","BSTC4_B1_FZL","BSTC4_B1_MXI","BSTC4_B1_MXL","BSTC4_B1_MYI", & - "BSTC4_B1_MYL","BSTC4_B1_MZI","BSTC4_B1_MZL","BSTC4_B1_XQ ","BSTC4_B1_XQD","BSTC4_B1_YQ ", & - "BSTC4_B1_YQD","BSTC4_B1_ZQ ","BSTC4_B1_ZQD","BSTC4_B2_FXI","BSTC4_B2_FXL","BSTC4_B2_FYI", & - "BSTC4_B2_FYL","BSTC4_B2_FZI","BSTC4_B2_FZL","BSTC4_B2_MXI","BSTC4_B2_MXL","BSTC4_B2_MYI", & - "BSTC4_B2_MYL","BSTC4_B2_MZI","BSTC4_B2_MZL","BSTC4_B2_XQ ","BSTC4_B2_XQD","BSTC4_B2_YQ ", & - "BSTC4_B2_YQD","BSTC4_B2_ZQ ","BSTC4_B2_ZQD","BSTC4_B3_FXI","BSTC4_B3_FXL","BSTC4_B3_FYI", & - "BSTC4_B3_FYL","BSTC4_B3_FZI","BSTC4_B3_FZL","BSTC4_B3_MXI","BSTC4_B3_MXL","BSTC4_B3_MYI", & - "BSTC4_B3_MYL","BSTC4_B3_MZI","BSTC4_B3_MZL","BSTC4_B3_XQ ","BSTC4_B3_XQD","BSTC4_B3_YQ ", & - "BSTC4_B3_YQD","BSTC4_B3_ZQ ","BSTC4_B3_ZQD","BSTC4_B4_FXI","BSTC4_B4_FXL","BSTC4_B4_FYI", & - "BSTC4_B4_FYL","BSTC4_B4_FZI","BSTC4_B4_FZL","BSTC4_B4_MXI","BSTC4_B4_MXL","BSTC4_B4_MYI", & - "BSTC4_B4_MYL","BSTC4_B4_MZI","BSTC4_B4_MZL","BSTC4_B4_XQ ","BSTC4_B4_XQD","BSTC4_B4_YQ ", & - "BSTC4_B4_YQD","BSTC4_B4_ZQ ","BSTC4_B4_ZQD","GENPWR ","GENTQ ","HSSBRTQC ", & - "NSTC1_FXI ","NSTC1_FXL ","NSTC1_FYI ","NSTC1_FYL ","NSTC1_FZI ","NSTC1_FZL ", & - "NSTC1_MXI ","NSTC1_MXL ","NSTC1_MYI ","NSTC1_MYL ","NSTC1_MZI ","NSTC1_MZL ", & - "NSTC1_XQ ","NSTC1_XQD ","NSTC1_YQ ","NSTC1_YQD ","NSTC1_ZQ ","NSTC1_ZQD ", & - "NSTC2_FXI ","NSTC2_FXL ","NSTC2_FYI ","NSTC2_FYL ","NSTC2_FZI ","NSTC2_FZL ", & - "NSTC2_MXI ","NSTC2_MXL ","NSTC2_MYI ","NSTC2_MYL ","NSTC2_MZI ","NSTC2_MZL ", & - "NSTC2_XQ ","NSTC2_XQD ","NSTC2_YQ ","NSTC2_YQD ","NSTC2_ZQ ","NSTC2_ZQD ", & - "NSTC3_FXI ","NSTC3_FXL ","NSTC3_FYI ","NSTC3_FYL ","NSTC3_FZI ","NSTC3_FZL ", & - "NSTC3_MXI ","NSTC3_MXL ","NSTC3_MYI ","NSTC3_MYL ","NSTC3_MZI ","NSTC3_MZL ", & - "NSTC3_XQ ","NSTC3_XQD ","NSTC3_YQ ","NSTC3_YQD ","NSTC3_ZQ ","NSTC3_ZQD ", & - "NSTC4_FXI ","NSTC4_FXL ","NSTC4_FYI ","NSTC4_FYL ","NSTC4_FZI ","NSTC4_FZL ", & - "NSTC4_MXI ","NSTC4_MXL ","NSTC4_MYI ","NSTC4_MYL ","NSTC4_MZI ","NSTC4_MZL ", & - "NSTC4_XQ ","NSTC4_XQD ","NSTC4_YQ ","NSTC4_YQD ","NSTC4_ZQ ","NSTC4_ZQD ", & - "SSTC1_FXI ","SSTC1_FXL ","SSTC1_FYI ","SSTC1_FYL ","SSTC1_FZI ","SSTC1_FZL ", & - "SSTC1_MXI ","SSTC1_MXL ","SSTC1_MYI ","SSTC1_MYL ","SSTC1_MZI ","SSTC1_MZL ", & - "SSTC1_XQ ","SSTC1_XQD ","SSTC1_YQ ","SSTC1_YQD ","SSTC1_ZQ ","SSTC1_ZQD ", & - "SSTC2_FXI ","SSTC2_FXL ","SSTC2_FYI ","SSTC2_FYL ","SSTC2_FZI ","SSTC2_FZL ", & - "SSTC2_MXI ","SSTC2_MXL ","SSTC2_MYI ","SSTC2_MYL ","SSTC2_MZI ","SSTC2_MZL ", & - "SSTC2_XQ ","SSTC2_XQD ","SSTC2_YQ ","SSTC2_YQD ","SSTC2_ZQ ","SSTC2_ZQD ", & - "SSTC3_FXI ","SSTC3_FXL ","SSTC3_FYI ","SSTC3_FYL ","SSTC3_FZI ","SSTC3_FZL ", & - "SSTC3_MXI ","SSTC3_MXL ","SSTC3_MYI ","SSTC3_MYL ","SSTC3_MZI ","SSTC3_MZL ", & - "SSTC3_XQ ","SSTC3_XQD ","SSTC3_YQ ","SSTC3_YQD ","SSTC3_ZQ ","SSTC3_ZQD ", & - "SSTC4_FXI ","SSTC4_FXL ","SSTC4_FYI ","SSTC4_FYL ","SSTC4_FZI ","SSTC4_FZL ", & - "SSTC4_MXI ","SSTC4_MXL ","SSTC4_MYI ","SSTC4_MYL ","SSTC4_MZI ","SSTC4_MZL ", & - "SSTC4_XQ ","SSTC4_XQD ","SSTC4_YQ ","SSTC4_YQD ","SSTC4_ZQ ","SSTC4_ZQD ", & - "TSTC1_FXI ","TSTC1_FXL ","TSTC1_FYI ","TSTC1_FYL ","TSTC1_FZI ","TSTC1_FZL ", & - "TSTC1_MXI ","TSTC1_MXL ","TSTC1_MYI ","TSTC1_MYL ","TSTC1_MZI ","TSTC1_MZL ", & - "TSTC1_XQ ","TSTC1_XQD ","TSTC1_YQ ","TSTC1_YQD ","TSTC1_ZQ ","TSTC1_ZQD ", & - "TSTC2_FXI ","TSTC2_FXL ","TSTC2_FYI ","TSTC2_FYL ","TSTC2_FZI ","TSTC2_FZL ", & - "TSTC2_MXI ","TSTC2_MXL ","TSTC2_MYI ","TSTC2_MYL ","TSTC2_MZI ","TSTC2_MZL ", & - "TSTC2_XQ ","TSTC2_XQD ","TSTC2_YQ ","TSTC2_YQD ","TSTC2_ZQ ","TSTC2_ZQD ", & - "TSTC3_FXI ","TSTC3_FXL ","TSTC3_FYI ","TSTC3_FYL ","TSTC3_FZI ","TSTC3_FZL ", & - "TSTC3_MXI ","TSTC3_MXL ","TSTC3_MYI ","TSTC3_MYL ","TSTC3_MZI ","TSTC3_MZL ", & - "TSTC3_XQ ","TSTC3_XQD ","TSTC3_YQ ","TSTC3_YQD ","TSTC3_ZQ ","TSTC3_ZQD ", & - "TSTC4_FXI ","TSTC4_FXL ","TSTC4_FYI ","TSTC4_FYL ","TSTC4_FZI ","TSTC4_FZL ", & - "TSTC4_MXI ","TSTC4_MXL ","TSTC4_MYI ","TSTC4_MYL ","TSTC4_MZI ","TSTC4_MZL ", & - "TSTC4_XQ ","TSTC4_XQD ","TSTC4_YQ ","TSTC4_YQD ","TSTC4_ZQ ","TSTC4_ZQD ", & - "YAWMOM ","YAWMOMCOM "/) - INTEGER(IntKi), PARAMETER :: ParamIndxAry(518) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) - BlAirFlC1 , BlAirFlC2 , BlAirFlC3 , BlAirFlC1 , BlAirFlC2 , BlAirFlC3 , & - BlPitchC1 , BlPitchC2 , BlPitchC3 , BStC1_B1_Fxi , BStC1_B1_Fxl , BStC1_B1_Fyi , & - BStC1_B1_Fyl , BStC1_B1_Fzi , BStC1_B1_Fzl , BStC1_B1_Mxi , BStC1_B1_Mxl , BStC1_B1_Myi , & - BStC1_B1_Myl , BStC1_B1_Mzi , BStC1_B1_Mzl , BStC1_B1_XQ , BStC1_B1_XQD , BStC1_B1_YQ , & - BStC1_B1_YQD , BStC1_B1_ZQ , BStC1_B1_ZQD , BStC1_B2_Fxi , BStC1_B2_Fxl , BStC1_B2_Fyi , & - BStC1_B2_Fyl , BStC1_B2_Fzi , BStC1_B2_Fzl , BStC1_B2_Mxi , BStC1_B2_Mxl , BStC1_B2_Myi , & - BStC1_B2_Myl , BStC1_B2_Mzi , BStC1_B2_Mzl , BStC1_B2_XQ , BStC1_B2_XQD , BStC1_B2_YQ , & - BStC1_B2_YQD , BStC1_B2_ZQ , BStC1_B2_ZQD , BStC1_B3_Fxi , BStC1_B3_Fxl , BStC1_B3_Fyi , & - BStC1_B3_Fyl , BStC1_B3_Fzi , BStC1_B3_Fzl , BStC1_B3_Mxi , BStC1_B3_Mxl , BStC1_B3_Myi , & - BStC1_B3_Myl , BStC1_B3_Mzi , BStC1_B3_Mzl , BStC1_B3_XQ , BStC1_B3_XQD , BStC1_B3_YQ , & - BStC1_B3_YQD , BStC1_B3_ZQ , BStC1_B3_ZQD , BStC1_B4_Fxi , BStC1_B4_Fxl , BStC1_B4_Fyi , & - BStC1_B4_Fyl , BStC1_B4_Fzi , BStC1_B4_Fzl , BStC1_B4_Mxi , BStC1_B4_Mxl , BStC1_B4_Myi , & - BStC1_B4_Myl , BStC1_B4_Mzi , BStC1_B4_Mzl , BStC1_B4_XQ , BStC1_B4_XQD , BStC1_B4_YQ , & - BStC1_B4_YQD , BStC1_B4_ZQ , BStC1_B4_ZQD , BStC2_B1_Fxi , BStC2_B1_Fxl , BStC2_B1_Fyi , & - BStC2_B1_Fyl , BStC2_B1_Fzi , BStC2_B1_Fzl , BStC2_B1_Mxi , BStC2_B1_Mxl , BStC2_B1_Myi , & - BStC2_B1_Myl , BStC2_B1_Mzi , BStC2_B1_Mzl , BStC2_B1_XQ , BStC2_B1_XQD , BStC2_B1_YQ , & - BStC2_B1_YQD , BStC2_B1_ZQ , BStC2_B1_ZQD , BStC2_B2_Fxi , BStC2_B2_Fxl , BStC2_B2_Fyi , & - BStC2_B2_Fyl , BStC2_B2_Fzi , BStC2_B2_Fzl , BStC2_B2_Mxi , BStC2_B2_Mxl , BStC2_B2_Myi , & - BStC2_B2_Myl , BStC2_B2_Mzi , BStC2_B2_Mzl , BStC2_B2_XQ , BStC2_B2_XQD , BStC2_B2_YQ , & - BStC2_B2_YQD , BStC2_B2_ZQ , BStC2_B2_ZQD , BStC2_B3_Fxi , BStC2_B3_Fxl , BStC2_B3_Fyi , & - BStC2_B3_Fyl , BStC2_B3_Fzi , BStC2_B3_Fzl , BStC2_B3_Mxi , BStC2_B3_Mxl , BStC2_B3_Myi , & - BStC2_B3_Myl , BStC2_B3_Mzi , BStC2_B3_Mzl , BStC2_B3_XQ , BStC2_B3_XQD , BStC2_B3_YQ , & - BStC2_B3_YQD , BStC2_B3_ZQ , BStC2_B3_ZQD , BStC2_B4_Fxi , BStC2_B4_Fxl , BStC2_B4_Fyi , & - BStC2_B4_Fyl , BStC2_B4_Fzi , BStC2_B4_Fzl , BStC2_B4_Mxi , BStC2_B4_Mxl , BStC2_B4_Myi , & - BStC2_B4_Myl , BStC2_B4_Mzi , BStC2_B4_Mzl , BStC2_B4_XQ , BStC2_B4_XQD , BStC2_B4_YQ , & - BStC2_B4_YQD , BStC2_B4_ZQ , BStC2_B4_ZQD , BStC3_B1_Fxi , BStC3_B1_Fxl , BStC3_B1_Fyi , & - BStC3_B1_Fyl , BStC3_B1_Fzi , BStC3_B1_Fzl , BStC3_B1_Mxi , BStC3_B1_Mxl , BStC3_B1_Myi , & - BStC3_B1_Myl , BStC3_B1_Mzi , BStC3_B1_Mzl , BStC3_B1_XQ , BStC3_B1_XQD , BStC3_B1_YQ , & - BStC3_B1_YQD , BStC3_B1_ZQ , BStC3_B1_ZQD , BStC3_B2_Fxi , BStC3_B2_Fxl , BStC3_B2_Fyi , & - BStC3_B2_Fyl , BStC3_B2_Fzi , BStC3_B2_Fzl , BStC3_B2_Mxi , BStC3_B2_Mxl , BStC3_B2_Myi , & - BStC3_B2_Myl , BStC3_B2_Mzi , BStC3_B2_Mzl , BStC3_B2_XQ , BStC3_B2_XQD , BStC3_B2_YQ , & - BStC3_B2_YQD , BStC3_B2_ZQ , BStC3_B2_ZQD , BStC3_B3_Fxi , BStC3_B3_Fxl , BStC3_B3_Fyi , & - BStC3_B3_Fyl , BStC3_B3_Fzi , BStC3_B3_Fzl , BStC3_B3_Mxi , BStC3_B3_Mxl , BStC3_B3_Myi , & - BStC3_B3_Myl , BStC3_B3_Mzi , BStC3_B3_Mzl , BStC3_B3_XQ , BStC3_B3_XQD , BStC3_B3_YQ , & - BStC3_B3_YQD , BStC3_B3_ZQ , BStC3_B3_ZQD , BStC3_B4_Fxi , BStC3_B4_Fxl , BStC3_B4_Fyi , & - BStC3_B4_Fyl , BStC3_B4_Fzi , BStC3_B4_Fzl , BStC3_B4_Mxi , BStC3_B4_Mxl , BStC3_B4_Myi , & - BStC3_B4_Myl , BStC3_B4_Mzi , BStC3_B4_Mzl , BStC3_B4_XQ , BStC3_B4_XQD , BStC3_B4_YQ , & - BStC3_B4_YQD , BStC3_B4_ZQ , BStC3_B4_ZQD , BStC4_B1_Fxi , BStC4_B1_Fxl , BStC4_B1_Fyi , & - BStC4_B1_Fyl , BStC4_B1_Fzi , BStC4_B1_Fzl , BStC4_B1_Mxi , BStC4_B1_Mxl , BStC4_B1_Myi , & - BStC4_B1_Myl , BStC4_B1_Mzi , BStC4_B1_Mzl , BStC4_B1_XQ , BStC4_B1_XQD , BStC4_B1_YQ , & - BStC4_B1_YQD , BStC4_B1_ZQ , BStC4_B1_ZQD , BStC4_B2_Fxi , BStC4_B2_Fxl , BStC4_B2_Fyi , & - BStC4_B2_Fyl , BStC4_B2_Fzi , BStC4_B2_Fzl , BStC4_B2_Mxi , BStC4_B2_Mxl , BStC4_B2_Myi , & - BStC4_B2_Myl , BStC4_B2_Mzi , BStC4_B2_Mzl , BStC4_B2_XQ , BStC4_B2_XQD , BStC4_B2_YQ , & - BStC4_B2_YQD , BStC4_B2_ZQ , BStC4_B2_ZQD , BStC4_B3_Fxi , BStC4_B3_Fxl , BStC4_B3_Fyi , & - BStC4_B3_Fyl , BStC4_B3_Fzi , BStC4_B3_Fzl , BStC4_B3_Mxi , BStC4_B3_Mxl , BStC4_B3_Myi , & - BStC4_B3_Myl , BStC4_B3_Mzi , BStC4_B3_Mzl , BStC4_B3_XQ , BStC4_B3_XQD , BStC4_B3_YQ , & - BStC4_B3_YQD , BStC4_B3_ZQ , BStC4_B3_ZQD , BStC4_B4_Fxi , BStC4_B4_Fxl , BStC4_B4_Fyi , & - BStC4_B4_Fyl , BStC4_B4_Fzi , BStC4_B4_Fzl , BStC4_B4_Mxi , BStC4_B4_Mxl , BStC4_B4_Myi , & - BStC4_B4_Myl , BStC4_B4_Mzi , BStC4_B4_Mzl , BStC4_B4_XQ , BStC4_B4_XQD , BStC4_B4_YQ , & - BStC4_B4_YQD , BStC4_B4_ZQ , BStC4_B4_ZQD , GenPwr , GenTq , HSSBrTqC , & - NStC1_Fxi , NStC1_Fxl , NStC1_Fyi , NStC1_Fyl , NStC1_Fzi , NStC1_Fzl , & - NStC1_Mxi , NStC1_Mxl , NStC1_Myi , NStC1_Myl , NStC1_Mzi , NStC1_Mzl , & - NStC1_XQ , NStC1_XQD , NStC1_YQ , NStC1_YQD , NStC1_ZQ , NStC1_ZQD , & - NStC2_Fxi , NStC2_Fxl , NStC2_Fyi , NStC2_Fyl , NStC2_Fzi , NStC2_Fzl , & - NStC2_Mxi , NStC2_Mxl , NStC2_Myi , NStC2_Myl , NStC2_Mzi , NStC2_Mzl , & - NStC2_XQ , NStC2_XQD , NStC2_YQ , NStC2_YQD , NStC2_ZQ , NStC2_ZQD , & - NStC3_Fxi , NStC3_Fxl , NStC3_Fyi , NStC3_Fyl , NStC3_Fzi , NStC3_Fzl , & - NStC3_Mxi , NStC3_Mxl , NStC3_Myi , NStC3_Myl , NStC3_Mzi , NStC3_Mzl , & - NStC3_XQ , NStC3_XQD , NStC3_YQ , NStC3_YQD , NStC3_ZQ , NStC3_ZQD , & - NStC4_Fxi , NStC4_Fxl , NStC4_Fyi , NStC4_Fyl , NStC4_Fzi , NStC4_Fzl , & - NStC4_Mxi , NStC4_Mxl , NStC4_Myi , NStC4_Myl , NStC4_Mzi , NStC4_Mzl , & - NStC4_XQ , NStC4_XQD , NStC4_YQ , NStC4_YQD , NStC4_ZQ , NStC4_ZQD , & - SStC1_Fxi , SStC1_Fxl , SStC1_Fyi , SStC1_Fyl , SStC1_Fzi , SStC1_Fzl , & - SStC1_Mxi , SStC1_Mxl , SStC1_Myi , SStC1_Myl , SStC1_Mzi , SStC1_Mzl , & - SStC1_XQ , SStC1_XQD , SStC1_YQ , SStC1_YQD , SStC1_ZQ , SStC1_ZQD , & - SStC2_Fxi , SStC2_Fxl , SStC2_Fyi , SStC2_Fyl , SStC2_Fzi , SStC2_Fzl , & - SStC2_Mxi , SStC2_Mxl , SStC2_Myi , SStC2_Myl , SStC2_Mzi , SStC2_Mzl , & - SStC2_XQ , SStC2_XQD , SStC2_YQ , SStC2_YQD , SStC2_ZQ , SStC2_ZQD , & - SStC3_Fxi , SStC3_Fxl , SStC3_Fyi , SStC3_Fyl , SStC3_Fzi , SStC3_Fzl , & - SStC3_Mxi , SStC3_Mxl , SStC3_Myi , SStC3_Myl , SStC3_Mzi , SStC3_Mzl , & - SStC3_XQ , SStC3_XQD , SStC3_YQ , SStC3_YQD , SStC3_ZQ , SStC3_ZQD , & - SStC4_Fxi , SStC4_Fxl , SStC4_Fyi , SStC4_Fyl , SStC4_Fzi , SStC4_Fzl , & - SStC4_Mxi , SStC4_Mxl , SStC4_Myi , SStC4_Myl , SStC4_Mzi , SStC4_Mzl , & - SStC4_XQ , SStC4_XQD , SStC4_YQ , SStC4_YQD , SStC4_ZQ , SStC4_ZQD , & - TStC1_Fxi , TStC1_Fxl , TStC1_Fyi , TStC1_Fyl , TStC1_Fzi , TStC1_Fzl , & - TStC1_Mxi , TStC1_Mxl , TStC1_Myi , TStC1_Myl , TStC1_Mzi , TStC1_Mzl , & - TStC1_XQ , TStC1_XQD , TStC1_YQ , TStC1_YQD , TStC1_ZQ , TStC1_ZQD , & - TStC2_Fxi , TStC2_Fxl , TStC2_Fyi , TStC2_Fyl , TStC2_Fzi , TStC2_Fzl , & - TStC2_Mxi , TStC2_Mxl , TStC2_Myi , TStC2_Myl , TStC2_Mzi , TStC2_Mzl , & - TStC2_XQ , TStC2_XQD , TStC2_YQ , TStC2_YQD , TStC2_ZQ , TStC2_ZQD , & - TStC3_Fxi , TStC3_Fxl , TStC3_Fyi , TStC3_Fyl , TStC3_Fzi , TStC3_Fzl , & - TStC3_Mxi , TStC3_Mxl , TStC3_Myi , TStC3_Myl , TStC3_Mzi , TStC3_Mzl , & - TStC3_XQ , TStC3_XQD , TStC3_YQ , TStC3_YQD , TStC3_ZQ , TStC3_ZQD , & - TStC4_Fxi , TStC4_Fxl , TStC4_Fyi , TStC4_Fyl , TStC4_Fzi , TStC4_Fzl , & - TStC4_Mxi , TStC4_Mxl , TStC4_Myi , TStC4_Myl , TStC4_Mzi , TStC4_Mzl , & - TStC4_XQ , TStC4_XQD , TStC4_YQ , TStC4_YQD , TStC4_ZQ , TStC4_ZQD , & - YawMomCom , YawMomCom /) - CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(518) = (/ & ! This lists the units corresponding to the allowed parameters - "(-) ","(-) ","(-) ","(-) ","(-) ","(-) ", & - "(deg) ","(deg) ","(deg) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN-m)","(kN-m)","(kN-m)", & - "(kN-m)","(kN-m)","(kN-m)","(m) ","(m/s) ","(m) ", & - "(m/s) ","(m) ","(m/s) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN-m)","(kN-m)","(kN-m)", & - "(kN-m)","(kN-m)","(kN-m)","(m) ","(m/s) ","(m) ", & - "(m/s) ","(m) ","(m/s) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN-m)","(kN-m)","(kN-m)", & - "(kN-m)","(kN-m)","(kN-m)","(m) ","(m/s) ","(m) ", & - "(m/s) ","(m) ","(m/s) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN-m)","(kN-m)","(kN-m)", & - "(kN-m)","(kN-m)","(kN-m)","(m) ","(m/s) ","(m) ", & - "(m/s) ","(m) ","(m/s) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN-m)","(kN-m)","(kN-m)", & - "(kN-m)","(kN-m)","(kN-m)","(m) ","(m/s) ","(m) ", & - "(m/s) ","(m) ","(m/s) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN-m)","(kN-m)","(kN-m)", & - "(kN-m)","(kN-m)","(kN-m)","(m) ","(m/s) ","(m) ", & - "(m/s) ","(m) ","(m/s) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN-m)","(kN-m)","(kN-m)", & - "(kN-m)","(kN-m)","(kN-m)","(m) ","(m/s) ","(m) ", & - "(m/s) ","(m) ","(m/s) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN-m)","(kN-m)","(kN-m)", & - "(kN-m)","(kN-m)","(kN-m)","(m) ","(m/s) ","(m) ", & - "(m/s) ","(m) ","(m/s) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN-m)","(kN-m)","(kN-m)", & - "(kN-m)","(kN-m)","(kN-m)","(m) ","(m/s) ","(m) ", & - "(m/s) ","(m) ","(m/s) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN-m)","(kN-m)","(kN-m)", & - "(kN-m)","(kN-m)","(kN-m)","(m) ","(m/s) ","(m) ", & - "(m/s) ","(m) ","(m/s) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN-m)","(kN-m)","(kN-m)", & - "(kN-m)","(kN-m)","(kN-m)","(m) ","(m/s) ","(m) ", & - "(m/s) ","(m) ","(m/s) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN-m)","(kN-m)","(kN-m)", & - "(kN-m)","(kN-m)","(kN-m)","(m) ","(m/s) ","(m) ", & - "(m/s) ","(m) ","(m/s) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN-m)","(kN-m)","(kN-m)", & - "(kN-m)","(kN-m)","(kN-m)","(m) ","(m/s) ","(m) ", & - "(m/s) ","(m) ","(m/s) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN-m)","(kN-m)","(kN-m)", & - "(kN-m)","(kN-m)","(kN-m)","(m) ","(m/s) ","(m) ", & - "(m/s) ","(m) ","(m/s) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN-m)","(kN-m)","(kN-m)", & - "(kN-m)","(kN-m)","(kN-m)","(m) ","(m/s) ","(m) ", & - "(m/s) ","(m) ","(m/s) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN-m)","(kN-m)","(kN-m)", & - "(kN-m)","(kN-m)","(kN-m)","(m) ","(m/s) ","(m) ", & - "(m/s) ","(m) ","(m/s) ","(kW) ","(kN-m)","(kN-m)", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)", & - "(m) ","(m/s) ","(m) ","(m/s) ","(m) ","(m/s) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)", & - "(m) ","(m/s) ","(m) ","(m/s) ","(m) ","(m/s) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)", & - "(m) ","(m/s) ","(m) ","(m/s) ","(m) ","(m/s) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)", & - "(m) ","(m/s) ","(m) ","(m/s) ","(m) ","(m/s) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)", & - "(m) ","(m/s) ","(m) ","(m/s) ","(m) ","(m/s) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)", & - "(m) ","(m/s) ","(m) ","(m/s) ","(m) ","(m/s) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)", & - "(m) ","(m/s) ","(m) ","(m/s) ","(m) ","(m/s) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)", & - "(m) ","(m/s) ","(m) ","(m/s) ","(m) ","(m/s) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)", & - "(m) ","(m/s) ","(m) ","(m/s) ","(m) ","(m/s) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)", & - "(m) ","(m/s) ","(m) ","(m/s) ","(m) ","(m/s) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)", & - "(m) ","(m/s) ","(m) ","(m/s) ","(m) ","(m/s) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)","(kN-m)", & - "(m) ","(m/s) ","(m) ","(m/s) ","(m) ","(m/s) ", & - "(kN-m)","(kN-m)"/) - - - ! Initialize values - ErrStat = ErrID_None - ErrMsg = "" - InvalidOutput = .FALSE. - - - ! Determine which inputs are not valid - - InvalidOutput( BlAirFlC3) = ( p%NumBl < 3 ) - InvalidOutput( BlPitchC3) = ( p%NumBl < 3 ) - InvalidOutput( NStC1_XQ) = ( p%NumNStC<1 ) - InvalidOutput( NStC1_XQD) = ( p%NumNStC<1 ) - InvalidOutput( NStC1_YQ) = ( p%NumNStC<1 ) - InvalidOutput( NStC1_YQD) = ( p%NumNStC<1 ) - InvalidOutput( NStC1_ZQ) = ( p%NumNStC<1 ) - InvalidOutput( NStC1_ZQD) = ( p%NumNStC<1 ) - InvalidOutput( NStC1_Fxi) = ( p%NumNStC<1 ) - InvalidOutput( NStC1_Fyi) = ( p%NumNStC<1 ) - InvalidOutput( NStC1_Fzi) = ( p%NumNStC<1 ) - InvalidOutput( NStC1_Mxi) = ( p%NumNStC<1 ) - InvalidOutput( NStC1_Myi) = ( p%NumNStC<1 ) - InvalidOutput( NStC1_Mzi) = ( p%NumNStC<1 ) - InvalidOutput( NStC1_Fxl) = ( p%NumNStC<1 ) - InvalidOutput( NStC1_Fyl) = ( p%NumNStC<1 ) - InvalidOutput( NStC1_Fzl) = ( p%NumNStC<1 ) - InvalidOutput( NStC1_Mxl) = ( p%NumNStC<1 ) - InvalidOutput( NStC1_Myl) = ( p%NumNStC<1 ) - InvalidOutput( NStC1_Mzl) = ( p%NumNStC<1 ) - InvalidOutput( NStC2_XQ) = ( p%NumNStC<2 ) - InvalidOutput( NStC2_XQD) = ( p%NumNStC<2 ) - InvalidOutput( NStC2_YQ) = ( p%NumNStC<2 ) - InvalidOutput( NStC2_YQD) = ( p%NumNStC<2 ) - InvalidOutput( NStC2_ZQ) = ( p%NumNStC<2 ) - InvalidOutput( NStC2_ZQD) = ( p%NumNStC<2 ) - InvalidOutput( NStC2_Fxi) = ( p%NumNStC<2 ) - InvalidOutput( NStC2_Fyi) = ( p%NumNStC<2 ) - InvalidOutput( NStC2_Fzi) = ( p%NumNStC<2 ) - InvalidOutput( NStC2_Mxi) = ( p%NumNStC<2 ) - InvalidOutput( NStC2_Myi) = ( p%NumNStC<2 ) - InvalidOutput( NStC2_Mzi) = ( p%NumNStC<2 ) - InvalidOutput( NStC2_Fxl) = ( p%NumNStC<2 ) - InvalidOutput( NStC2_Fyl) = ( p%NumNStC<2 ) - InvalidOutput( NStC2_Fzl) = ( p%NumNStC<2 ) - InvalidOutput( NStC2_Mxl) = ( p%NumNStC<2 ) - InvalidOutput( NStC2_Myl) = ( p%NumNStC<2 ) - InvalidOutput( NStC2_Mzl) = ( p%NumNStC<2 ) - InvalidOutput( NStC3_XQ) = ( p%NumNStC<3 ) - InvalidOutput( NStC3_XQD) = ( p%NumNStC<3 ) - InvalidOutput( NStC3_YQ) = ( p%NumNStC<3 ) - InvalidOutput( NStC3_YQD) = ( p%NumNStC<3 ) - InvalidOutput( NStC3_ZQ) = ( p%NumNStC<3 ) - InvalidOutput( NStC3_ZQD) = ( p%NumNStC<3 ) - InvalidOutput( NStC3_Fxi) = ( p%NumNStC<3 ) - InvalidOutput( NStC3_Fyi) = ( p%NumNStC<3 ) - InvalidOutput( NStC3_Fzi) = ( p%NumNStC<3 ) - InvalidOutput( NStC3_Mxi) = ( p%NumNStC<3 ) - InvalidOutput( NStC3_Myi) = ( p%NumNStC<3 ) - InvalidOutput( NStC3_Mzi) = ( p%NumNStC<3 ) - InvalidOutput( NStC3_Fxl) = ( p%NumNStC<3 ) - InvalidOutput( NStC3_Fyl) = ( p%NumNStC<3 ) - InvalidOutput( NStC3_Fzl) = ( p%NumNStC<3 ) - InvalidOutput( NStC3_Mxl) = ( p%NumNStC<3 ) - InvalidOutput( NStC3_Myl) = ( p%NumNStC<3 ) - InvalidOutput( NStC3_Mzl) = ( p%NumNStC<3 ) - InvalidOutput( NStC4_XQ) = ( p%NumNStC<4 ) - InvalidOutput( NStC4_XQD) = ( p%NumNStC<4 ) - InvalidOutput( NStC4_YQ) = ( p%NumNStC<4 ) - InvalidOutput( NStC4_YQD) = ( p%NumNStC<4 ) - InvalidOutput( NStC4_ZQ) = ( p%NumNStC<4 ) - InvalidOutput( NStC4_ZQD) = ( p%NumNStC<4 ) - InvalidOutput( NStC4_Fxi) = ( p%NumNStC<4 ) - InvalidOutput( NStC4_Fyi) = ( p%NumNStC<4 ) - InvalidOutput( NStC4_Fzi) = ( p%NumNStC<4 ) - InvalidOutput( NStC4_Mxi) = ( p%NumNStC<4 ) - InvalidOutput( NStC4_Myi) = ( p%NumNStC<4 ) - InvalidOutput( NStC4_Mzi) = ( p%NumNStC<4 ) - InvalidOutput( NStC4_Fxl) = ( p%NumNStC<4 ) - InvalidOutput( NStC4_Fyl) = ( p%NumNStC<4 ) - InvalidOutput( NStC4_Fzl) = ( p%NumNStC<4 ) - InvalidOutput( NStC4_Mxl) = ( p%NumNStC<4 ) - InvalidOutput( NStC4_Myl) = ( p%NumNStC<4 ) - InvalidOutput( NStC4_Mzl) = ( p%NumNStC<4 ) - InvalidOutput( TStC1_XQ) = ( p%NumTStC<1 ) - InvalidOutput( TStC1_XQD) = ( p%NumTStC<1 ) - InvalidOutput( TStC1_YQ) = ( p%NumTStC<1 ) - InvalidOutput( TStC1_YQD) = ( p%NumTStC<1 ) - InvalidOutput( TStC1_ZQ) = ( p%NumTStC<1 ) - InvalidOutput( TStC1_ZQD) = ( p%NumTStC<1 ) - InvalidOutput( TStC1_Fxi) = ( p%NumTStC<1 ) - InvalidOutput( TStC1_Fyi) = ( p%NumTStC<1 ) - InvalidOutput( TStC1_Fzi) = ( p%NumTStC<1 ) - InvalidOutput( TStC1_Mxi) = ( p%NumTStC<1 ) - InvalidOutput( TStC1_Myi) = ( p%NumTStC<1 ) - InvalidOutput( TStC1_Mzi) = ( p%NumTStC<1 ) - InvalidOutput( TStC1_Fxl) = ( p%NumTStC<1 ) - InvalidOutput( TStC1_Fyl) = ( p%NumTStC<1 ) - InvalidOutput( TStC1_Fzl) = ( p%NumTStC<1 ) - InvalidOutput( TStC1_Mxl) = ( p%NumTStC<1 ) - InvalidOutput( TStC1_Myl) = ( p%NumTStC<1 ) - InvalidOutput( TStC1_Mzl) = ( p%NumTStC<1 ) - InvalidOutput( TStC2_XQ) = ( p%NumTStC<2 ) - InvalidOutput( TStC2_XQD) = ( p%NumTStC<2 ) - InvalidOutput( TStC2_YQ) = ( p%NumTStC<2 ) - InvalidOutput( TStC2_YQD) = ( p%NumTStC<2 ) - InvalidOutput( TStC2_ZQ) = ( p%NumTStC<2 ) - InvalidOutput( TStC2_ZQD) = ( p%NumTStC<2 ) - InvalidOutput( TStC2_Fxi) = ( p%NumTStC<2 ) - InvalidOutput( TStC2_Fyi) = ( p%NumTStC<2 ) - InvalidOutput( TStC2_Fzi) = ( p%NumTStC<2 ) - InvalidOutput( TStC2_Mxi) = ( p%NumTStC<2 ) - InvalidOutput( TStC2_Myi) = ( p%NumTStC<2 ) - InvalidOutput( TStC2_Mzi) = ( p%NumTStC<2 ) - InvalidOutput( TStC2_Fxl) = ( p%NumTStC<2 ) - InvalidOutput( TStC2_Fyl) = ( p%NumTStC<2 ) - InvalidOutput( TStC2_Fzl) = ( p%NumTStC<2 ) - InvalidOutput( TStC2_Mxl) = ( p%NumTStC<2 ) - InvalidOutput( TStC2_Myl) = ( p%NumTStC<2 ) - InvalidOutput( TStC2_Mzl) = ( p%NumTStC<2 ) - InvalidOutput( TStC3_XQ) = ( p%NumTStC<3 ) - InvalidOutput( TStC3_XQD) = ( p%NumTStC<3 ) - InvalidOutput( TStC3_YQ) = ( p%NumTStC<3 ) - InvalidOutput( TStC3_YQD) = ( p%NumTStC<3 ) - InvalidOutput( TStC3_ZQ) = ( p%NumTStC<3 ) - InvalidOutput( TStC3_ZQD) = ( p%NumTStC<3 ) - InvalidOutput( TStC3_Fxi) = ( p%NumTStC<3 ) - InvalidOutput( TStC3_Fyi) = ( p%NumTStC<3 ) - InvalidOutput( TStC3_Fzi) = ( p%NumTStC<3 ) - InvalidOutput( TStC3_Mxi) = ( p%NumTStC<3 ) - InvalidOutput( TStC3_Myi) = ( p%NumTStC<3 ) - InvalidOutput( TStC3_Mzi) = ( p%NumTStC<3 ) - InvalidOutput( TStC3_Fxl) = ( p%NumTStC<3 ) - InvalidOutput( TStC3_Fyl) = ( p%NumTStC<3 ) - InvalidOutput( TStC3_Fzl) = ( p%NumTStC<3 ) - InvalidOutput( TStC3_Mxl) = ( p%NumTStC<3 ) - InvalidOutput( TStC3_Myl) = ( p%NumTStC<3 ) - InvalidOutput( TStC3_Mzl) = ( p%NumTStC<3 ) - InvalidOutput( TStC4_XQ) = ( p%NumTStC<4 ) - InvalidOutput( TStC4_XQD) = ( p%NumTStC<4 ) - InvalidOutput( TStC4_YQ) = ( p%NumTStC<4 ) - InvalidOutput( TStC4_YQD) = ( p%NumTStC<4 ) - InvalidOutput( TStC4_ZQ) = ( p%NumTStC<4 ) - InvalidOutput( TStC4_ZQD) = ( p%NumTStC<4 ) - InvalidOutput( TStC4_Fxi) = ( p%NumTStC<4 ) - InvalidOutput( TStC4_Fyi) = ( p%NumTStC<4 ) - InvalidOutput( TStC4_Fzi) = ( p%NumTStC<4 ) - InvalidOutput( TStC4_Mxi) = ( p%NumTStC<4 ) - InvalidOutput( TStC4_Myi) = ( p%NumTStC<4 ) - InvalidOutput( TStC4_Mzi) = ( p%NumTStC<4 ) - InvalidOutput( TStC4_Fxl) = ( p%NumTStC<4 ) - InvalidOutput( TStC4_Fyl) = ( p%NumTStC<4 ) - InvalidOutput( TStC4_Fzl) = ( p%NumTStC<4 ) - InvalidOutput( TStC4_Mxl) = ( p%NumTStC<4 ) - InvalidOutput( TStC4_Myl) = ( p%NumTStC<4 ) - InvalidOutput( TStC4_Mzl) = ( p%NumTStC<4 ) - InvalidOutput( BStC1_B1_XQ) = ( p%NumBStC<1 .or. p%NumBl<1 ) - InvalidOutput(BStC1_B1_XQD) = ( p%NumBStC<1 .or. p%NumBl<1 ) - InvalidOutput( BStC1_B1_YQ) = ( p%NumBStC<1 .or. p%NumBl<1 ) - InvalidOutput(BStC1_B1_YQD) = ( p%NumBStC<1 .or. p%NumBl<1 ) - InvalidOutput( BStC1_B1_ZQ) = ( p%NumBStC<1 .or. p%NumBl<1 ) - InvalidOutput(BStC1_B1_ZQD) = ( p%NumBStC<1 .or. p%NumBl<1 ) - InvalidOutput(BStC1_B1_Fxi) = ( p%NumBStC<1 .or. p%NumBl<1 ) - InvalidOutput(BStC1_B1_Fyi) = ( p%NumBStC<1 .or. p%NumBl<1 ) - InvalidOutput(BStC1_B1_Fzi) = ( p%NumBStC<1 .or. p%NumBl<1 ) - InvalidOutput(BStC1_B1_Mxi) = ( p%NumBStC<1 .or. p%NumBl<1 ) - InvalidOutput(BStC1_B1_Myi) = ( p%NumBStC<1 .or. p%NumBl<1 ) - InvalidOutput(BStC1_B1_Mzi) = ( p%NumBStC<1 .or. p%NumBl<1 ) - InvalidOutput(BStC1_B1_Fxl) = ( p%NumBStC<1 .or. p%NumBl<1 ) - InvalidOutput(BStC1_B1_Fyl) = ( p%NumBStC<1 .or. p%NumBl<1 ) - InvalidOutput(BStC1_B1_Fzl) = ( p%NumBStC<1 .or. p%NumBl<1 ) - InvalidOutput(BStC1_B1_Mxl) = ( p%NumBStC<1 .or. p%NumBl<1 ) - InvalidOutput(BStC1_B1_Myl) = ( p%NumBStC<1 .or. p%NumBl<1 ) - InvalidOutput(BStC1_B1_Mzl) = ( p%NumBStC<1 .or. p%NumBl<1 ) - InvalidOutput( BStC2_B1_XQ) = ( p%NumBStC<2 .or. p%NumBl<1 ) - InvalidOutput(BStC2_B1_XQD) = ( p%NumBStC<2 .or. p%NumBl<1 ) - InvalidOutput( BStC2_B1_YQ) = ( p%NumBStC<2 .or. p%NumBl<1 ) - InvalidOutput(BStC2_B1_YQD) = ( p%NumBStC<2 .or. p%NumBl<1 ) - InvalidOutput( BStC2_B1_ZQ) = ( p%NumBStC<2 .or. p%NumBl<1 ) - InvalidOutput(BStC2_B1_ZQD) = ( p%NumBStC<2 .or. p%NumBl<1 ) - InvalidOutput(BStC2_B1_Fxi) = ( p%NumBStC<2 .or. p%NumBl<1 ) - InvalidOutput(BStC2_B1_Fyi) = ( p%NumBStC<2 .or. p%NumBl<1 ) - InvalidOutput(BStC2_B1_Fzi) = ( p%NumBStC<2 .or. p%NumBl<1 ) - InvalidOutput(BStC2_B1_Mxi) = ( p%NumBStC<2 .or. p%NumBl<1 ) - InvalidOutput(BStC2_B1_Myi) = ( p%NumBStC<2 .or. p%NumBl<1 ) - InvalidOutput(BStC2_B1_Mzi) = ( p%NumBStC<2 .or. p%NumBl<1 ) - InvalidOutput(BStC2_B1_Fxl) = ( p%NumBStC<2 .or. p%NumBl<1 ) - InvalidOutput(BStC2_B1_Fyl) = ( p%NumBStC<2 .or. p%NumBl<1 ) - InvalidOutput(BStC2_B1_Fzl) = ( p%NumBStC<2 .or. p%NumBl<1 ) - InvalidOutput(BStC2_B1_Mxl) = ( p%NumBStC<2 .or. p%NumBl<1 ) - InvalidOutput(BStC2_B1_Myl) = ( p%NumBStC<2 .or. p%NumBl<1 ) - InvalidOutput(BStC2_B1_Mzl) = ( p%NumBStC<2 .or. p%NumBl<1 ) - InvalidOutput( BStC3_B1_XQ) = ( p%NumBStC<3 .or. p%NumBl<1 ) - InvalidOutput(BStC3_B1_XQD) = ( p%NumBStC<3 .or. p%NumBl<1 ) - InvalidOutput( BStC3_B1_YQ) = ( p%NumBStC<3 .or. p%NumBl<1 ) - InvalidOutput(BStC3_B1_YQD) = ( p%NumBStC<3 .or. p%NumBl<1 ) - InvalidOutput( BStC3_B1_ZQ) = ( p%NumBStC<3 .or. p%NumBl<1 ) - InvalidOutput(BStC3_B1_ZQD) = ( p%NumBStC<3 .or. p%NumBl<1 ) - InvalidOutput(BStC3_B1_Fxi) = ( p%NumBStC<3 .or. p%NumBl<1 ) - InvalidOutput(BStC3_B1_Fyi) = ( p%NumBStC<3 .or. p%NumBl<1 ) - InvalidOutput(BStC3_B1_Fzi) = ( p%NumBStC<3 .or. p%NumBl<1 ) - InvalidOutput(BStC3_B1_Mxi) = ( p%NumBStC<3 .or. p%NumBl<1 ) - InvalidOutput(BStC3_B1_Myi) = ( p%NumBStC<3 .or. p%NumBl<1 ) - InvalidOutput(BStC3_B1_Mzi) = ( p%NumBStC<3 .or. p%NumBl<1 ) - InvalidOutput(BStC3_B1_Fxl) = ( p%NumBStC<3 .or. p%NumBl<1 ) - InvalidOutput(BStC3_B1_Fyl) = ( p%NumBStC<3 .or. p%NumBl<1 ) - InvalidOutput(BStC3_B1_Fzl) = ( p%NumBStC<3 .or. p%NumBl<1 ) - InvalidOutput(BStC3_B1_Mxl) = ( p%NumBStC<3 .or. p%NumBl<1 ) - InvalidOutput(BStC3_B1_Myl) = ( p%NumBStC<3 .or. p%NumBl<1 ) - InvalidOutput(BStC3_B1_Mzl) = ( p%NumBStC<3 .or. p%NumBl<1 ) - InvalidOutput( BStC4_B1_XQ) = ( p%NumBStC<4 .or. p%NumBl<1 ) - InvalidOutput(BStC4_B1_XQD) = ( p%NumBStC<4 .or. p%NumBl<1 ) - InvalidOutput( BStC4_B1_YQ) = ( p%NumBStC<4 .or. p%NumBl<1 ) - InvalidOutput(BStC4_B1_YQD) = ( p%NumBStC<4 .or. p%NumBl<1 ) - InvalidOutput( BStC4_B1_ZQ) = ( p%NumBStC<4 .or. p%NumBl<1 ) - InvalidOutput(BStC4_B1_ZQD) = ( p%NumBStC<4 .or. p%NumBl<1 ) - InvalidOutput(BStC4_B1_Fxi) = ( p%NumBStC<4 .or. p%NumBl<1 ) - InvalidOutput(BStC4_B1_Fyi) = ( p%NumBStC<4 .or. p%NumBl<1 ) - InvalidOutput(BStC4_B1_Fzi) = ( p%NumBStC<4 .or. p%NumBl<1 ) - InvalidOutput(BStC4_B1_Mxi) = ( p%NumBStC<4 .or. p%NumBl<1 ) - InvalidOutput(BStC4_B1_Myi) = ( p%NumBStC<4 .or. p%NumBl<1 ) - InvalidOutput(BStC4_B1_Mzi) = ( p%NumBStC<4 .or. p%NumBl<1 ) - InvalidOutput(BStC4_B1_Fxl) = ( p%NumBStC<4 .or. p%NumBl<1 ) - InvalidOutput(BStC4_B1_Fyl) = ( p%NumBStC<4 .or. p%NumBl<1 ) - InvalidOutput(BStC4_B1_Fzl) = ( p%NumBStC<4 .or. p%NumBl<1 ) - InvalidOutput(BStC4_B1_Mxl) = ( p%NumBStC<4 .or. p%NumBl<1 ) - InvalidOutput(BStC4_B1_Myl) = ( p%NumBStC<4 .or. p%NumBl<1 ) - InvalidOutput(BStC4_B1_Mzl) = ( p%NumBStC<4 .or. p%NumBl<1 ) - InvalidOutput( BStC1_B2_XQ) = ( p%NumBStC<1 .or. p%NumBl<2 ) - InvalidOutput(BStC1_B2_XQD) = ( p%NumBStC<1 .or. p%NumBl<2 ) - InvalidOutput( BStC1_B2_YQ) = ( p%NumBStC<1 .or. p%NumBl<2 ) - InvalidOutput(BStC1_B2_YQD) = ( p%NumBStC<1 .or. p%NumBl<2 ) - InvalidOutput( BStC1_B2_ZQ) = ( p%NumBStC<1 .or. p%NumBl<2 ) - InvalidOutput(BStC1_B2_ZQD) = ( p%NumBStC<1 .or. p%NumBl<2 ) - InvalidOutput(BStC1_B2_Fxi) = ( p%NumBStC<1 .or. p%NumBl<2 ) - InvalidOutput(BStC1_B2_Fyi) = ( p%NumBStC<1 .or. p%NumBl<2 ) - InvalidOutput(BStC1_B2_Fzi) = ( p%NumBStC<1 .or. p%NumBl<2 ) - InvalidOutput(BStC1_B2_Mxi) = ( p%NumBStC<1 .or. p%NumBl<2 ) - InvalidOutput(BStC1_B2_Myi) = ( p%NumBStC<1 .or. p%NumBl<2 ) - InvalidOutput(BStC1_B2_Mzi) = ( p%NumBStC<1 .or. p%NumBl<2 ) - InvalidOutput(BStC1_B2_Fxl) = ( p%NumBStC<1 .or. p%NumBl<2 ) - InvalidOutput(BStC1_B2_Fyl) = ( p%NumBStC<1 .or. p%NumBl<2 ) - InvalidOutput(BStC1_B2_Fzl) = ( p%NumBStC<1 .or. p%NumBl<2 ) - InvalidOutput(BStC1_B2_Mxl) = ( p%NumBStC<1 .or. p%NumBl<2 ) - InvalidOutput(BStC1_B2_Myl) = ( p%NumBStC<1 .or. p%NumBl<2 ) - InvalidOutput(BStC1_B2_Mzl) = ( p%NumBStC<1 .or. p%NumBl<2 ) - InvalidOutput( BStC2_B2_XQ) = ( p%NumBStC<2 .or. p%NumBl<2 ) - InvalidOutput(BStC2_B2_XQD) = ( p%NumBStC<2 .or. p%NumBl<2 ) - InvalidOutput( BStC2_B2_YQ) = ( p%NumBStC<2 .or. p%NumBl<2 ) - InvalidOutput(BStC2_B2_YQD) = ( p%NumBStC<2 .or. p%NumBl<2 ) - InvalidOutput( BStC2_B2_ZQ) = ( p%NumBStC<2 .or. p%NumBl<2 ) - InvalidOutput(BStC2_B2_ZQD) = ( p%NumBStC<2 .or. p%NumBl<2 ) - InvalidOutput(BStC2_B2_Fxi) = ( p%NumBStC<2 .or. p%NumBl<2 ) - InvalidOutput(BStC2_B2_Fyi) = ( p%NumBStC<2 .or. p%NumBl<2 ) - InvalidOutput(BStC2_B2_Fzi) = ( p%NumBStC<2 .or. p%NumBl<2 ) - InvalidOutput(BStC2_B2_Mxi) = ( p%NumBStC<2 .or. p%NumBl<2 ) - InvalidOutput(BStC2_B2_Myi) = ( p%NumBStC<2 .or. p%NumBl<2 ) - InvalidOutput(BStC2_B2_Mzi) = ( p%NumBStC<2 .or. p%NumBl<2 ) - InvalidOutput(BStC2_B2_Fxl) = ( p%NumBStC<2 .or. p%NumBl<2 ) - InvalidOutput(BStC2_B2_Fyl) = ( p%NumBStC<2 .or. p%NumBl<2 ) - InvalidOutput(BStC2_B2_Fzl) = ( p%NumBStC<2 .or. p%NumBl<2 ) - InvalidOutput(BStC2_B2_Mxl) = ( p%NumBStC<2 .or. p%NumBl<2 ) - InvalidOutput(BStC2_B2_Myl) = ( p%NumBStC<2 .or. p%NumBl<2 ) - InvalidOutput(BStC2_B2_Mzl) = ( p%NumBStC<2 .or. p%NumBl<2 ) - InvalidOutput( BStC3_B2_XQ) = ( p%NumBStC<3 .or. p%NumBl<2 ) - InvalidOutput(BStC3_B2_XQD) = ( p%NumBStC<3 .or. p%NumBl<2 ) - InvalidOutput( BStC3_B2_YQ) = ( p%NumBStC<3 .or. p%NumBl<2 ) - InvalidOutput(BStC3_B2_YQD) = ( p%NumBStC<3 .or. p%NumBl<2 ) - InvalidOutput( BStC3_B2_ZQ) = ( p%NumBStC<3 .or. p%NumBl<2 ) - InvalidOutput(BStC3_B2_ZQD) = ( p%NumBStC<3 .or. p%NumBl<2 ) - InvalidOutput(BStC3_B2_Fxi) = ( p%NumBStC<3 .or. p%NumBl<2 ) - InvalidOutput(BStC3_B2_Fyi) = ( p%NumBStC<3 .or. p%NumBl<2 ) - InvalidOutput(BStC3_B2_Fzi) = ( p%NumBStC<3 .or. p%NumBl<2 ) - InvalidOutput(BStC3_B2_Mxi) = ( p%NumBStC<3 .or. p%NumBl<2 ) - InvalidOutput(BStC3_B2_Myi) = ( p%NumBStC<3 .or. p%NumBl<2 ) - InvalidOutput(BStC3_B2_Mzi) = ( p%NumBStC<3 .or. p%NumBl<2 ) - InvalidOutput(BStC3_B2_Fxl) = ( p%NumBStC<3 .or. p%NumBl<2 ) - InvalidOutput(BStC3_B2_Fyl) = ( p%NumBStC<3 .or. p%NumBl<2 ) - InvalidOutput(BStC3_B2_Fzl) = ( p%NumBStC<3 .or. p%NumBl<2 ) - InvalidOutput(BStC3_B2_Mxl) = ( p%NumBStC<3 .or. p%NumBl<2 ) - InvalidOutput(BStC3_B2_Myl) = ( p%NumBStC<3 .or. p%NumBl<2 ) - InvalidOutput(BStC3_B2_Mzl) = ( p%NumBStC<3 .or. p%NumBl<2 ) - InvalidOutput( BStC4_B2_XQ) = ( p%NumBStC<4 .or. p%NumBl<2 ) - InvalidOutput(BStC4_B2_XQD) = ( p%NumBStC<4 .or. p%NumBl<2 ) - InvalidOutput( BStC4_B2_YQ) = ( p%NumBStC<4 .or. p%NumBl<2 ) - InvalidOutput(BStC4_B2_YQD) = ( p%NumBStC<4 .or. p%NumBl<2 ) - InvalidOutput( BStC4_B2_ZQ) = ( p%NumBStC<4 .or. p%NumBl<2 ) - InvalidOutput(BStC4_B2_ZQD) = ( p%NumBStC<4 .or. p%NumBl<2 ) - InvalidOutput(BStC4_B2_Fxi) = ( p%NumBStC<4 .or. p%NumBl<2 ) - InvalidOutput(BStC4_B2_Fyi) = ( p%NumBStC<4 .or. p%NumBl<2 ) - InvalidOutput(BStC4_B2_Fzi) = ( p%NumBStC<4 .or. p%NumBl<2 ) - InvalidOutput(BStC4_B2_Mxi) = ( p%NumBStC<4 .or. p%NumBl<2 ) - InvalidOutput(BStC4_B2_Myi) = ( p%NumBStC<4 .or. p%NumBl<2 ) - InvalidOutput(BStC4_B2_Mzi) = ( p%NumBStC<4 .or. p%NumBl<2 ) - InvalidOutput(BStC4_B2_Fxl) = ( p%NumBStC<4 .or. p%NumBl<2 ) - InvalidOutput(BStC4_B2_Fyl) = ( p%NumBStC<4 .or. p%NumBl<2 ) - InvalidOutput(BStC4_B2_Fzl) = ( p%NumBStC<4 .or. p%NumBl<2 ) - InvalidOutput(BStC4_B2_Mxl) = ( p%NumBStC<4 .or. p%NumBl<2 ) - InvalidOutput(BStC4_B2_Myl) = ( p%NumBStC<4 .or. p%NumBl<2 ) - InvalidOutput(BStC4_B2_Mzl) = ( p%NumBStC<4 .or. p%NumBl<2 ) - InvalidOutput( BStC1_B3_XQ) = ( p%NumBStC<1 .or. p%NumBl<3 ) - InvalidOutput(BStC1_B3_XQD) = ( p%NumBStC<1 .or. p%NumBl<3 ) - InvalidOutput( BStC1_B3_YQ) = ( p%NumBStC<1 .or. p%NumBl<3 ) - InvalidOutput(BStC1_B3_YQD) = ( p%NumBStC<1 .or. p%NumBl<3 ) - InvalidOutput( BStC1_B3_ZQ) = ( p%NumBStC<1 .or. p%NumBl<3 ) - InvalidOutput(BStC1_B3_ZQD) = ( p%NumBStC<1 .or. p%NumBl<3 ) - InvalidOutput(BStC1_B3_Fxi) = ( p%NumBStC<1 .or. p%NumBl<3 ) - InvalidOutput(BStC1_B3_Fyi) = ( p%NumBStC<1 .or. p%NumBl<3 ) - InvalidOutput(BStC1_B3_Fzi) = ( p%NumBStC<1 .or. p%NumBl<3 ) - InvalidOutput(BStC1_B3_Mxi) = ( p%NumBStC<1 .or. p%NumBl<3 ) - InvalidOutput(BStC1_B3_Myi) = ( p%NumBStC<1 .or. p%NumBl<3 ) - InvalidOutput(BStC1_B3_Mzi) = ( p%NumBStC<1 .or. p%NumBl<3 ) - InvalidOutput(BStC1_B3_Fxl) = ( p%NumBStC<1 .or. p%NumBl<3 ) - InvalidOutput(BStC1_B3_Fyl) = ( p%NumBStC<1 .or. p%NumBl<3 ) - InvalidOutput(BStC1_B3_Fzl) = ( p%NumBStC<1 .or. p%NumBl<3 ) - InvalidOutput(BStC1_B3_Mxl) = ( p%NumBStC<1 .or. p%NumBl<3 ) - InvalidOutput(BStC1_B3_Myl) = ( p%NumBStC<1 .or. p%NumBl<3 ) - InvalidOutput(BStC1_B3_Mzl) = ( p%NumBStC<1 .or. p%NumBl<3 ) - InvalidOutput( BStC2_B3_XQ) = ( p%NumBStC<2 .or. p%NumBl<3 ) - InvalidOutput(BStC2_B3_XQD) = ( p%NumBStC<2 .or. p%NumBl<3 ) - InvalidOutput( BStC2_B3_YQ) = ( p%NumBStC<2 .or. p%NumBl<3 ) - InvalidOutput(BStC2_B3_YQD) = ( p%NumBStC<2 .or. p%NumBl<3 ) - InvalidOutput( BStC2_B3_ZQ) = ( p%NumBStC<2 .or. p%NumBl<3 ) - InvalidOutput(BStC2_B3_ZQD) = ( p%NumBStC<2 .or. p%NumBl<3 ) - InvalidOutput(BStC2_B3_Fxi) = ( p%NumBStC<2 .or. p%NumBl<3 ) - InvalidOutput(BStC2_B3_Fyi) = ( p%NumBStC<2 .or. p%NumBl<3 ) - InvalidOutput(BStC2_B3_Fzi) = ( p%NumBStC<2 .or. p%NumBl<3 ) - InvalidOutput(BStC2_B3_Mxi) = ( p%NumBStC<2 .or. p%NumBl<3 ) - InvalidOutput(BStC2_B3_Myi) = ( p%NumBStC<2 .or. p%NumBl<3 ) - InvalidOutput(BStC2_B3_Mzi) = ( p%NumBStC<2 .or. p%NumBl<3 ) - InvalidOutput(BStC2_B3_Fxl) = ( p%NumBStC<2 .or. p%NumBl<3 ) - InvalidOutput(BStC2_B3_Fyl) = ( p%NumBStC<2 .or. p%NumBl<3 ) - InvalidOutput(BStC2_B3_Fzl) = ( p%NumBStC<2 .or. p%NumBl<3 ) - InvalidOutput(BStC2_B3_Mxl) = ( p%NumBStC<2 .or. p%NumBl<3 ) - InvalidOutput(BStC2_B3_Myl) = ( p%NumBStC<2 .or. p%NumBl<3 ) - InvalidOutput(BStC2_B3_Mzl) = ( p%NumBStC<2 .or. p%NumBl<3 ) - InvalidOutput( BStC3_B3_XQ) = ( p%NumBStC<3 .or. p%NumBl<3 ) - InvalidOutput(BStC3_B3_XQD) = ( p%NumBStC<3 .or. p%NumBl<3 ) - InvalidOutput( BStC3_B3_YQ) = ( p%NumBStC<3 .or. p%NumBl<3 ) - InvalidOutput(BStC3_B3_YQD) = ( p%NumBStC<3 .or. p%NumBl<3 ) - InvalidOutput( BStC3_B3_ZQ) = ( p%NumBStC<3 .or. p%NumBl<3 ) - InvalidOutput(BStC3_B3_ZQD) = ( p%NumBStC<3 .or. p%NumBl<3 ) - InvalidOutput(BStC3_B3_Fxi) = ( p%NumBStC<3 .or. p%NumBl<3 ) - InvalidOutput(BStC3_B3_Fyi) = ( p%NumBStC<3 .or. p%NumBl<3 ) - InvalidOutput(BStC3_B3_Fzi) = ( p%NumBStC<3 .or. p%NumBl<3 ) - InvalidOutput(BStC3_B3_Mxi) = ( p%NumBStC<3 .or. p%NumBl<3 ) - InvalidOutput(BStC3_B3_Myi) = ( p%NumBStC<3 .or. p%NumBl<3 ) - InvalidOutput(BStC3_B3_Mzi) = ( p%NumBStC<3 .or. p%NumBl<3 ) - InvalidOutput(BStC3_B3_Fxl) = ( p%NumBStC<3 .or. p%NumBl<3 ) - InvalidOutput(BStC3_B3_Fyl) = ( p%NumBStC<3 .or. p%NumBl<3 ) - InvalidOutput(BStC3_B3_Fzl) = ( p%NumBStC<3 .or. p%NumBl<3 ) - InvalidOutput(BStC3_B3_Mxl) = ( p%NumBStC<3 .or. p%NumBl<3 ) - InvalidOutput(BStC3_B3_Myl) = ( p%NumBStC<3 .or. p%NumBl<3 ) - InvalidOutput(BStC3_B3_Mzl) = ( p%NumBStC<3 .or. p%NumBl<3 ) - InvalidOutput( BStC4_B3_XQ) = ( p%NumBStC<4 .or. p%NumBl<3 ) - InvalidOutput(BStC4_B3_XQD) = ( p%NumBStC<4 .or. p%NumBl<3 ) - InvalidOutput( BStC4_B3_YQ) = ( p%NumBStC<4 .or. p%NumBl<3 ) - InvalidOutput(BStC4_B3_YQD) = ( p%NumBStC<4 .or. p%NumBl<3 ) - InvalidOutput( BStC4_B3_ZQ) = ( p%NumBStC<4 .or. p%NumBl<3 ) - InvalidOutput(BStC4_B3_ZQD) = ( p%NumBStC<4 .or. p%NumBl<3 ) - InvalidOutput(BStC4_B3_Fxi) = ( p%NumBStC<4 .or. p%NumBl<3 ) - InvalidOutput(BStC4_B3_Fyi) = ( p%NumBStC<4 .or. p%NumBl<3 ) - InvalidOutput(BStC4_B3_Fzi) = ( p%NumBStC<4 .or. p%NumBl<3 ) - InvalidOutput(BStC4_B3_Mxi) = ( p%NumBStC<4 .or. p%NumBl<3 ) - InvalidOutput(BStC4_B3_Myi) = ( p%NumBStC<4 .or. p%NumBl<3 ) - InvalidOutput(BStC4_B3_Mzi) = ( p%NumBStC<4 .or. p%NumBl<3 ) - InvalidOutput(BStC4_B3_Fxl) = ( p%NumBStC<4 .or. p%NumBl<3 ) - InvalidOutput(BStC4_B3_Fyl) = ( p%NumBStC<4 .or. p%NumBl<3 ) - InvalidOutput(BStC4_B3_Fzl) = ( p%NumBStC<4 .or. p%NumBl<3 ) - InvalidOutput(BStC4_B3_Mxl) = ( p%NumBStC<4 .or. p%NumBl<3 ) - InvalidOutput(BStC4_B3_Myl) = ( p%NumBStC<4 .or. p%NumBl<3 ) - InvalidOutput(BStC4_B3_Mzl) = ( p%NumBStC<4 .or. p%NumBl<3 ) - InvalidOutput( BStC1_B4_XQ) = ( p%NumBStC<1 .or. p%NumBl<4 ) - InvalidOutput(BStC1_B4_XQD) = ( p%NumBStC<1 .or. p%NumBl<4 ) - InvalidOutput( BStC1_B4_YQ) = ( p%NumBStC<1 .or. p%NumBl<4 ) - InvalidOutput(BStC1_B4_YQD) = ( p%NumBStC<1 .or. p%NumBl<4 ) - InvalidOutput( BStC1_B4_ZQ) = ( p%NumBStC<1 .or. p%NumBl<4 ) - InvalidOutput(BStC1_B4_ZQD) = ( p%NumBStC<1 .or. p%NumBl<4 ) - InvalidOutput(BStC1_B4_Fxi) = ( p%NumBStC<1 .or. p%NumBl<4 ) - InvalidOutput(BStC1_B4_Fyi) = ( p%NumBStC<1 .or. p%NumBl<4 ) - InvalidOutput(BStC1_B4_Fzi) = ( p%NumBStC<1 .or. p%NumBl<4 ) - InvalidOutput(BStC1_B4_Mxi) = ( p%NumBStC<1 .or. p%NumBl<4 ) - InvalidOutput(BStC1_B4_Myi) = ( p%NumBStC<1 .or. p%NumBl<4 ) - InvalidOutput(BStC1_B4_Mzi) = ( p%NumBStC<1 .or. p%NumBl<4 ) - InvalidOutput(BStC1_B4_Fxl) = ( p%NumBStC<1 .or. p%NumBl<4 ) - InvalidOutput(BStC1_B4_Fyl) = ( p%NumBStC<1 .or. p%NumBl<4 ) - InvalidOutput(BStC1_B4_Fzl) = ( p%NumBStC<1 .or. p%NumBl<4 ) - InvalidOutput(BStC1_B4_Mxl) = ( p%NumBStC<1 .or. p%NumBl<4 ) - InvalidOutput(BStC1_B4_Myl) = ( p%NumBStC<1 .or. p%NumBl<4 ) - InvalidOutput(BStC1_B4_Mzl) = ( p%NumBStC<1 .or. p%NumBl<4 ) - InvalidOutput( BStC2_B4_XQ) = ( p%NumBStC<2 .or. p%NumBl<4 ) - InvalidOutput(BStC2_B4_XQD) = ( p%NumBStC<2 .or. p%NumBl<4 ) - InvalidOutput( BStC2_B4_YQ) = ( p%NumBStC<2 .or. p%NumBl<4 ) - InvalidOutput(BStC2_B4_YQD) = ( p%NumBStC<2 .or. p%NumBl<4 ) - InvalidOutput( BStC2_B4_ZQ) = ( p%NumBStC<2 .or. p%NumBl<4 ) - InvalidOutput(BStC2_B4_ZQD) = ( p%NumBStC<2 .or. p%NumBl<4 ) - InvalidOutput(BStC2_B4_Fxi) = ( p%NumBStC<2 .or. p%NumBl<4 ) - InvalidOutput(BStC2_B4_Fyi) = ( p%NumBStC<2 .or. p%NumBl<4 ) - InvalidOutput(BStC2_B4_Fzi) = ( p%NumBStC<2 .or. p%NumBl<4 ) - InvalidOutput(BStC2_B4_Mxi) = ( p%NumBStC<2 .or. p%NumBl<4 ) - InvalidOutput(BStC2_B4_Myi) = ( p%NumBStC<2 .or. p%NumBl<4 ) - InvalidOutput(BStC2_B4_Mzi) = ( p%NumBStC<2 .or. p%NumBl<4 ) - InvalidOutput(BStC2_B4_Fxl) = ( p%NumBStC<2 .or. p%NumBl<4 ) - InvalidOutput(BStC2_B4_Fyl) = ( p%NumBStC<2 .or. p%NumBl<4 ) - InvalidOutput(BStC2_B4_Fzl) = ( p%NumBStC<2 .or. p%NumBl<4 ) - InvalidOutput(BStC2_B4_Mxl) = ( p%NumBStC<2 .or. p%NumBl<4 ) - InvalidOutput(BStC2_B4_Myl) = ( p%NumBStC<2 .or. p%NumBl<4 ) - InvalidOutput(BStC2_B4_Mzl) = ( p%NumBStC<2 .or. p%NumBl<4 ) - InvalidOutput( BStC3_B4_XQ) = ( p%NumBStC<3 .or. p%NumBl<4 ) - InvalidOutput(BStC3_B4_XQD) = ( p%NumBStC<3 .or. p%NumBl<4 ) - InvalidOutput( BStC3_B4_YQ) = ( p%NumBStC<3 .or. p%NumBl<4 ) - InvalidOutput(BStC3_B4_YQD) = ( p%NumBStC<3 .or. p%NumBl<4 ) - InvalidOutput( BStC3_B4_ZQ) = ( p%NumBStC<3 .or. p%NumBl<4 ) - InvalidOutput(BStC3_B4_ZQD) = ( p%NumBStC<3 .or. p%NumBl<4 ) - InvalidOutput(BStC3_B4_Fxi) = ( p%NumBStC<3 .or. p%NumBl<4 ) - InvalidOutput(BStC3_B4_Fyi) = ( p%NumBStC<3 .or. p%NumBl<4 ) - InvalidOutput(BStC3_B4_Fzi) = ( p%NumBStC<3 .or. p%NumBl<4 ) - InvalidOutput(BStC3_B4_Mxi) = ( p%NumBStC<3 .or. p%NumBl<4 ) - InvalidOutput(BStC3_B4_Myi) = ( p%NumBStC<3 .or. p%NumBl<4 ) - InvalidOutput(BStC3_B4_Mzi) = ( p%NumBStC<3 .or. p%NumBl<4 ) - InvalidOutput(BStC3_B4_Fxl) = ( p%NumBStC<3 .or. p%NumBl<4 ) - InvalidOutput(BStC3_B4_Fyl) = ( p%NumBStC<3 .or. p%NumBl<4 ) - InvalidOutput(BStC3_B4_Fzl) = ( p%NumBStC<3 .or. p%NumBl<4 ) - InvalidOutput(BStC3_B4_Mxl) = ( p%NumBStC<3 .or. p%NumBl<4 ) - InvalidOutput(BStC3_B4_Myl) = ( p%NumBStC<3 .or. p%NumBl<4 ) - InvalidOutput(BStC3_B4_Mzl) = ( p%NumBStC<3 .or. p%NumBl<4 ) - InvalidOutput( BStC4_B4_XQ) = ( p%NumBStC<4 .or. p%NumBl<4 ) - InvalidOutput(BStC4_B4_XQD) = ( p%NumBStC<4 .or. p%NumBl<4 ) - InvalidOutput( BStC4_B4_YQ) = ( p%NumBStC<4 .or. p%NumBl<4 ) - InvalidOutput(BStC4_B4_YQD) = ( p%NumBStC<4 .or. p%NumBl<4 ) - InvalidOutput( BStC4_B4_ZQ) = ( p%NumBStC<4 .or. p%NumBl<4 ) - InvalidOutput(BStC4_B4_ZQD) = ( p%NumBStC<4 .or. p%NumBl<4 ) - InvalidOutput(BStC4_B4_Fxi) = ( p%NumBStC<4 .or. p%NumBl<4 ) - InvalidOutput(BStC4_B4_Fyi) = ( p%NumBStC<4 .or. p%NumBl<4 ) - InvalidOutput(BStC4_B4_Fzi) = ( p%NumBStC<4 .or. p%NumBl<4 ) - InvalidOutput(BStC4_B4_Mxi) = ( p%NumBStC<4 .or. p%NumBl<4 ) - InvalidOutput(BStC4_B4_Myi) = ( p%NumBStC<4 .or. p%NumBl<4 ) - InvalidOutput(BStC4_B4_Mzi) = ( p%NumBStC<4 .or. p%NumBl<4 ) - InvalidOutput(BStC4_B4_Fxl) = ( p%NumBStC<4 .or. p%NumBl<4 ) - InvalidOutput(BStC4_B4_Fyl) = ( p%NumBStC<4 .or. p%NumBl<4 ) - InvalidOutput(BStC4_B4_Fzl) = ( p%NumBStC<4 .or. p%NumBl<4 ) - InvalidOutput(BStC4_B4_Mxl) = ( p%NumBStC<4 .or. p%NumBl<4 ) - InvalidOutput(BStC4_B4_Myl) = ( p%NumBStC<4 .or. p%NumBl<4 ) - InvalidOutput(BStC4_B4_Mzl) = ( p%NumBStC<4 .or. p%NumBl<4 ) - InvalidOutput( SStC1_XQ) = ( p%NumSStC<1 ) - InvalidOutput( SStC1_XQD) = ( p%NumSStC<1 ) - InvalidOutput( SStC1_YQ) = ( p%NumSStC<1 ) - InvalidOutput( SStC1_YQD) = ( p%NumSStC<1 ) - InvalidOutput( SStC1_ZQ) = ( p%NumSStC<1 ) - InvalidOutput( SStC1_ZQD) = ( p%NumSStC<1 ) - InvalidOutput( SStC1_Fxi) = ( p%NumSStC<1 ) - InvalidOutput( SStC1_Fyi) = ( p%NumSStC<1 ) - InvalidOutput( SStC1_Fzi) = ( p%NumSStC<1 ) - InvalidOutput( SStC1_Mxi) = ( p%NumSStC<1 ) - InvalidOutput( SStC1_Myi) = ( p%NumSStC<1 ) - InvalidOutput( SStC1_Mzi) = ( p%NumSStC<1 ) - InvalidOutput( SStC1_Fxl) = ( p%NumSStC<1 ) - InvalidOutput( SStC1_Fyl) = ( p%NumSStC<1 ) - InvalidOutput( SStC1_Fzl) = ( p%NumSStC<1 ) - InvalidOutput( SStC1_Mxl) = ( p%NumSStC<1 ) - InvalidOutput( SStC1_Myl) = ( p%NumSStC<1 ) - InvalidOutput( SStC1_Mzl) = ( p%NumSStC<1 ) - InvalidOutput( SStC2_XQ) = ( p%NumSStC<2 ) - InvalidOutput( SStC2_XQD) = ( p%NumSStC<2 ) - InvalidOutput( SStC2_YQ) = ( p%NumSStC<2 ) - InvalidOutput( SStC2_YQD) = ( p%NumSStC<2 ) - InvalidOutput( SStC2_ZQ) = ( p%NumSStC<2 ) - InvalidOutput( SStC2_ZQD) = ( p%NumSStC<2 ) - InvalidOutput( SStC2_Fxi) = ( p%NumSStC<2 ) - InvalidOutput( SStC2_Fyi) = ( p%NumSStC<2 ) - InvalidOutput( SStC2_Fzi) = ( p%NumSStC<2 ) - InvalidOutput( SStC2_Mxi) = ( p%NumSStC<2 ) - InvalidOutput( SStC2_Myi) = ( p%NumSStC<2 ) - InvalidOutput( SStC2_Mzi) = ( p%NumSStC<2 ) - InvalidOutput( SStC2_Fxl) = ( p%NumSStC<2 ) - InvalidOutput( SStC2_Fyl) = ( p%NumSStC<2 ) - InvalidOutput( SStC2_Fzl) = ( p%NumSStC<2 ) - InvalidOutput( SStC2_Mxl) = ( p%NumSStC<2 ) - InvalidOutput( SStC2_Myl) = ( p%NumSStC<2 ) - InvalidOutput( SStC2_Mzl) = ( p%NumSStC<2 ) - InvalidOutput( SStC3_XQ) = ( p%NumSStC<3 ) - InvalidOutput( SStC3_XQD) = ( p%NumSStC<3 ) - InvalidOutput( SStC3_YQ) = ( p%NumSStC<3 ) - InvalidOutput( SStC3_YQD) = ( p%NumSStC<3 ) - InvalidOutput( SStC3_ZQ) = ( p%NumSStC<3 ) - InvalidOutput( SStC3_ZQD) = ( p%NumSStC<3 ) - InvalidOutput( SStC3_Fxi) = ( p%NumSStC<3 ) - InvalidOutput( SStC3_Fyi) = ( p%NumSStC<3 ) - InvalidOutput( SStC3_Fzi) = ( p%NumSStC<3 ) - InvalidOutput( SStC3_Mxi) = ( p%NumSStC<3 ) - InvalidOutput( SStC3_Myi) = ( p%NumSStC<3 ) - InvalidOutput( SStC3_Mzi) = ( p%NumSStC<3 ) - InvalidOutput( SStC3_Fxl) = ( p%NumSStC<3 ) - InvalidOutput( SStC3_Fyl) = ( p%NumSStC<3 ) - InvalidOutput( SStC3_Fzl) = ( p%NumSStC<3 ) - InvalidOutput( SStC3_Mxl) = ( p%NumSStC<3 ) - InvalidOutput( SStC3_Myl) = ( p%NumSStC<3 ) - InvalidOutput( SStC3_Mzl) = ( p%NumSStC<3 ) - InvalidOutput( SStC4_XQ) = ( p%NumSStC<4 ) - InvalidOutput( SStC4_XQD) = ( p%NumSStC<4 ) - InvalidOutput( SStC4_YQ) = ( p%NumSStC<4 ) - InvalidOutput( SStC4_YQD) = ( p%NumSStC<4 ) - InvalidOutput( SStC4_ZQ) = ( p%NumSStC<4 ) - InvalidOutput( SStC4_ZQD) = ( p%NumSStC<4 ) - InvalidOutput( SStC4_Fxi) = ( p%NumSStC<4 ) - InvalidOutput( SStC4_Fyi) = ( p%NumSStC<4 ) - InvalidOutput( SStC4_Fzi) = ( p%NumSStC<4 ) - InvalidOutput( SStC4_Mxi) = ( p%NumSStC<4 ) - InvalidOutput( SStC4_Myi) = ( p%NumSStC<4 ) - InvalidOutput( SStC4_Mzi) = ( p%NumSStC<4 ) - InvalidOutput( SStC4_Fxl) = ( p%NumSStC<4 ) - InvalidOutput( SStC4_Fyl) = ( p%NumSStC<4 ) - InvalidOutput( SStC4_Fzl) = ( p%NumSStC<4 ) - InvalidOutput( SStC4_Mxl) = ( p%NumSStC<4 ) - InvalidOutput( SStC4_Myl) = ( p%NumSStC<4 ) - InvalidOutput( SStC4_Mzl) = ( p%NumSStC<4 ) - - - !------------------------------------------------------------------------------------------------- - ! Allocate and set index, name, and units for the output channels - ! If a selected output channel is not available in this module, set error flag. - !------------------------------------------------------------------------------------------------- - - ALLOCATE ( p%OutParam(0:p%NumOuts) , STAT=ErrStat2 ) - IF ( ErrStat2 /= 0_IntKi ) THEN - CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the ServoDyn OutParam array.", ErrStat, ErrMsg, RoutineName ) - RETURN - ENDIF - - ! Set index, name, and units for the time output channel: - - p%OutParam(0)%Indx = Time - p%OutParam(0)%Name = "Time" ! OutParam(0) is the time channel by default. - p%OutParam(0)%Units = "(s)" - p%OutParam(0)%SignM = 1 - - - ! Set index, name, and units for all of the output channels. - ! If a selected output channel is not available by this module set ErrStat = ErrID_Warn. - - DO I = 1,p%NumOuts - - p%OutParam(I)%Name = OutList(I) - OutListTmp = OutList(I) - - ! Reverse the sign (+/-) of the output channel if the user prefixed the - ! channel name with a "-", "_", "m", or "M" character indicating "minus". - - - CheckOutListAgain = .FALSE. - - IF ( INDEX( "-_", OutListTmp(1:1) ) > 0 ) THEN - p%OutParam(I)%SignM = -1 ! ex, "-TipDxc1" causes the sign of TipDxc1 to be switched. - OutListTmp = OutListTmp(2:) - ELSE IF ( INDEX( "mM", OutListTmp(1:1) ) > 0 ) THEN ! We'll assume this is a variable name for now, (if not, we will check later if OutListTmp(2:) is also a variable name) - CheckOutListAgain = .TRUE. - p%OutParam(I)%SignM = 1 - ELSE - p%OutParam(I)%SignM = 1 - END IF - - CALL Conv2UC( OutListTmp ) ! Convert OutListTmp to upper case - - - Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) - - - ! If it started with an "M" (CheckOutListAgain) we didn't find the value in our list (Indx < 1) - - IF ( CheckOutListAgain .AND. Indx < 1 ) THEN ! Let's assume that "M" really meant "minus" and then test again - p%OutParam(I)%SignM = -1 ! ex, "MTipDxc1" causes the sign of TipDxc1 to be switched. - OutListTmp = OutListTmp(2:) - - Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) - END IF - - - IF ( Indx > 0 ) THEN ! we found the channel name - IF ( InvalidOutput( ParamIndxAry(Indx) ) ) THEN ! but, it isn't valid for these settings - p%OutParam(I)%Indx = 0 ! pick any valid channel (I just picked "Time=0" here because it's universal) - p%OutParam(I)%Units = "INVALID" - p%OutParam(I)%SignM = 0 - ELSE - p%OutParam(I)%Indx = ParamIndxAry(Indx) - p%OutParam(I)%Units = ParamUnitsAry(Indx) ! it's a valid output - END IF - ELSE ! this channel isn't valid - p%OutParam(I)%Indx = 0 ! pick any valid channel (I just picked "Time=0" here because it's universal) - p%OutParam(I)%Units = "INVALID" - p%OutParam(I)%SignM = 0 ! multiply all results by zero - - CALL SetErrStat(ErrID_Fatal, TRIM(p%OutParam(I)%Name)//" is not an available output channel.",ErrStat,ErrMsg,RoutineName) - END IF - - END DO - - RETURN -END SUBROUTINE SetOutParam -!---------------------------------------------------------------------------------------------------------------------------------- -!End of code generated by Matlab script -!********************************************************************************************************************************** -END MODULE ServoDyn_IO -!********************************************************************************************************************************** diff --git a/OpenFAST/modules/servodyn/src/ServoDyn_Registry.txt b/OpenFAST/modules/servodyn/src/ServoDyn_Registry.txt deleted file mode 100644 index 527552d2f..000000000 --- a/OpenFAST/modules/servodyn/src/ServoDyn_Registry.txt +++ /dev/null @@ -1,434 +0,0 @@ -################################################################################################################################### -# Registry for ServoDyn in the FAST Modularization Framework -# This Registry file is used to create MODULE ServoDyn_Types which contains all of the user-defined types needed in ServoDyn. -# 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 -usefrom StrucCtrl_Registry.txt - -# ..... Initialization data ....................................................................................................... -# Define inputs that the initialization routine may need here: -typedef ServoDyn/SrvD InitInputType CHARACTER(1024) InputFile - - - "Name of the input file" - -typedef ^ InitInputType Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - -typedef ^ InitInputType IntKi NumBl - - - "Number of blades on the turbine" - -typedef ^ InitInputType CHARACTER(1024) RootName - - - "RootName for writing output files" - -typedef ^ InitInputType ReKi BlPitchInit {:} - - "Initial blade pitch" - -typedef ^ InitInputType ReKi Gravity {3} - - "Gravitational acceleration vector" m/s^2 -typedef ^ InitInputType ReKi NacPosition {3} - - "nacelle origin for setting up mesh" m -typedef ^ InitInputType R8Ki NacOrientation {3}{3} - - "nacelle orientation for setting up mesh" - -typedef ^ InitInputType ReKi TwrBasePos {3} - - "tower base origin for setting up mesh" m -typedef ^ InitInputType R8Ki TwrBaseOrient {3}{3} - - "tower base orientation for setting up mesh" m -typedef ^ InitInputType ReKi PlatformPos {3} - - "platform origin for setting up mesh" m -typedef ^ InitInputType R8Ki PlatformOrient {3}{3} - - "platform orientation for setting up mesh" m -typedef ^ InitInputType DbKi Tmax - - - "max time from glue code" s -typedef ^ InitInputType ReKi AvgWindSpeed - - - "average wind speed for the simulation" m/s -typedef ^ InitInputType ReKi AirDens - - - "air density" kg/m^3 -typedef ^ InitInputType IntKi NumSC2CtrlGlob - - - "number of global controller inputs [from supercontroller]" - -typedef ^ InitInputType IntKi NumSC2Ctrl - - - "number of turbine specific controller inputs [from supercontroller]" - -typedef ^ InitInputType IntKi NumCtrl2SC - - - "number of controller outputs [to supercontroller]" - -typedef ^ InitInputType IntKi TrimCase - - - "Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True]" - -typedef ^ InitInputType ReKi TrimGain - - - "Proportional gain for the rotational speed error (>0) [used only if TrimCase>0]" "rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque" -typedef ^ InitInputType ReKi RotSpeedRef - - - "Reference rotor speed" "rad/s" -typedef ^ InitInputType ReKi BladeRootPosition {:}{:} - - "X-Y-Z reference position of each blade root (3 x NumBlades)" m -typedef ^ InitInputType R8Ki BladeRootOrientation {:}{:}{:} - - "DCM reference orientation of blade roots (3x3 x NumBlades)" - -typedef ^ InitInputType LOGICAL UseInputFile - .TRUE. - "read input from input file" - -typedef ^ InitInputType FileInfoType PassedPrimaryInputData - - - "Primary input file as FileInfoType (set by driver/glue code)" - -#ADD in the TMD submodule input file passing here -typedef ^ InitInputType ReKi fromSCGlob {:} - - "Initial global inputs to the controller [from the supercontroller]" - -typedef ^ InitInputType ReKi fromSC {:} - - "Initial turbine specific inputs to the controller [from the supercontroller]" - - - -# Define outputs from the initialization routine here: -typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - -typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - -typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - -typedef ^ InitOutputType IntKi CouplingScheme - - - "Switch that indicates if a particular coupling scheme is required" - -typedef ^ InitOutputType Logical UseHSSBrake - - - "flag to determine if high-speed shaft brake is potentially used (true=yes)" - -typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - -typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - -typedef ^ InitOutputType LOGICAL RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - -typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - -typedef ^ InitOutputType LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - - -# ..... Input file data ........................................................................................................... -# This is data defined in the Input File for this module (or could otherwise be passed in) -# ..... Primary Input file data ........................................................................................................... -typedef ServoDyn/SrvD SrvD_InputFile DbKi DT - - - "Communication interval for controllers" s -typedef ^ SrvD_InputFile LOGICAL Echo - - - "Echo the input file out" - -typedef ^ SrvD_InputFile IntKi PCMode - - - "Pitch control mode" - -typedef ^ SrvD_InputFile DbKi TPCOn - - - "Time to enable active pitch control [unused when PCMode=0]" s -typedef ^ SrvD_InputFile DbKi TPitManS 3 - - "Time to start override pitch maneuver for blade (K) and end standard pitch control" s -typedef ^ SrvD_InputFile ReKi PitManRat 3 - - "Pitch rates at which override pitch maneuvers head toward final pitch angles" rad/s -typedef ^ SrvD_InputFile ReKi BlPitchF 3 - - "Blade (K) final pitch for pitch maneuvers" radians -typedef ^ SrvD_InputFile IntKi VSContrl - - - "Variable-speed control mode" - -typedef ^ SrvD_InputFile IntKi GenModel - - - "Generator model [used only when VSContrl=0]" - -typedef ^ SrvD_InputFile ReKi GenEff - - - "Generator efficiency [ignored by the Thevenin and user-defined generator models]" - -typedef ^ SrvD_InputFile LOGICAL GenTiStr - - - "Method to start the generator {T: timed using TimGenOn, F: generator speed using SpdGenOn}" - -typedef ^ SrvD_InputFile LOGICAL GenTiStp - - - "Method to stop the generator {T: timed using TimGenOf, F: when generator power = 0}" - -typedef ^ SrvD_InputFile ReKi SpdGenOn - - - "Generator speed to turn on the generator for a startup (HSS speed) [used only when GenTiStr=False]" rad/s -typedef ^ SrvD_InputFile DbKi TimGenOn - - - "Time to turn on the generator for a startup [used only when GenTiStr=True]" s -typedef ^ SrvD_InputFile DbKi TimGenOf - - - "Time to turn off the generator [used only when GenTiStp=True]" s -typedef ^ SrvD_InputFile ReKi VS_RtGnSp - - - "Rated generator speed for simple variable-speed generator control (HSS side) [used only when VSContrl=1]" rad/s -typedef ^ SrvD_InputFile ReKi VS_RtTq - - - "Rated generator torque/constant generator torque in Region 3 for simple variable-speed generator control (HSS side) [used only when VSContrl=1]" N-m -typedef ^ SrvD_InputFile ReKi VS_Rgn2K - - - "Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) [used only when VSContrl=1]" N-m/(rad/s)^2 -typedef ^ SrvD_InputFile ReKi VS_SlPc - - - "Rated generator slip percentage in Region 2 1/2 for simple variable-speed generator control [used only when VSContrl=1]" - -typedef ^ SrvD_InputFile ReKi SIG_SlPc - - - "Rated generator slip percentage [used only when VSContrl=0 and GenModel=1]" - -typedef ^ SrvD_InputFile ReKi SIG_SySp - - - "Synchronous (zero-torque) generator speed [used only when VSContrl=0 and GenModel=1]" rad/s -typedef ^ SrvD_InputFile ReKi SIG_RtTq - - - "Rated torque [used only when VSContrl=0 and GenModel=1]" N-m -typedef ^ SrvD_InputFile ReKi SIG_PORt - - - "Pull-out ratio (Tpullout/Trated) [used only when VSContrl=0 and GenModel=1]" - -typedef ^ SrvD_InputFile ReKi TEC_Freq - - - "Line frequency [50 or 60] [used only when VSContrl=0 and GenModel=2]" Hz -typedef ^ SrvD_InputFile IntKi TEC_NPol - - - "Number of poles [even integer > 0] [used only when VSContrl=0 and GenModel=2]" - -typedef ^ SrvD_InputFile ReKi TEC_SRes - - - "Stator resistance [used only when VSContrl=0 and GenModel=2]" ohms -typedef ^ SrvD_InputFile ReKi TEC_RRes - - - "Rotor resistance [used only when VSContrl=0 and GenModel=2]" ohms -typedef ^ SrvD_InputFile ReKi TEC_VLL - - - "Line-to-line RMS voltage [used only when VSContrl=0 and GenModel=2]" volts -typedef ^ SrvD_InputFile ReKi TEC_SLR - - - "Stator leakage reactance [used only when VSContrl=0 and GenModel=2]" ohms -typedef ^ SrvD_InputFile ReKi TEC_RLR - - - "Rotor leakage reactance [used only when VSContrl=0 and GenModel=2]" ohms -typedef ^ SrvD_InputFile ReKi TEC_MR - - - "Magnetizing reactance [used only when VSContrl=0 and GenModel=2]" ohms -typedef ^ SrvD_InputFile IntKi HSSBrMode - - - "HSS brake model" - -typedef ^ SrvD_InputFile DbKi THSSBrDp - - - "Time to initiate deployment of the HSS brake" s -typedef ^ SrvD_InputFile DbKi HSSBrDT - - - "Time for HSS-brake to reach full deployment once initiated [used only when HSSBrMode=1]" s -typedef ^ SrvD_InputFile ReKi HSSBrTqF - - - "Fully deployed HSS-brake torque" N-m -typedef ^ SrvD_InputFile IntKi YCMode - - - "Yaw control mode" - -typedef ^ SrvD_InputFile DbKi TYCOn - - - "Time to enable active yaw control [unused when YCMode=0]" s -typedef ^ SrvD_InputFile ReKi YawNeut - - - "Neutral yaw position--yaw spring force is zero at this yaw" radians -typedef ^ SrvD_InputFile ReKi YawSpr - - - "Nacelle-yaw spring constant" N-m/rad -typedef ^ SrvD_InputFile ReKi YawDamp - - - "Nacelle-yaw constant" N-m/(rad/s) -typedef ^ SrvD_InputFile DbKi TYawManS - - - "Time to start override yaw maneuver and end standard yaw control" s -typedef ^ SrvD_InputFile ReKi YawManRat - - - "Yaw maneuver rate (in absolute value)" rad/s -typedef ^ SrvD_InputFile ReKi NacYawF - - - "Final yaw angle for override yaw maneuvers" radians -typedef ^ SrvD_InputFile LOGICAL SumPrint - - - "Print summary data to .sum" - -typedef ^ SrvD_InputFile IntKi OutFile - - - "Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both)" - -typedef ^ SrvD_InputFile LOGICAL TabDelim - - - "Use tab delimiters in text tabular output file?" - -typedef ^ SrvD_InputFile CHARACTER(20) OutFmt - - - "Format used for text tabular output (except time)" - -#typedef ^ SrvD_InputFile IntKi OutFileFmt - - - "Format for module tabular (time-marching) output: {1: text file [.out], 2: binary file [.outb], 3: both}" - -typedef ^ SrvD_InputFile DbKi Tstart - - - "Time to start module's tabular output" s -typedef ^ SrvD_InputFile IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - -typedef ^ SrvD_InputFile CHARACTER(ChanLen) OutList {:} - - "List of user-requested output channels" - - -typedef ^ SrvD_InputFile CHARACTER(1024) DLL_FileName - - - "Name of the DLL file including the full path" - -typedef ^ SrvD_InputFile CHARACTER(1024) DLL_ProcName - - - "Name of the procedure in the DLL that will be called" - -typedef ^ SrvD_InputFile CHARACTER(1024) DLL_InFile - - - "Name of input file used in DLL" - -typedef ^ SrvD_InputFile DbKi DLL_DT - - - "interval for calling DLL (must be integer multiple number of DT steps)" s -typedef ^ SrvD_InputFile LOGICAL DLL_Ramp - - - "whether the DLL pitch should be a ramp (true) or step change (false) when DLL_DT <> DT. If true, introduces a time delay." - -typedef ^ SrvD_InputFile ReKi BPCutoff - - - "The cutoff frequency for the blade pitch low-pass filter. Large values => no filter." Hz -typedef ^ SrvD_InputFile ReKi NacYaw_North - - - "Reference yaw angle of the nacelle when the upwind end points due North [used only with DLL Interface]" radians -typedef ^ SrvD_InputFile IntKi Ptch_Cntrl - - - "Record 28: Use individual pitch control {0: collective pitch; 1: individual pitch control} [used only with DLL Interface]" - -typedef ^ SrvD_InputFile ReKi Ptch_SetPnt - - - "Record 5: Below-rated pitch angle set-point [used only with DLL Interface]" radians -typedef ^ SrvD_InputFile ReKi Ptch_Min - - - "Record 6: Minimum pitch angle [used only with DLL Interface]" radians -typedef ^ SrvD_InputFile ReKi Ptch_Max - - - "Record 7: Maximum pitch angle [used only with DLL Interface]" radians -typedef ^ SrvD_InputFile ReKi PtchRate_Min - - - "Record 8: Minimum pitch rate (most negative value allowed) [used only with DLL Interface]" rad/s -typedef ^ SrvD_InputFile ReKi PtchRate_Max - - - "Record 9: Maximum pitch rate [used only with DLL Interface]" rad/s -typedef ^ SrvD_InputFile ReKi Gain_OM - - - "Record 16: Optimal mode gain [used only with DLL Interface]" Nm/(rad/s)^2 -typedef ^ SrvD_InputFile ReKi GenSpd_MinOM - - - "Record 17: Minimum generator speed [used only with DLL Interface]" rad/s -typedef ^ SrvD_InputFile ReKi GenSpd_MaxOM - - - "Record 18: Optimal mode maximum speed [used only with DLL Interface]" rad/s -typedef ^ SrvD_InputFile ReKi GenSpd_Dem - - - "Record 19: Demanded generator speed above rated [used only with DLL Interface]" rad/s -typedef ^ SrvD_InputFile ReKi GenTrq_Dem - - - "Record 22: Demanded generator torque above rated [used only with DLL Interface]" Nm -typedef ^ SrvD_InputFile ReKi GenPwr_Dem - - - "Record 13: Demanded power [used only with DLL Interface]" W -typedef ^ SrvD_InputFile IntKi DLL_NumTrq - - - "Record 26: No. of points in torque-speed look-up table {0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Gain_OM (Record 16) to 0.0} [used only with DLL Interface]" - -typedef ^ SrvD_InputFile ReKi GenSpd_TLU {:} - - "Records R:2:R+2*DLL_NumTrq-2: Generator speed values in look-up table [used only with DLL Interface]" rad/s -typedef ^ SrvD_InputFile ReKi GenTrq_TLU {:} - - "Records R+1:2:R+2*DLL_NumTrq-1: Generator torque values in look-up table [used only with DLL Interface]" Nm -typedef ^ SrvD_InputFile LOGICAL UseLegacyInterface - - - "Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER)" - - -typedef ^ SrvD_InputFile IntKi NumBStC - - - "Number of blade structural controllers (integer)" - -typedef ^ SrvD_InputFile CHARACTER(1024) BStCfiles {:} - - "Name of the files for blade structural controllers (quoted strings) [unused when NumBStC==0]" - -typedef ^ SrvD_InputFile IntKi NumNStC - - - "Number of nacelle structural controllers (integer)" - -typedef ^ SrvD_InputFile CHARACTER(1024) NStCfiles {:} - - "Name of the files for nacelle structural controllers (quoted strings) [unused when NumNStC==0]" - -typedef ^ SrvD_InputFile IntKi NumTStC - - - "Number of tower structural controllers (integer)" - -typedef ^ SrvD_InputFile CHARACTER(1024) TStCfiles {:} - - "Name of the files for tower structural controllers (quoted strings) [unused when NumTStC==0]" - -typedef ^ SrvD_InputFile IntKi NumSStC - - - "Number of substructure structural controllers (integer)" - -typedef ^ SrvD_InputFile CHARACTER(1024) SStCfiles {:} - - "Name of the files for subtructure structural controllers (quoted strings) [unused when NumSStC==0]" - - -# ..... Data for using Bladed DLLs ....................................................................................................... -typedef ^ BladedDLLType SiKi avrSWAP {:} - - "The swap array: used to pass data to and from the DLL controller" "see Bladed DLL documentation" -typedef ^ BladedDLLType ReKi HSSBrTrqDemand - - - "Demanded braking torque - from Bladed DLL" - -typedef ^ BladedDLLType ReKi YawRateCom - - - "Nacelle yaw rate demanded from Bladed DLL" rad/s -typedef ^ BladedDLLType ReKi GenTrq - - - "Electrical generator torque from Bladed DLL" N-m -typedef ^ BladedDLLType IntKi GenState - - - "Generator state from Bladed DLL" - -typedef ^ BladedDLLType ReKi BlPitchCom 3 - - "Commanded blade pitch angles" radians -typedef ^ BladedDLLType ReKi PrevBlPitch 3 - - "Previously commanded blade pitch angles" radians -typedef ^ BladedDLLType ReKi BlAirfoilCom 3 - - "Commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables)" - -typedef ^ BladedDLLType ReKi ElecPwr_prev - - - "Electrical power (from previous step), sent to Bladed DLL" W -typedef ^ BladedDLLType ReKi GenTrq_prev - - - "Electrical generator torque (from previous step), sent to Bladed DLL" N-m -typedef ^ BladedDLLType SiKi toSC {:} - - "controller output to supercontroller" - -typedef ^ BladedDLLType logical initialized - - - "flag that determines if DLL has been called (for difference between CalcOutput and UpdateStates)" - -typedef ^ BladedDLLType INTEGER NumLogChannels - - - "number of log channels from controller" - -typedef ^ BladedDLLType OutParmType LogChannels_OutParam {:} - - "Names and units (and other characteristics) of logging outputs from DLL" - -typedef ^ BladedDLLType ReKi LogChannels {:} - - "logging outputs from controller" - -typedef ^ BladedDLLType IntKi ErrStat - - - "error message from external controller API" - -typedef ^ BladedDLLType CHARACTER(ErrMsgLen) ErrMsg - - - "error message from external controller API" - -typedef ^ BladedDLLType R8Ki CurrentTime - - - "Current Simulation Time" s -typedef ^ BladedDLLType IntKi SimStatus - - - "simulation status (see avrSWAP(1): Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation)" - -typedef ^ BladedDLLType IntKi ShaftBrakeStatusBinaryFlag - - - "binary flag indicating (on/off) status for shaft brake 1, shaft brake 2, generator brake, shaft brake 3, or brake torque set separately (0, 1, or 16 allowed in FAST)"- -typedef ^ BladedDLLType LOGICAL HSSBrDeployed - - - "Whether the HSS brake has been deployed" - -typedef ^ BladedDLLType R8Ki TimeHSSBrFullyDeployed - - - "Time at which the controller high-speed shaft is fully deployed" s -typedef ^ BladedDLLType R8Ki TimeHSSBrDeployed - - - "Time at which the controller high-speed shaft is first deployed" s -typedef ^ BladedDLLType LOGICAL OverrideYawRateWithTorque - - - "acts similiar to Yaw_Cntrl" - -typedef ^ BladedDLLType ReKi YawTorqueDemand - - - "Demanded yaw actuator torque (override of yaw rate control)" Nm -## these are INPUTS copied to the DLL: -typedef ^ BladedDLLType ReKi BlPitchInput {:} - - "Input blade pitch angles" radians -typedef ^ BladedDLLType ReKi YawAngleFromNorth - - - "Yaw angle of the nacelle relative to North (see NacYaw_North)" rad -typedef ^ BladedDLLType ReKi HorWindV - - - "Horizontal hub-height wind velocity magnitude" m/s -typedef ^ BladedDLLType ReKi HSS_Spd - - - "High-speed shaft (HSS) speed" rad/s -typedef ^ BladedDLLType ReKi YawErr - - - "Yaw error" radians -typedef ^ BladedDLLType ReKi RotSpeed - - - "Rotor azimuth angular speed" rad/s -typedef ^ BladedDLLType ReKi YawBrTAxp - - - "Tower-top / yaw bearing fore-aft (translational) acceleration (absolute)" m/s^2 -typedef ^ BladedDLLType ReKi YawBrTAyp - - - "Tower-top / yaw bearing side-to-side (translational) acceleration (absolute)" m/s^2 -typedef ^ BladedDLLType ReKi LSSTipMys - - - "Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m -typedef ^ BladedDLLType ReKi LSSTipMzs - - - "Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m -typedef ^ BladedDLLType ReKi LSSTipMya - - - "Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m -typedef ^ BladedDLLType ReKi LSSTipMza - - - "Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m -typedef ^ BladedDLLType ReKi LSSTipPxa - - - "Rotor azimuth angle (position)" radians -typedef ^ BladedDLLType ReKi Yaw - - - "Current nacelle yaw" radians -typedef ^ BladedDLLType ReKi YawRate - - - "Current nacelle yaw rate" rad/s -typedef ^ BladedDLLType ReKi YawBrMyn - - - "Rotating (with nacelle) tower-top / yaw bearing pitch moment" N-m -typedef ^ BladedDLLType ReKi YawBrMzn - - - "Tower-top / yaw bearing yaw moment" N-m -typedef ^ BladedDLLType ReKi NcIMURAxs - - - "Nacelle inertial measurement unit angular (rotational) acceleration (absolute)" rad/s^2 -typedef ^ BladedDLLType ReKi NcIMURAys - - - "Nacelle inertial measurement unit angular (rotational) acceleration (absolute)" rad/s^2 -typedef ^ BladedDLLType ReKi NcIMURAzs - - - "Nacelle inertial measurement unit angular (rotational) acceleration (absolute)" rad/s^2 -typedef ^ BladedDLLType ReKi RotPwr - - - "Rotor power (this is equivalent to the low-speed shaft power)" W -typedef ^ BladedDLLType ReKi LSSTipMxa - - - "Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m -typedef ^ BladedDLLType ReKi RootMyc 3 - - "Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3)" N-m -typedef ^ BladedDLLType ReKi RootMxc 3 - - "In-plane moment (i.e., the moment caused by in-plane forces) at the blade root" N-m -## these are PARAMETERS sent to the DLL (THEIR VALUES SHOULD NOT CHANGE DURING SIMULATION): -typedef ^ BladedDLLType DbKi DLL_DT - - - "interval for calling DLL (integer multiple number of DT)" s -typedef ^ BladedDLLType CHARACTER(1024) DLL_InFile - - - "Name of input file used in DLL" - -typedef ^ BladedDLLType CHARACTER(1024) RootName - - - "RootName for writing output files" - -typedef ^ BladedDLLType ReKi GenTrq_Dem - - - "Demanded generator torque above rated" Nm -typedef ^ BladedDLLType ReKi GenSpd_Dem - - - "Demanded generator speed above rated" rad/s -typedef ^ BladedDLLType ReKi Ptch_Max - - - "Maximum pitch angle" rad -typedef ^ BladedDLLType ReKi Ptch_Min - - - "Minimum pitch angle" rad -typedef ^ BladedDLLType ReKi Ptch_SetPnt - - - "Below-rated pitch angle set-point" rad -typedef ^ BladedDLLType ReKi PtchRate_Max - - - "Maximum pitch rate" rad/s -typedef ^ BladedDLLType ReKi PtchRate_Min - - - "Minimum pitch rate (most negative value allowed)" rad/s -typedef ^ BladedDLLType ReKi GenPwr_Dem - - - "Demanded power (This is not valid for variable-speed, pitch-regulated controllers.)" W -typedef ^ BladedDLLType ReKi Gain_OM - - - "Optimal mode gain" Nm/(rad/s)^2 -typedef ^ BladedDLLType ReKi GenSpd_MaxOM - - - "Optimal mode maximum speed" rad/s -typedef ^ BladedDLLType ReKi GenSpd_MinOM - - - "Minimum generator speed" rad/s -typedef ^ BladedDLLType IntKi Ptch_Cntrl - - - "Pitch control: 0 = collective; 1 = individual" - -typedef ^ BladedDLLType IntKi DLL_NumTrq - - - "No. of points in torque-speed look-up table, 0 = none and use the optimal mode PARAMETERs instead; nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0" - -typedef ^ BladedDLLType ReKi GenSpd_TLU {:} - - "Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) -- this should be defined using an array constructor; for example, if DLL_NumTrq = 3, GenSpd_TLU(DLL_NumTrq) = (/ 0.0, 99.9, 999.9 /)" rad/s -typedef ^ BladedDLLType ReKi GenTrq_TLU {:} - - "Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) -- this should be defined using an array constructor, for example, if DLL_NumTrq = 3, GenTrq_TLU(DLL_NumTrq) = (/ 0.0, 10, 200.0 /)" Nm -typedef ^ BladedDLLType IntKi Yaw_Cntrl - - - "Yaw control: 0 = rate; 1 = torque" - - -# ..... States .................................................................................................................... -# Define continuous (differentiable) states here: -typedef ^ ContinuousStateType ReKi DummyContState - - - "Remove this variable if you have continuous states" - -typedef ^ ContinuousStateType StC_ContinuousStateType BStC {:} - - "StC module states - blade" - -typedef ^ ContinuousStateType StC_ContinuousStateType NStC {:} - - "StC module states - nacelle" - -typedef ^ ContinuousStateType StC_ContinuousStateType TStC {:} - - "StC module states - tower" - -typedef ^ ContinuousStateType StC_ContinuousStateType SStC {:} - - "StC module inputs - substructure" - - -# Define discrete (nondifferentiable) states here: -typedef ^ DiscreteStateType ReKi CtrlOffset - - - "Controller offset parameter" N-m -#typedef ^ DiscreteStateType ReKi BlPitchFilter {:} - - "blade pitch filter" - -typedef ^ DiscreteStateType StC_DiscreteStateType BStC {:} - - "StC module states - blade" - -typedef ^ DiscreteStateType StC_DiscreteStateType NStC {:} - - "StC module states - nacelle" - -typedef ^ DiscreteStateType StC_DiscreteStateType TStC {:} - - "StC module states - tower" - -typedef ^ DiscreteStateType StC_DiscreteStateType SStC {:} - - "StC module inputs - substructure" - - -# Define constraint states here: -typedef ^ ConstraintStateType ReKi DummyConstrState - - - "Remove this variable if you have constraint states" - -typedef ^ ConstraintStateType StC_ConstraintStateType BStC {:} - - "StC module states - blade" - -typedef ^ ConstraintStateType StC_ConstraintStateType NStC {:} - - "StC module states - nacelle" - -typedef ^ ConstraintStateType StC_ConstraintStateType TStC {:} - - "StC module states - tower" - -typedef ^ ConstraintStateType StC_ConstraintStateType SStC {:} - - "StC module inputs - substructure" - - -# Define "other" states (e.g. logical states) here: -# other states for pitch maneuver: -typedef ^ OtherStateType Logical BegPitMan {:} - - "Whether the override pitch maneuver actually began" - -typedef ^ OtherStateType ReKi BlPitchI {:} - - "Initial blade pitch angles at the start of the override pitch maneuver" radians -typedef ^ OtherStateType DbKi TPitManE {:} - - "Time to end pitch maneuvers for each blade" s -# other states for yaw maneuver: -typedef ^ OtherStateType Logical BegYawMan - - - "Whether the yaw maneuver actually began" - -typedef ^ OtherStateType ReKi NacYawI - - - "Initial yaw angle at the start of the override yaw maneuver" radians -typedef ^ OtherStateType DbKi TYawManE - - - "Time to end override yaw maneuver" s -typedef ^ OtherStateType ReKi YawPosComInt - - - "Internal variable that integrates the commanded yaw rate and passes it to YawPosCom" radians -# other states for tip-brake deployment: -typedef ^ OtherStateType Logical BegTpBr {:} - - "Whether the tip brakes actually deployed" - -typedef ^ OtherStateType DbKi TTpBrDp {:} - - "Times to initiate deployment of tip brakes" s -typedef ^ OtherStateType DbKi TTpBrFl {:} - - "Times at which tip brakes are fully deployed" s -# other states for generator on/off: -typedef ^ OtherStateType Logical Off4Good - - - "Is the generator offline for rest of simulation?" - -typedef ^ OtherStateType Logical GenOnLine - - - "Is the generator online?" - -# other states for StC sub-module: -typedef ^ OtherStateType StC_OtherStateType BStC {:} - - "StC module states - blade" - -typedef ^ OtherStateType StC_OtherStateType NStC {:} - - "StC module states - nacelle" - -typedef ^ OtherStateType StC_OtherStateType TStC {:} - - "StC module states - tower" - -typedef ^ OtherStateType StC_OtherStateType SStC {:} - - "StC module inputs - substructure" - - -# ..... Misc Variables ................................................................................................................ -typedef ^ MiscVarType DbKi LastTimeCalled - - - "last time the CalcOutput/Bladed DLL was called" s -typedef ^ MiscVarType BladedDLLType dll_data - - - "data used for Bladed DLL" - -typedef ^ MiscVarType logical FirstWarn - - - "Whether or not this is the first warning about the DLL being called without Explicit-Loose coupling." - -typedef ^ MiscVarType DbKi LastTimeFiltered - - - "last time the CalcOutput/Bladed DLL was filtered" s -typedef ^ MiscVarType ReKi xd_BlPitchFilter {:} - - "blade pitch filter" - -typedef ^ MiscVarType StC_MiscVarType BStC {:} - - "StC module misc vars - blade" - -typedef ^ MiscVarType StC_MiscVarType NStC {:} - - "StC module misc vars - nacelle" - -typedef ^ MiscVarType StC_MiscVarType TStC {:} - - "StC module misc vars - tower" - -typedef ^ MiscVarType StC_MiscVarType SStC {:} - - "StC module misc vars - substructure" - - -# ..... Parameters ................................................................................................................ -# Define parameters here: -# Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: -typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds -typedef ^ ParameterType DbKi HSSBrDT - - - "Time it takes for HSS brake to reach full deployment once deployed" seconds -typedef ^ ParameterType ReKi HSSBrTqF - - - "Fully deployed HSS brake torque" -typedef ^ ParameterType ReKi SIG_POSl - - - "Pullout slip" -typedef ^ ParameterType ReKi SIG_POTq - - - "Pullout torque" -typedef ^ ParameterType ReKi SIG_SlPc - - - "Rated generator slip percentage" -typedef ^ ParameterType ReKi SIG_Slop - - - "Torque/Speed slope for simple induction generator" -typedef ^ ParameterType ReKi SIG_SySp - - - "Synchronous (zero-torque) generator speed" rad/s -typedef ^ ParameterType ReKi TEC_A0 - - - "A0 term for Thevenin-equivalent circuit" -typedef ^ ParameterType ReKi TEC_C0 - - - "C0 term for Thevenin-equivalent circuit" -typedef ^ ParameterType ReKi TEC_C1 - - - "C1 term for Thevenin-equivalent circuit" -typedef ^ ParameterType ReKi TEC_C2 - - - "C2 term for Thevenin-equivalent circuit" -typedef ^ ParameterType ReKi TEC_K2 - - - "K2 term for Thevenin-equivalent circuit" -typedef ^ ParameterType ReKi TEC_MR - - - "Magnetizing reactance for Thevenin-equivalent circuit" ohms -typedef ^ ParameterType ReKi TEC_Re1 - - - "Thevenin's equivalent stator resistance (ohms)" ohms -typedef ^ ParameterType ReKi TEC_RLR - - - "Rotor leakage reactance for Thevenin-equivalent circuit" -typedef ^ ParameterType ReKi TEC_RRes - - - "Rotor resistance for Thevenin-equivalent circuit" -typedef ^ ParameterType ReKi TEC_SRes - - - "Stator resistance for Thevenin-equivalent circuit" -typedef ^ ParameterType ReKi TEC_SySp - - - "Synchronous speed for Thevenin-equivalent circuit" -typedef ^ ParameterType ReKi TEC_V1a - - - "Source voltage for Thevenin-equivalent circuit" -typedef ^ ParameterType ReKi TEC_VLL - - - "Line-to-line RMS voltage for Thevenin-equivalent circuit" -typedef ^ ParameterType ReKi TEC_Xe1 - - - "Thevenin's equivalent stator leakage reactance (ohms)" ohms -typedef ^ ParameterType ReKi GenEff - - - "Generator efficiency" -typedef ^ ParameterType ReKi BlPitchInit {:} - - "Initial blade pitch angles" radians -typedef ^ ParameterType ReKi BlPitchF {:} - - "Final blade pitch" -typedef ^ ParameterType ReKi PitManRat {:} - - "Pitch rates at which override pitch maneuvers head toward final pitch angles (does not include sign)" rad/s -typedef ^ ParameterType ReKi YawManRat - - - "Yaw rate at which override yaw maneuver head toward for final yaw angle (does not include sign)" rad/s -typedef ^ ParameterType ReKi NacYawF - - - "Final yaw angle after override yaw maneuver" -typedef ^ ParameterType ReKi SpdGenOn - - - "Generator speed to turn on the generator for a startup" -typedef ^ ParameterType DbKi THSSBrDp - - - "Time to initiate deployment of the shaft brake" s -typedef ^ ParameterType DbKi THSSBrFl - - - "Time at which shaft brake is fully deployed" s -typedef ^ ParameterType DbKi TimGenOf - - - "Time to turn off generator for braking or modeling a run-away" s -typedef ^ ParameterType DbKi TimGenOn - - - "Time to turn on generator for startup" s -typedef ^ ParameterType DbKi TPCOn - - - "Time to enable active pitch control" s -typedef ^ ParameterType DbKi TPitManS {:} - - "Time to start pitch maneuvers for each blade" s -typedef ^ ParameterType DbKi TYawManS - - - "Time to start override yaw maneuver" s -typedef ^ ParameterType DbKi TYCOn - - - "Time to enable active yaw control" s -typedef ^ ParameterType ReKi VS_RtGnSp - - - "Rated generator speed (HSS side)" rad/s -typedef ^ ParameterType ReKi VS_RtTq - - - "Rated generator torque/constant generator torque in Region 3 (HSS side)" N-m -typedef ^ ParameterType ReKi VS_Slope - - - "Torque/speed slope of region 2 1/2 induction generator" -typedef ^ ParameterType ReKi VS_SlPc - - - "Rated generator slip percentage in Region 2 1/2" - -typedef ^ ParameterType ReKi VS_SySp - - - "Synchronous speed of region 2 1/2 induction generator" -typedef ^ ParameterType ReKi VS_TrGnSp - - - "Transitional generator speed between regions 2 and 2 1/2" -typedef ^ ParameterType ReKi YawPosCom - - - "Commanded yaw angle from user-defined routines" rad -typedef ^ ParameterType ReKi YawRateCom - - - "Commanded yaw rate from user-defined routines" rad/s -typedef ^ ParameterType IntKi GenModel - - - "Generator model" - -typedef ^ ParameterType IntKi HSSBrMode - - - "HSS brake model" - -typedef ^ ParameterType IntKi PCMode - - - "Pitch control mode" - -typedef ^ ParameterType IntKi VSContrl - - - "Variable-speed-generator control switch" - -typedef ^ ParameterType IntKi YCMode - - - "Yaw control mode" - -typedef ^ ParameterType LOGICAL GenTiStp - - - "Stop generator based upon T: time or F: generator power = 0" -typedef ^ ParameterType LOGICAL GenTiStr - - - "Start generator based upon T: time or F: generator speed" -typedef ^ ParameterType ReKi VS_Rgn2K - - - "Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) [used only when VSContrl=1]" N-m/(rad/s)^2 -typedef ^ ParameterType ReKi YawNeut - - - "Neutral yaw position--yaw spring force is zero at this yaw" radians -typedef ^ ParameterType ReKi YawSpr - - - "Nacelle-yaw spring constant" N-m/rad -typedef ^ ParameterType ReKi YawDamp - - - "Nacelle-yaw constant" N-m/(rad/s) -typedef ^ ParameterType DbKi TpBrDT - - - "Time for tip-brake to reach full deployment once released" s -typedef ^ ParameterType ReKi TBDepISp {:} - - "Deployment-initiation speed for the tip brakes" rad/s -typedef ^ ParameterType ReKi TBDrConN - - - "Tip-brake drag constant during normal operation, Cd*Area" -typedef ^ ParameterType ReKi TBDrConD - - - "Tip-brake drag constant during fully-deployed operation, Cd*Area" -typedef ^ ParameterType IntKi NumBl - - - "Number of blades on the turbine" - -typedef ^ ParameterType IntKi NumBStC - - - "Number of blade structural controllers (integer)" - -typedef ^ ParameterType IntKi NumNStC - - - "Number of nacelle structural controllers (integer)" - -typedef ^ ParameterType IntKi NumTStC - - - "Number of tower structural controllers (integer)" - -typedef ^ ParameterType IntKi NumSStC - - - "Number of substructure structural controllers (integer)" - -# parameters for output -typedef ^ ParameterType IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - -typedef ^ ParameterType IntKi NumOuts_DLL - - - "Number of logging channels output from the DLL (set at initialization)" - -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 CHARACTER(1) Delim - - - "Column delimiter for output text files" - -# parameters for Bladed Interface (dynamic-link library) -typedef ^ ParameterType LOGICAL UseBladedInterface - - - "Flag that determines if BladedInterface was used" - -typedef ^ ParameterType LOGICAL UseLegacyInterface - - - "Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER)" - -typedef ^ ParameterType DLL_Type DLL_Trgt - - - "The addresses and names of the Bladed DLL and its procedure" - -typedef ^ ParameterType LOGICAL DLL_Ramp - - - "determines if there is a DLL_DT-ramp time delay (true only when DLL_DT /= DT)" - -typedef ^ ParameterType ReKi BlAlpha - - - "parameter for low-pass filter of blade pitch commands from the controller DLL" - -typedef ^ ParameterType IntKi DLL_n - - - "number of steps between the controller being called and SrvD being called" - -typedef ^ ParameterType IntKi avcOUTNAME_LEN - - - "Length of the avcOUTNAME character array passed to/from the DLL" - -typedef ^ ParameterType ReKi NacYaw_North - - - "Reference yaw angle of the nacelle when the upwind end points due North" rad -typedef ^ ParameterType ReKi AvgWindSpeed - - - "average wind speed for the simulation" m/s -typedef ^ ParameterType ReKi AirDens - - - "air density" kg/m^3 -# parameters for trim-case (linearization): -typedef ^ ParameterType IntKi TrimCase - - - "Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True]" - -typedef ^ ParameterType ReKi TrimGain - - - "Proportional gain for the rotational speed error (>0) [used only if TrimCase>0]" "rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque" -typedef ^ ParameterType ReKi RotSpeedRef - - - "Reference rotor speed" "rad/s" -# parameters for other modules: -typedef ^ ParameterType StC_ParameterType BStC {:} - - "StC module parameters - blade" - -typedef ^ ParameterType StC_ParameterType NStC {:} - - "StC module parameters - nacelle" - -typedef ^ ParameterType StC_ParameterType TStC {:} - - "StC module parameters - tower" - -typedef ^ ParameterType StC_ParameterType SStC {:} - - "StC module parameters - substructure" - -typedef ^ ParameterType LOGICAL UseSC - - - "Supercontroller on/off flag" - - -# ..... Inputs .................................................................................................................... -# Define inputs that are not on this mesh here: -typedef ^ InputType ReKi BlPitch {:} - 2pi "Current blade pitch angles" radians -typedef ^ InputType ReKi Yaw - - 2pi "Current nacelle yaw" radians -typedef ^ InputType ReKi YawRate - - - "Current nacelle yaw rate" rad/s -typedef ^ InputType ReKi LSS_Spd - - - "Low-speed shaft (LSS) speed at entrance to gearbox" rad/s -typedef ^ InputType ReKi HSS_Spd - - - "High-speed shaft (HSS) speed" rad/s -typedef ^ InputType ReKi RotSpeed - - - "Rotor azimuth angular speed" rad/s -typedef ^ InputType ReKi ExternalYawPosCom - - 2pi "Commanded nacelle yaw position from Simulink or Labview" radians -typedef ^ InputType ReKi ExternalYawRateCom - - - "Commanded nacelle yaw rate from Simulink or Labview" rad/s -typedef ^ InputType ReKi ExternalBlPitchCom {:} - 2pi "Commanded blade pitch from Simulink or LabVIEW" radians -typedef ^ InputType ReKi ExternalGenTrq - - - "Electrical generator torque from Simulink or LabVIEW" N-m -typedef ^ InputType ReKi ExternalElecPwr - - - "Electrical power from Simulink or LabVIEW" W -typedef ^ InputType ReKi ExternalHSSBrFrac - - - "Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW" - -typedef ^ InputType ReKi TwrAccel - - - "Tower acceleration for tower feedback control (user routine only)" m/s^2 -typedef ^ InputType ReKi YawErr - - 2pi "Yaw error" radians -typedef ^ InputType ReKi WindDir - - 2pi "Wind direction" radians -typedef ^ InputType ReKi RootMyc 3 - - "Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3)" N-m -typedef ^ InputType ReKi YawBrTAxp - - - "Tower-top / yaw bearing fore-aft (translational) acceleration (absolute)" m/s^2 -typedef ^ InputType ReKi YawBrTAyp - - - "Tower-top / yaw bearing side-to-side (translational) acceleration (absolute)" m/s^2 -typedef ^ InputType ReKi LSSTipPxa - - - "Rotor azimuth angle (position)" radians -typedef ^ InputType ReKi RootMxc 3 - - "In-plane moment (i.e., the moment caused by in-plane forces) at the blade root" N-m -typedef ^ InputType ReKi LSSTipMxa - - - "Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m -typedef ^ InputType ReKi LSSTipMya - - - "Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m -typedef ^ InputType ReKi LSSTipMza - - - "Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m -typedef ^ InputType ReKi LSSTipMys - - - "Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m -typedef ^ InputType ReKi LSSTipMzs - - - "Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m -typedef ^ InputType ReKi YawBrMyn - - - "Rotating (with nacelle) tower-top / yaw bearing pitch moment" N-m -typedef ^ InputType ReKi YawBrMzn - - - "Tower-top / yaw bearing yaw moment" N-m -typedef ^ InputType ReKi NcIMURAxs - - - "Nacelle inertial measurement unit angular (rotational) acceleration (absolute)" rad/s^2 -typedef ^ InputType ReKi NcIMURAys - - - "Nacelle inertial measurement unit angular (rotational) acceleration (absolute)" rad/s^2 -typedef ^ InputType ReKi NcIMURAzs - - - "Nacelle inertial measurement unit angular (rotational) acceleration (absolute)" rad/s^2 -typedef ^ InputType ReKi RotPwr - - - "Rotor power (this is equivalent to the low-speed shaft power)" W -typedef ^ InputType ReKi HorWindV - - - "Horizontal hub-height wind velocity magnitude" m/s -typedef ^ InputType ReKi YawAngle - - 2pi "Estimate of yaw (nacelle + platform)" radians -typedef ^ InputType StC_InputType BStC {:} - - "StC module inputs - blade" - -typedef ^ InputType StC_InputType NStC {:} - - "StC module inputs - nacelle" - -typedef ^ InputType StC_InputType TStC {:} - - "StC module inputs - tower" - -typedef ^ InputType StC_InputType SStC {:} - - "StC module inputs - substructure" - -typedef ^ InputType SiKi fromSC {:} - - "A swap array: used to pass turbine specific input data to the DLL controller from the supercontroller" - -typedef ^ InputType SiKi fromSCglob {:} - - "A swap array: used to pass global input data to the DLL controller from the supercontroller" - -typedef ^ InputType SiKi Lidar {:} - - "A swap array: used to pass input data to the DLL controller from the Lidar" - - -# ..... Outputs ................................................................................................................... -# Define outputs that are contained on the mesh here: -#typedef ^ OutputType MeshType MeshedOutput - - - "Meshed output data" - -# Define outputs that are not on this mesh here: -typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" -typedef ^ OutputType ReKi BlPitchCom {:} - 2pi "Commanded blade pitch angles" radians -typedef ^ OutputType ReKi BlAirfoilCom {:} - - "Commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables)" - -typedef ^ OutputType ReKi YawMom - - - "Torque transmitted through the yaw bearing" N-m -typedef ^ OutputType ReKi GenTrq - - - "Electrical generator torque" N-m -typedef ^ OutputType ReKi HSSBrTrqC - - - "Commanded HSS brake torque" N-m -typedef ^ OutputType ReKi ElecPwr - - - "Electrical power" W -typedef ^ OutputType ReKi TBDrCon {:} - - "Instantaneous tip-brake drag constant, Cd*Area" -typedef ^ OutputType StC_OutputType BStC {:} - - "StC module outputs - blade" - -typedef ^ OutputType StC_OutputType NStC {:} - - "StC module outputs - nacelle" - -typedef ^ OutputType StC_OutputType TStC {:} - - "StC module outputs - tower" - -typedef ^ OutputType StC_OutputType SStC {:} - - "StC module outputs - substructure" - -typedef ^ OutputType SiKi toSC {:} - - "A swap array: used to pass output data from the DLL controller to the supercontroller" - -typedef ^ OutputType SiKi Lidar {:} - - "A swap array: used to pass output data from the DLL controller to the Lidar" - diff --git a/OpenFAST/modules/servodyn/src/ServoDyn_Types.f90 b/OpenFAST/modules/servodyn/src/ServoDyn_Types.f90 deleted file mode 100644 index 0f4a7b28e..000000000 --- a/OpenFAST/modules/servodyn/src/ServoDyn_Types.f90 +++ /dev/null @@ -1,12282 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'ServoDyn_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 -!********************************************************************************************************************************* -! ServoDyn_Types -!................................................................................................................................. -! This file is part of ServoDyn. -! -! 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 ServoDyn. 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 ServoDyn_Types -!--------------------------------------------------------------------------------------------------------------------------------- -USE StrucCtrl_Types -USE NWTC_Library -IMPLICIT NONE -! ========= SrvD_InitInputType ======= - TYPE, PUBLIC :: SrvD_InitInputType - CHARACTER(1024) :: InputFile !< Name of the input file [-] - LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] - INTEGER(IntKi) :: NumBl !< Number of blades on the turbine [-] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchInit !< Initial blade pitch [-] - REAL(ReKi) , DIMENSION(1:3) :: Gravity !< Gravitational acceleration vector [m/s^2] - REAL(ReKi) , DIMENSION(1:3) :: NacPosition !< nacelle origin for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacOrientation !< nacelle orientation for setting up mesh [-] - REAL(ReKi) , DIMENSION(1:3) :: TwrBasePos !< tower base origin for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseOrient !< tower base orientation for setting up mesh [m] - REAL(ReKi) , DIMENSION(1:3) :: PlatformPos !< platform origin for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: PlatformOrient !< platform orientation for setting up mesh [m] - REAL(DbKi) :: Tmax !< max time from glue code [s] - REAL(ReKi) :: AvgWindSpeed !< average wind speed for the simulation [m/s] - REAL(ReKi) :: AirDens !< air density [kg/m^3] - INTEGER(IntKi) :: NumSC2CtrlGlob !< number of global controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumSC2Ctrl !< number of turbine specific controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumCtrl2SC !< number of controller outputs [to supercontroller] [-] - INTEGER(IntKi) :: TrimCase !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] [-] - REAL(ReKi) :: TrimGain !< Proportional gain for the rotational speed error (>0) [used only if TrimCase>0] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] - REAL(ReKi) :: RotSpeedRef !< Reference rotor speed [rad/s] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BladeRootPosition !< X-Y-Z reference position of each blade root (3 x NumBlades) [m] - REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: BladeRootOrientation !< DCM reference orientation of blade roots (3x3 x NumBlades) [-] - LOGICAL :: UseInputFile = .TRUE. !< read input from input file [-] - TYPE(FileInfoType) :: PassedPrimaryInputData !< Primary input file as FileInfoType (set by driver/glue code) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: fromSCGlob !< Initial global inputs to the controller [from the supercontroller] [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: fromSC !< Initial turbine specific inputs to the controller [from the supercontroller] [-] - END TYPE SrvD_InitInputType -! ======================= -! ========= SrvD_InitOutputType ======= - TYPE, PUBLIC :: SrvD_InitOutputType - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] - TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - INTEGER(IntKi) :: CouplingScheme !< Switch that indicates if a particular coupling scheme is required [-] - LOGICAL :: UseHSSBrake !< flag to determine if high-speed shaft brake is potentially used (true=yes) [-] - CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] - CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_y !< Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] - END TYPE SrvD_InitOutputType -! ======================= -! ========= SrvD_InputFile ======= - TYPE, PUBLIC :: SrvD_InputFile - REAL(DbKi) :: DT !< Communication interval for controllers [s] - LOGICAL :: Echo !< Echo the input file out [-] - INTEGER(IntKi) :: PCMode !< Pitch control mode [-] - REAL(DbKi) :: TPCOn !< Time to enable active pitch control [unused when PCMode=0] [s] - REAL(DbKi) , DIMENSION(1:3) :: TPitManS !< Time to start override pitch maneuver for blade (K) and end standard pitch control [s] - REAL(ReKi) , DIMENSION(1:3) :: PitManRat !< Pitch rates at which override pitch maneuvers head toward final pitch angles [rad/s] - REAL(ReKi) , DIMENSION(1:3) :: BlPitchF !< Blade (K) final pitch for pitch maneuvers [radians] - INTEGER(IntKi) :: VSContrl !< Variable-speed control mode [-] - INTEGER(IntKi) :: GenModel !< Generator model [used only when VSContrl=0] [-] - REAL(ReKi) :: GenEff !< Generator efficiency [ignored by the Thevenin and user-defined generator models] [-] - LOGICAL :: GenTiStr !< Method to start the generator {T: timed using TimGenOn, F: generator speed using SpdGenOn} [-] - LOGICAL :: GenTiStp !< Method to stop the generator {T: timed using TimGenOf, F: when generator power = 0} [-] - REAL(ReKi) :: SpdGenOn !< Generator speed to turn on the generator for a startup (HSS speed) [used only when GenTiStr=False] [rad/s] - REAL(DbKi) :: TimGenOn !< Time to turn on the generator for a startup [used only when GenTiStr=True] [s] - REAL(DbKi) :: TimGenOf !< Time to turn off the generator [used only when GenTiStp=True] [s] - REAL(ReKi) :: VS_RtGnSp !< Rated generator speed for simple variable-speed generator control (HSS side) [used only when VSContrl=1] [rad/s] - REAL(ReKi) :: VS_RtTq !< Rated generator torque/constant generator torque in Region 3 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] [N-m] - REAL(ReKi) :: VS_Rgn2K !< Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] [N-m/(rad/s)^2] - REAL(ReKi) :: VS_SlPc !< Rated generator slip percentage in Region 2 1/2 for simple variable-speed generator control [used only when VSContrl=1] [-] - REAL(ReKi) :: SIG_SlPc !< Rated generator slip percentage [used only when VSContrl=0 and GenModel=1] [-] - REAL(ReKi) :: SIG_SySp !< Synchronous (zero-torque) generator speed [used only when VSContrl=0 and GenModel=1] [rad/s] - REAL(ReKi) :: SIG_RtTq !< Rated torque [used only when VSContrl=0 and GenModel=1] [N-m] - REAL(ReKi) :: SIG_PORt !< Pull-out ratio (Tpullout/Trated) [used only when VSContrl=0 and GenModel=1] [-] - REAL(ReKi) :: TEC_Freq !< Line frequency [50 or 60] [used only when VSContrl=0 and GenModel=2] [Hz] - INTEGER(IntKi) :: TEC_NPol !< Number of poles [even integer > 0] [used only when VSContrl=0 and GenModel=2] [-] - REAL(ReKi) :: TEC_SRes !< Stator resistance [used only when VSContrl=0 and GenModel=2] [ohms] - REAL(ReKi) :: TEC_RRes !< Rotor resistance [used only when VSContrl=0 and GenModel=2] [ohms] - REAL(ReKi) :: TEC_VLL !< Line-to-line RMS voltage [used only when VSContrl=0 and GenModel=2] [volts] - REAL(ReKi) :: TEC_SLR !< Stator leakage reactance [used only when VSContrl=0 and GenModel=2] [ohms] - REAL(ReKi) :: TEC_RLR !< Rotor leakage reactance [used only when VSContrl=0 and GenModel=2] [ohms] - REAL(ReKi) :: TEC_MR !< Magnetizing reactance [used only when VSContrl=0 and GenModel=2] [ohms] - INTEGER(IntKi) :: HSSBrMode !< HSS brake model [-] - REAL(DbKi) :: THSSBrDp !< Time to initiate deployment of the HSS brake [s] - REAL(DbKi) :: HSSBrDT !< Time for HSS-brake to reach full deployment once initiated [used only when HSSBrMode=1] [s] - REAL(ReKi) :: HSSBrTqF !< Fully deployed HSS-brake torque [N-m] - INTEGER(IntKi) :: YCMode !< Yaw control mode [-] - REAL(DbKi) :: TYCOn !< Time to enable active yaw control [unused when YCMode=0] [s] - REAL(ReKi) :: YawNeut !< Neutral yaw position--yaw spring force is zero at this yaw [radians] - REAL(ReKi) :: YawSpr !< Nacelle-yaw spring constant [N-m/rad] - REAL(ReKi) :: YawDamp !< Nacelle-yaw constant [N-m/(rad/s)] - REAL(DbKi) :: TYawManS !< Time to start override yaw maneuver and end standard yaw control [s] - REAL(ReKi) :: YawManRat !< Yaw maneuver rate (in absolute value) [rad/s] - REAL(ReKi) :: NacYawF !< Final yaw angle for override yaw maneuvers [radians] - LOGICAL :: SumPrint !< Print summary data to .sum [-] - INTEGER(IntKi) :: OutFile !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] - LOGICAL :: TabDelim !< Use tab delimiters in text tabular output file? [-] - CHARACTER(20) :: OutFmt !< Format used for text tabular output (except time) [-] - REAL(DbKi) :: Tstart !< Time to start module's tabular output [s] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] - CHARACTER(1024) :: DLL_FileName !< Name of the DLL file including the full path [-] - CHARACTER(1024) :: DLL_ProcName !< Name of the procedure in the DLL that will be called [-] - CHARACTER(1024) :: DLL_InFile !< Name of input file used in DLL [-] - REAL(DbKi) :: DLL_DT !< interval for calling DLL (must be integer multiple number of DT steps) [s] - LOGICAL :: DLL_Ramp !< whether the DLL pitch should be a ramp (true) or step change (false) when DLL_DT <> DT. If true, introduces a time delay. [-] - REAL(ReKi) :: BPCutoff !< The cutoff frequency for the blade pitch low-pass filter. Large values => no filter. [Hz] - REAL(ReKi) :: NacYaw_North !< Reference yaw angle of the nacelle when the upwind end points due North [used only with DLL Interface] [radians] - INTEGER(IntKi) :: Ptch_Cntrl !< Record 28: Use individual pitch control {0: collective pitch; 1: individual pitch control} [used only with DLL Interface] [-] - REAL(ReKi) :: Ptch_SetPnt !< Record 5: Below-rated pitch angle set-point [used only with DLL Interface] [radians] - REAL(ReKi) :: Ptch_Min !< Record 6: Minimum pitch angle [used only with DLL Interface] [radians] - REAL(ReKi) :: Ptch_Max !< Record 7: Maximum pitch angle [used only with DLL Interface] [radians] - REAL(ReKi) :: PtchRate_Min !< Record 8: Minimum pitch rate (most negative value allowed) [used only with DLL Interface] [rad/s] - REAL(ReKi) :: PtchRate_Max !< Record 9: Maximum pitch rate [used only with DLL Interface] [rad/s] - REAL(ReKi) :: Gain_OM !< Record 16: Optimal mode gain [used only with DLL Interface] [Nm/(rad/s)^2] - REAL(ReKi) :: GenSpd_MinOM !< Record 17: Minimum generator speed [used only with DLL Interface] [rad/s] - REAL(ReKi) :: GenSpd_MaxOM !< Record 18: Optimal mode maximum speed [used only with DLL Interface] [rad/s] - REAL(ReKi) :: GenSpd_Dem !< Record 19: Demanded generator speed above rated [used only with DLL Interface] [rad/s] - REAL(ReKi) :: GenTrq_Dem !< Record 22: Demanded generator torque above rated [used only with DLL Interface] [Nm] - REAL(ReKi) :: GenPwr_Dem !< Record 13: Demanded power [used only with DLL Interface] [W] - INTEGER(IntKi) :: DLL_NumTrq !< Record 26: No. of points in torque-speed look-up table {0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Gain_OM (Record 16) to 0.0} [used only with DLL Interface] [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenSpd_TLU !< Records R:2:R+2*DLL_NumTrq-2: Generator speed values in look-up table [used only with DLL Interface] [rad/s] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenTrq_TLU !< Records R+1:2:R+2*DLL_NumTrq-1: Generator torque values in look-up table [used only with DLL Interface] [Nm] - LOGICAL :: UseLegacyInterface !< Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER) [-] - INTEGER(IntKi) :: NumBStC !< Number of blade structural controllers (integer) [-] - CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: BStCfiles !< Name of the files for blade structural controllers (quoted strings) [unused when NumBStC==0] [-] - INTEGER(IntKi) :: NumNStC !< Number of nacelle structural controllers (integer) [-] - CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: NStCfiles !< Name of the files for nacelle structural controllers (quoted strings) [unused when NumNStC==0] [-] - INTEGER(IntKi) :: NumTStC !< Number of tower structural controllers (integer) [-] - CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: TStCfiles !< Name of the files for tower structural controllers (quoted strings) [unused when NumTStC==0] [-] - INTEGER(IntKi) :: NumSStC !< Number of substructure structural controllers (integer) [-] - CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: SStCfiles !< Name of the files for subtructure structural controllers (quoted strings) [unused when NumSStC==0] [-] - END TYPE SrvD_InputFile -! ======================= -! ========= BladedDLLType ======= - TYPE, PUBLIC :: BladedDLLType - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: avrSWAP !< The swap array: used to pass data to and from the DLL controller [see Bladed DLL documentation] - REAL(ReKi) :: HSSBrTrqDemand !< Demanded braking torque - from Bladed DLL [-] - REAL(ReKi) :: YawRateCom !< Nacelle yaw rate demanded from Bladed DLL [rad/s] - REAL(ReKi) :: GenTrq !< Electrical generator torque from Bladed DLL [N-m] - INTEGER(IntKi) :: GenState !< Generator state from Bladed DLL [-] - REAL(ReKi) , DIMENSION(1:3) :: BlPitchCom !< Commanded blade pitch angles [radians] - REAL(ReKi) , DIMENSION(1:3) :: PrevBlPitch !< Previously commanded blade pitch angles [radians] - REAL(ReKi) , DIMENSION(1:3) :: BlAirfoilCom !< Commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables) [-] - REAL(ReKi) :: ElecPwr_prev !< Electrical power (from previous step), sent to Bladed DLL [W] - REAL(ReKi) :: GenTrq_prev !< Electrical generator torque (from previous step), sent to Bladed DLL [N-m] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: toSC !< controller output to supercontroller [-] - LOGICAL :: initialized !< flag that determines if DLL has been called (for difference between CalcOutput and UpdateStates) [-] - INTEGER(IntKi) :: NumLogChannels !< number of log channels from controller [-] - TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: LogChannels_OutParam !< Names and units (and other characteristics) of logging outputs from DLL [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LogChannels !< logging outputs from controller [-] - INTEGER(IntKi) :: ErrStat !< error message from external controller API [-] - CHARACTER(ErrMsgLen) :: ErrMsg !< error message from external controller API [-] - REAL(R8Ki) :: CurrentTime !< Current Simulation Time [s] - INTEGER(IntKi) :: SimStatus !< simulation status (see avrSWAP(1): Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation) [-] - INTEGER(IntKi) :: ShaftBrakeStatusBinaryFlag !< binary flag indicating (on/off) status for shaft brake 1, shaft brake 2, generator brake, shaft brake 3, or brake torque set separately (0, 1, or 16 allowed in FAST) [-] - LOGICAL :: HSSBrDeployed !< Whether the HSS brake has been deployed [-] - REAL(R8Ki) :: TimeHSSBrFullyDeployed !< Time at which the controller high-speed shaft is fully deployed [s] - REAL(R8Ki) :: TimeHSSBrDeployed !< Time at which the controller high-speed shaft is first deployed [s] - LOGICAL :: OverrideYawRateWithTorque !< acts similiar to Yaw_Cntrl [-] - REAL(ReKi) :: YawTorqueDemand !< Demanded yaw actuator torque (override of yaw rate control) [Nm] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchInput !< Input blade pitch angles [radians] - REAL(ReKi) :: YawAngleFromNorth !< Yaw angle of the nacelle relative to North (see NacYaw_North) [rad] - REAL(ReKi) :: HorWindV !< Horizontal hub-height wind velocity magnitude [m/s] - REAL(ReKi) :: HSS_Spd !< High-speed shaft (HSS) speed [rad/s] - REAL(ReKi) :: YawErr !< Yaw error [radians] - REAL(ReKi) :: RotSpeed !< Rotor azimuth angular speed [rad/s] - REAL(ReKi) :: YawBrTAxp !< Tower-top / yaw bearing fore-aft (translational) acceleration (absolute) [m/s^2] - REAL(ReKi) :: YawBrTAyp !< Tower-top / yaw bearing side-to-side (translational) acceleration (absolute) [m/s^2] - REAL(ReKi) :: LSSTipMys !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMzs !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMya !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMza !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipPxa !< Rotor azimuth angle (position) [radians] - REAL(ReKi) :: Yaw !< Current nacelle yaw [radians] - REAL(ReKi) :: YawRate !< Current nacelle yaw rate [rad/s] - REAL(ReKi) :: YawBrMyn !< Rotating (with nacelle) tower-top / yaw bearing pitch moment [N-m] - REAL(ReKi) :: YawBrMzn !< Tower-top / yaw bearing yaw moment [N-m] - REAL(ReKi) :: NcIMURAxs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: NcIMURAys !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: NcIMURAzs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: RotPwr !< Rotor power (this is equivalent to the low-speed shaft power) [W] - REAL(ReKi) :: LSSTipMxa !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) , DIMENSION(1:3) :: RootMyc !< Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3) [N-m] - REAL(ReKi) , DIMENSION(1:3) :: RootMxc !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] - REAL(DbKi) :: DLL_DT !< interval for calling DLL (integer multiple number of DT) [s] - CHARACTER(1024) :: DLL_InFile !< Name of input file used in DLL [-] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] - REAL(ReKi) :: GenTrq_Dem !< Demanded generator torque above rated [Nm] - REAL(ReKi) :: GenSpd_Dem !< Demanded generator speed above rated [rad/s] - REAL(ReKi) :: Ptch_Max !< Maximum pitch angle [rad] - REAL(ReKi) :: Ptch_Min !< Minimum pitch angle [rad] - REAL(ReKi) :: Ptch_SetPnt !< Below-rated pitch angle set-point [rad] - REAL(ReKi) :: PtchRate_Max !< Maximum pitch rate [rad/s] - REAL(ReKi) :: PtchRate_Min !< Minimum pitch rate (most negative value allowed) [rad/s] - REAL(ReKi) :: GenPwr_Dem !< Demanded power (This is not valid for variable-speed, pitch-regulated controllers.) [W] - REAL(ReKi) :: Gain_OM !< Optimal mode gain [Nm/(rad/s)^2] - REAL(ReKi) :: GenSpd_MaxOM !< Optimal mode maximum speed [rad/s] - REAL(ReKi) :: GenSpd_MinOM !< Minimum generator speed [rad/s] - INTEGER(IntKi) :: Ptch_Cntrl !< Pitch control: 0 = collective; 1 = individual [-] - INTEGER(IntKi) :: DLL_NumTrq !< No. of points in torque-speed look-up table, 0 = none and use the optimal mode PARAMETERs instead; nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0 [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenSpd_TLU !< Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) -- this should be defined using an array constructor; for example, if DLL_NumTrq = 3, GenSpd_TLU(DLL_NumTrq) = (/ 0.0, 99.9, 999.9 /) [rad/s] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenTrq_TLU !< Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) -- this should be defined using an array constructor, for example, if DLL_NumTrq = 3, GenTrq_TLU(DLL_NumTrq) = (/ 0.0, 10, 200.0 /) [Nm] - INTEGER(IntKi) :: Yaw_Cntrl !< Yaw control: 0 = rate; 1 = torque [-] - END TYPE BladedDLLType -! ======================= -! ========= SrvD_ContinuousStateType ======= - TYPE, PUBLIC :: SrvD_ContinuousStateType - REAL(ReKi) :: DummyContState !< Remove this variable if you have continuous states [-] - TYPE(StC_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module states - blade [-] - TYPE(StC_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module states - nacelle [-] - TYPE(StC_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module states - tower [-] - TYPE(StC_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: SStC !< StC module inputs - substructure [-] - END TYPE SrvD_ContinuousStateType -! ======================= -! ========= SrvD_DiscreteStateType ======= - TYPE, PUBLIC :: SrvD_DiscreteStateType - REAL(ReKi) :: CtrlOffset !< Controller offset parameter [N-m] - TYPE(StC_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module states - blade [-] - TYPE(StC_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module states - nacelle [-] - TYPE(StC_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module states - tower [-] - TYPE(StC_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: SStC !< StC module inputs - substructure [-] - END TYPE SrvD_DiscreteStateType -! ======================= -! ========= SrvD_ConstraintStateType ======= - TYPE, PUBLIC :: SrvD_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] - TYPE(StC_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module states - blade [-] - TYPE(StC_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module states - nacelle [-] - TYPE(StC_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module states - tower [-] - TYPE(StC_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: SStC !< StC module inputs - substructure [-] - END TYPE SrvD_ConstraintStateType -! ======================= -! ========= SrvD_OtherStateType ======= - TYPE, PUBLIC :: SrvD_OtherStateType - LOGICAL , DIMENSION(:), ALLOCATABLE :: BegPitMan !< Whether the override pitch maneuver actually began [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchI !< Initial blade pitch angles at the start of the override pitch maneuver [radians] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TPitManE !< Time to end pitch maneuvers for each blade [s] - LOGICAL :: BegYawMan !< Whether the yaw maneuver actually began [-] - REAL(ReKi) :: NacYawI !< Initial yaw angle at the start of the override yaw maneuver [radians] - REAL(DbKi) :: TYawManE !< Time to end override yaw maneuver [s] - REAL(ReKi) :: YawPosComInt !< Internal variable that integrates the commanded yaw rate and passes it to YawPosCom [radians] - LOGICAL , DIMENSION(:), ALLOCATABLE :: BegTpBr !< Whether the tip brakes actually deployed [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TTpBrDp !< Times to initiate deployment of tip brakes [s] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TTpBrFl !< Times at which tip brakes are fully deployed [s] - LOGICAL :: Off4Good !< Is the generator offline for rest of simulation? [-] - LOGICAL :: GenOnLine !< Is the generator online? [-] - TYPE(StC_OtherStateType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module states - blade [-] - TYPE(StC_OtherStateType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module states - nacelle [-] - TYPE(StC_OtherStateType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module states - tower [-] - TYPE(StC_OtherStateType) , DIMENSION(:), ALLOCATABLE :: SStC !< StC module inputs - substructure [-] - END TYPE SrvD_OtherStateType -! ======================= -! ========= SrvD_MiscVarType ======= - TYPE, PUBLIC :: SrvD_MiscVarType - REAL(DbKi) :: LastTimeCalled !< last time the CalcOutput/Bladed DLL was called [s] - TYPE(BladedDLLType) :: dll_data !< data used for Bladed DLL [-] - LOGICAL :: FirstWarn !< Whether or not this is the first warning about the DLL being called without Explicit-Loose coupling. [-] - REAL(DbKi) :: LastTimeFiltered !< last time the CalcOutput/Bladed DLL was filtered [s] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: xd_BlPitchFilter !< blade pitch filter [-] - TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module misc vars - blade [-] - TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module misc vars - nacelle [-] - TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module misc vars - tower [-] - TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: SStC !< StC module misc vars - substructure [-] - END TYPE SrvD_MiscVarType -! ======================= -! ========= SrvD_ParameterType ======= - TYPE, PUBLIC :: SrvD_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - REAL(DbKi) :: HSSBrDT !< Time it takes for HSS brake to reach full deployment once deployed [seconds] - REAL(ReKi) :: HSSBrTqF !< Fully deployed HSS brake torque [-] - REAL(ReKi) :: SIG_POSl !< Pullout slip [-] - REAL(ReKi) :: SIG_POTq !< Pullout torque [-] - REAL(ReKi) :: SIG_SlPc !< Rated generator slip percentage [-] - REAL(ReKi) :: SIG_Slop !< Torque/Speed slope for simple induction generator [-] - REAL(ReKi) :: SIG_SySp !< Synchronous (zero-torque) generator speed [rad/s] - REAL(ReKi) :: TEC_A0 !< A0 term for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_C0 !< C0 term for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_C1 !< C1 term for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_C2 !< C2 term for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_K2 !< K2 term for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_MR !< Magnetizing reactance for Thevenin-equivalent circuit [ohms] - REAL(ReKi) :: TEC_Re1 !< Thevenin's equivalent stator resistance (ohms) [ohms] - REAL(ReKi) :: TEC_RLR !< Rotor leakage reactance for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_RRes !< Rotor resistance for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_SRes !< Stator resistance for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_SySp !< Synchronous speed for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_V1a !< Source voltage for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_VLL !< Line-to-line RMS voltage for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_Xe1 !< Thevenin's equivalent stator leakage reactance (ohms) [ohms] - REAL(ReKi) :: GenEff !< Generator efficiency [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchInit !< Initial blade pitch angles [radians] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchF !< Final blade pitch [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PitManRat !< Pitch rates at which override pitch maneuvers head toward final pitch angles (does not include sign) [rad/s] - REAL(ReKi) :: YawManRat !< Yaw rate at which override yaw maneuver head toward for final yaw angle (does not include sign) [rad/s] - REAL(ReKi) :: NacYawF !< Final yaw angle after override yaw maneuver [-] - REAL(ReKi) :: SpdGenOn !< Generator speed to turn on the generator for a startup [-] - REAL(DbKi) :: THSSBrDp !< Time to initiate deployment of the shaft brake [s] - REAL(DbKi) :: THSSBrFl !< Time at which shaft brake is fully deployed [s] - REAL(DbKi) :: TimGenOf !< Time to turn off generator for braking or modeling a run-away [s] - REAL(DbKi) :: TimGenOn !< Time to turn on generator for startup [s] - REAL(DbKi) :: TPCOn !< Time to enable active pitch control [s] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TPitManS !< Time to start pitch maneuvers for each blade [s] - REAL(DbKi) :: TYawManS !< Time to start override yaw maneuver [s] - REAL(DbKi) :: TYCOn !< Time to enable active yaw control [s] - REAL(ReKi) :: VS_RtGnSp !< Rated generator speed (HSS side) [rad/s] - REAL(ReKi) :: VS_RtTq !< Rated generator torque/constant generator torque in Region 3 (HSS side) [N-m] - REAL(ReKi) :: VS_Slope !< Torque/speed slope of region 2 1/2 induction generator [-] - REAL(ReKi) :: VS_SlPc !< Rated generator slip percentage in Region 2 1/2 [-] - REAL(ReKi) :: VS_SySp !< Synchronous speed of region 2 1/2 induction generator [-] - REAL(ReKi) :: VS_TrGnSp !< Transitional generator speed between regions 2 and 2 1/2 [-] - REAL(ReKi) :: YawPosCom !< Commanded yaw angle from user-defined routines [rad] - REAL(ReKi) :: YawRateCom !< Commanded yaw rate from user-defined routines [rad/s] - INTEGER(IntKi) :: GenModel !< Generator model [-] - INTEGER(IntKi) :: HSSBrMode !< HSS brake model [-] - INTEGER(IntKi) :: PCMode !< Pitch control mode [-] - INTEGER(IntKi) :: VSContrl !< Variable-speed-generator control switch [-] - INTEGER(IntKi) :: YCMode !< Yaw control mode [-] - LOGICAL :: GenTiStp !< Stop generator based upon T: time or F: generator power = 0 [-] - LOGICAL :: GenTiStr !< Start generator based upon T: time or F: generator speed [-] - REAL(ReKi) :: VS_Rgn2K !< Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] [N-m/(rad/s)^2] - REAL(ReKi) :: YawNeut !< Neutral yaw position--yaw spring force is zero at this yaw [radians] - REAL(ReKi) :: YawSpr !< Nacelle-yaw spring constant [N-m/rad] - REAL(ReKi) :: YawDamp !< Nacelle-yaw constant [N-m/(rad/s)] - REAL(DbKi) :: TpBrDT !< Time for tip-brake to reach full deployment once released [s] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TBDepISp !< Deployment-initiation speed for the tip brakes [rad/s] - REAL(ReKi) :: TBDrConN !< Tip-brake drag constant during normal operation, Cd*Area [-] - REAL(ReKi) :: TBDrConD !< Tip-brake drag constant during fully-deployed operation, Cd*Area [-] - INTEGER(IntKi) :: NumBl !< Number of blades on the turbine [-] - INTEGER(IntKi) :: NumBStC !< Number of blade structural controllers (integer) [-] - INTEGER(IntKi) :: NumNStC !< Number of nacelle structural controllers (integer) [-] - INTEGER(IntKi) :: NumTStC !< Number of tower structural controllers (integer) [-] - INTEGER(IntKi) :: NumSStC !< Number of substructure structural controllers (integer) [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] - INTEGER(IntKi) :: NumOuts_DLL !< Number of logging channels output from the DLL (set at initialization) [-] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] - TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] - CHARACTER(1) :: Delim !< Column delimiter for output text files [-] - LOGICAL :: UseBladedInterface !< Flag that determines if BladedInterface was used [-] - LOGICAL :: UseLegacyInterface !< Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER) [-] - TYPE(DLL_Type) :: DLL_Trgt !< The addresses and names of the Bladed DLL and its procedure [-] - LOGICAL :: DLL_Ramp !< determines if there is a DLL_DT-ramp time delay (true only when DLL_DT /= DT) [-] - REAL(ReKi) :: BlAlpha !< parameter for low-pass filter of blade pitch commands from the controller DLL [-] - INTEGER(IntKi) :: DLL_n !< number of steps between the controller being called and SrvD being called [-] - INTEGER(IntKi) :: avcOUTNAME_LEN !< Length of the avcOUTNAME character array passed to/from the DLL [-] - REAL(ReKi) :: NacYaw_North !< Reference yaw angle of the nacelle when the upwind end points due North [rad] - REAL(ReKi) :: AvgWindSpeed !< average wind speed for the simulation [m/s] - REAL(ReKi) :: AirDens !< air density [kg/m^3] - INTEGER(IntKi) :: TrimCase !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] [-] - REAL(ReKi) :: TrimGain !< Proportional gain for the rotational speed error (>0) [used only if TrimCase>0] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] - REAL(ReKi) :: RotSpeedRef !< Reference rotor speed [rad/s] - TYPE(StC_ParameterType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module parameters - blade [-] - TYPE(StC_ParameterType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module parameters - nacelle [-] - TYPE(StC_ParameterType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module parameters - tower [-] - TYPE(StC_ParameterType) , DIMENSION(:), ALLOCATABLE :: SStC !< StC module parameters - substructure [-] - LOGICAL :: UseSC !< Supercontroller on/off flag [-] - END TYPE SrvD_ParameterType -! ======================= -! ========= SrvD_InputType ======= - TYPE, PUBLIC :: SrvD_InputType - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitch !< Current blade pitch angles [radians] - REAL(ReKi) :: Yaw !< Current nacelle yaw [radians] - REAL(ReKi) :: YawRate !< Current nacelle yaw rate [rad/s] - REAL(ReKi) :: LSS_Spd !< Low-speed shaft (LSS) speed at entrance to gearbox [rad/s] - REAL(ReKi) :: HSS_Spd !< High-speed shaft (HSS) speed [rad/s] - REAL(ReKi) :: RotSpeed !< Rotor azimuth angular speed [rad/s] - REAL(ReKi) :: ExternalYawPosCom !< Commanded nacelle yaw position from Simulink or Labview [radians] - REAL(ReKi) :: ExternalYawRateCom !< Commanded nacelle yaw rate from Simulink or Labview [rad/s] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ExternalBlPitchCom !< Commanded blade pitch from Simulink or LabVIEW [radians] - REAL(ReKi) :: ExternalGenTrq !< Electrical generator torque from Simulink or LabVIEW [N-m] - REAL(ReKi) :: ExternalElecPwr !< Electrical power from Simulink or LabVIEW [W] - REAL(ReKi) :: ExternalHSSBrFrac !< Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW [-] - REAL(ReKi) :: TwrAccel !< Tower acceleration for tower feedback control (user routine only) [m/s^2] - REAL(ReKi) :: YawErr !< Yaw error [radians] - REAL(ReKi) :: WindDir !< Wind direction [radians] - REAL(ReKi) , DIMENSION(1:3) :: RootMyc !< Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3) [N-m] - REAL(ReKi) :: YawBrTAxp !< Tower-top / yaw bearing fore-aft (translational) acceleration (absolute) [m/s^2] - REAL(ReKi) :: YawBrTAyp !< Tower-top / yaw bearing side-to-side (translational) acceleration (absolute) [m/s^2] - REAL(ReKi) :: LSSTipPxa !< Rotor azimuth angle (position) [radians] - REAL(ReKi) , DIMENSION(1:3) :: RootMxc !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] - REAL(ReKi) :: LSSTipMxa !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMya !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMza !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMys !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMzs !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: YawBrMyn !< Rotating (with nacelle) tower-top / yaw bearing pitch moment [N-m] - REAL(ReKi) :: YawBrMzn !< Tower-top / yaw bearing yaw moment [N-m] - REAL(ReKi) :: NcIMURAxs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: NcIMURAys !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: NcIMURAzs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: RotPwr !< Rotor power (this is equivalent to the low-speed shaft power) [W] - REAL(ReKi) :: HorWindV !< Horizontal hub-height wind velocity magnitude [m/s] - REAL(ReKi) :: YawAngle !< Estimate of yaw (nacelle + platform) [radians] - TYPE(StC_InputType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module inputs - blade [-] - TYPE(StC_InputType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module inputs - nacelle [-] - TYPE(StC_InputType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module inputs - tower [-] - TYPE(StC_InputType) , DIMENSION(:), ALLOCATABLE :: SStC !< StC module inputs - substructure [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: fromSC !< A swap array: used to pass turbine specific input data to the DLL controller from the supercontroller [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: fromSCglob !< A swap array: used to pass global input data to the DLL controller from the supercontroller [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: Lidar !< A swap array: used to pass input data to the DLL controller from the Lidar [-] - END TYPE SrvD_InputType -! ======================= -! ========= SrvD_OutputType ======= - TYPE, PUBLIC :: SrvD_OutputType - 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 :: BlPitchCom !< Commanded blade pitch angles [radians] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlAirfoilCom !< Commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables) [-] - REAL(ReKi) :: YawMom !< Torque transmitted through the yaw bearing [N-m] - REAL(ReKi) :: GenTrq !< Electrical generator torque [N-m] - REAL(ReKi) :: HSSBrTrqC !< Commanded HSS brake torque [N-m] - REAL(ReKi) :: ElecPwr !< Electrical power [W] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TBDrCon !< Instantaneous tip-brake drag constant, Cd*Area [-] - TYPE(StC_OutputType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module outputs - blade [-] - TYPE(StC_OutputType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module outputs - nacelle [-] - TYPE(StC_OutputType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module outputs - tower [-] - TYPE(StC_OutputType) , DIMENSION(:), ALLOCATABLE :: SStC !< StC module outputs - substructure [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: toSC !< A swap array: used to pass output data from the DLL controller to the supercontroller [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: Lidar !< A swap array: used to pass output data from the DLL controller to the Lidar [-] - END TYPE SrvD_OutputType -! ======================= -CONTAINS - SUBROUTINE SrvD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(SrvD_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%NumBl = SrcInitInputData%NumBl - DstInitInputData%RootName = SrcInitInputData%RootName -IF (ALLOCATED(SrcInitInputData%BlPitchInit)) THEN - i1_l = LBOUND(SrcInitInputData%BlPitchInit,1) - i1_u = UBOUND(SrcInitInputData%BlPitchInit,1) - IF (.NOT. ALLOCATED(DstInitInputData%BlPitchInit)) THEN - ALLOCATE(DstInitInputData%BlPitchInit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlPitchInit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BlPitchInit = SrcInitInputData%BlPitchInit -ENDIF - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%NacPosition = SrcInitInputData%NacPosition - DstInitInputData%NacOrientation = SrcInitInputData%NacOrientation - DstInitInputData%TwrBasePos = SrcInitInputData%TwrBasePos - DstInitInputData%TwrBaseOrient = SrcInitInputData%TwrBaseOrient - DstInitInputData%PlatformPos = SrcInitInputData%PlatformPos - DstInitInputData%PlatformOrient = SrcInitInputData%PlatformOrient - DstInitInputData%Tmax = SrcInitInputData%Tmax - DstInitInputData%AvgWindSpeed = SrcInitInputData%AvgWindSpeed - DstInitInputData%AirDens = SrcInitInputData%AirDens - DstInitInputData%NumSC2CtrlGlob = SrcInitInputData%NumSC2CtrlGlob - DstInitInputData%NumSC2Ctrl = SrcInitInputData%NumSC2Ctrl - DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC - DstInitInputData%TrimCase = SrcInitInputData%TrimCase - DstInitInputData%TrimGain = SrcInitInputData%TrimGain - DstInitInputData%RotSpeedRef = SrcInitInputData%RotSpeedRef -IF (ALLOCATED(SrcInitInputData%BladeRootPosition)) THEN - i1_l = LBOUND(SrcInitInputData%BladeRootPosition,1) - i1_u = UBOUND(SrcInitInputData%BladeRootPosition,1) - i2_l = LBOUND(SrcInitInputData%BladeRootPosition,2) - i2_u = UBOUND(SrcInitInputData%BladeRootPosition,2) - IF (.NOT. ALLOCATED(DstInitInputData%BladeRootPosition)) THEN - ALLOCATE(DstInitInputData%BladeRootPosition(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BladeRootPosition = SrcInitInputData%BladeRootPosition -ENDIF -IF (ALLOCATED(SrcInitInputData%BladeRootOrientation)) THEN - i1_l = LBOUND(SrcInitInputData%BladeRootOrientation,1) - i1_u = UBOUND(SrcInitInputData%BladeRootOrientation,1) - i2_l = LBOUND(SrcInitInputData%BladeRootOrientation,2) - i2_u = UBOUND(SrcInitInputData%BladeRootOrientation,2) - i3_l = LBOUND(SrcInitInputData%BladeRootOrientation,3) - i3_u = UBOUND(SrcInitInputData%BladeRootOrientation,3) - IF (.NOT. ALLOCATED(DstInitInputData%BladeRootOrientation)) THEN - ALLOCATE(DstInitInputData%BladeRootOrientation(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootOrientation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BladeRootOrientation = SrcInitInputData%BladeRootOrientation -ENDIF - DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitInputData%fromSCGlob)) THEN - i1_l = LBOUND(SrcInitInputData%fromSCGlob,1) - i1_u = UBOUND(SrcInitInputData%fromSCGlob,1) - IF (.NOT. ALLOCATED(DstInitInputData%fromSCGlob)) THEN - ALLOCATE(DstInitInputData%fromSCGlob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%fromSCGlob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%fromSCGlob = SrcInitInputData%fromSCGlob -ENDIF -IF (ALLOCATED(SrcInitInputData%fromSC)) THEN - i1_l = LBOUND(SrcInitInputData%fromSC,1) - i1_u = UBOUND(SrcInitInputData%fromSC,1) - IF (.NOT. ALLOCATED(DstInitInputData%fromSC)) THEN - ALLOCATE(DstInitInputData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%fromSC = SrcInitInputData%fromSC -ENDIF - END SUBROUTINE SrvD_CopyInitInput - - SUBROUTINE SrvD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(SrvD_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyInitInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitInputData%BlPitchInit)) THEN - DEALLOCATE(InitInputData%BlPitchInit) -ENDIF -IF (ALLOCATED(InitInputData%BladeRootPosition)) THEN - DEALLOCATE(InitInputData%BladeRootPosition) -ENDIF -IF (ALLOCATED(InitInputData%BladeRootOrientation)) THEN - DEALLOCATE(InitInputData%BladeRootOrientation) -ENDIF - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedPrimaryInputData, ErrStat, ErrMsg ) -IF (ALLOCATED(InitInputData%fromSCGlob)) THEN - DEALLOCATE(InitInputData%fromSCGlob) -ENDIF -IF (ALLOCATED(InitInputData%fromSC)) THEN - DEALLOCATE(InitInputData%fromSC) -ENDIF - END SUBROUTINE SrvD_DestroyInitInput - - SUBROUTINE SrvD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1 ! Linearize - Int_BufSz = Int_BufSz + 1 ! NumBl - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! BlPitchInit allocated yes/no - IF ( ALLOCATED(InData%BlPitchInit) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitchInit upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchInit) ! BlPitchInit - END IF - Re_BufSz = Re_BufSz + SIZE(InData%Gravity) ! Gravity - Re_BufSz = Re_BufSz + SIZE(InData%NacPosition) ! NacPosition - Db_BufSz = Db_BufSz + SIZE(InData%NacOrientation) ! NacOrientation - Re_BufSz = Re_BufSz + SIZE(InData%TwrBasePos) ! TwrBasePos - Db_BufSz = Db_BufSz + SIZE(InData%TwrBaseOrient) ! TwrBaseOrient - Re_BufSz = Re_BufSz + SIZE(InData%PlatformPos) ! PlatformPos - Db_BufSz = Db_BufSz + SIZE(InData%PlatformOrient) ! PlatformOrient - Db_BufSz = Db_BufSz + 1 ! Tmax - Re_BufSz = Re_BufSz + 1 ! AvgWindSpeed - Re_BufSz = Re_BufSz + 1 ! AirDens - Int_BufSz = Int_BufSz + 1 ! NumSC2CtrlGlob - Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl - Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC - Int_BufSz = Int_BufSz + 1 ! TrimCase - Re_BufSz = Re_BufSz + 1 ! TrimGain - Re_BufSz = Re_BufSz + 1 ! RotSpeedRef - Int_BufSz = Int_BufSz + 1 ! BladeRootPosition allocated yes/no - IF ( ALLOCATED(InData%BladeRootPosition) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BladeRootPosition upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BladeRootPosition) ! BladeRootPosition - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootOrientation allocated yes/no - IF ( ALLOCATED(InData%BladeRootOrientation) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! BladeRootOrientation upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BladeRootOrientation) ! BladeRootOrientation - END IF - Int_BufSz = Int_BufSz + 1 ! UseInputFile - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PassedPrimaryInputData: size of buffers for each call to pack subtype - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedPrimaryInputData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedPrimaryInputData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedPrimaryInputData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedPrimaryInputData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! fromSCGlob allocated yes/no - IF ( ALLOCATED(InData%fromSCGlob) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSCGlob upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSCGlob) ! fromSCGlob - END IF - Int_BufSz = Int_BufSz + 1 ! fromSC allocated yes/no - IF ( ALLOCATED(InData%fromSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSC) ! fromSC - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%BlPitchInit) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitchInit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchInit,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitchInit,1), UBOUND(InData%BlPitchInit,1) - ReKiBuf(Re_Xferred) = InData%BlPitchInit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%Gravity,1), UBOUND(InData%Gravity,1) - ReKiBuf(Re_Xferred) = InData%Gravity(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%NacPosition,1), UBOUND(InData%NacPosition,1) - ReKiBuf(Re_Xferred) = InData%NacPosition(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%NacOrientation,2), UBOUND(InData%NacOrientation,2) - DO i1 = LBOUND(InData%NacOrientation,1), UBOUND(InData%NacOrientation,1) - DbKiBuf(Db_Xferred) = InData%NacOrientation(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%TwrBasePos,1), UBOUND(InData%TwrBasePos,1) - ReKiBuf(Re_Xferred) = InData%TwrBasePos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%TwrBaseOrient,2), UBOUND(InData%TwrBaseOrient,2) - DO i1 = LBOUND(InData%TwrBaseOrient,1), UBOUND(InData%TwrBaseOrient,1) - DbKiBuf(Db_Xferred) = InData%TwrBaseOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%PlatformPos,1), UBOUND(InData%PlatformPos,1) - ReKiBuf(Re_Xferred) = InData%PlatformPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%PlatformOrient,2), UBOUND(InData%PlatformOrient,2) - DO i1 = LBOUND(InData%PlatformOrient,1), UBOUND(InData%PlatformOrient,1) - DbKiBuf(Db_Xferred) = InData%PlatformOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DbKiBuf(Db_Xferred) = InData%Tmax - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AvgWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2CtrlGlob - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TrimCase - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TrimGain - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeedRef - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BladeRootPosition) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootPosition,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootPosition,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootPosition,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootPosition,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BladeRootPosition,2), UBOUND(InData%BladeRootPosition,2) - DO i1 = LBOUND(InData%BladeRootPosition,1), UBOUND(InData%BladeRootPosition,1) - ReKiBuf(Re_Xferred) = InData%BladeRootPosition(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeRootOrientation) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootOrientation,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootOrientation,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootOrientation,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootOrientation,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootOrientation,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootOrientation,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%BladeRootOrientation,3), UBOUND(InData%BladeRootOrientation,3) - DO i2 = LBOUND(InData%BladeRootOrientation,2), UBOUND(InData%BladeRootOrientation,2) - DO i1 = LBOUND(InData%BladeRootOrientation,1), UBOUND(InData%BladeRootOrientation,1) - DbKiBuf(Db_Xferred) = InData%BladeRootOrientation(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, OnlySize ) ! PassedPrimaryInputData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%fromSCGlob) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSCGlob,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSCGlob,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSCGlob,1), UBOUND(InData%fromSCGlob,1) - ReKiBuf(Re_Xferred) = InData%fromSCGlob(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fromSC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSC,1), UBOUND(InData%fromSC,1) - ReKiBuf(Re_Xferred) = InData%fromSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SrvD_PackInitInput - - SUBROUTINE SrvD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchInit not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlPitchInit)) DEALLOCATE(OutData%BlPitchInit) - ALLOCATE(OutData%BlPitchInit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitchInit,1), UBOUND(OutData%BlPitchInit,1) - OutData%BlPitchInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%Gravity,1) - i1_u = UBOUND(OutData%Gravity,1) - DO i1 = LBOUND(OutData%Gravity,1), UBOUND(OutData%Gravity,1) - OutData%Gravity(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%NacPosition,1) - i1_u = UBOUND(OutData%NacPosition,1) - DO i1 = LBOUND(OutData%NacPosition,1), UBOUND(OutData%NacPosition,1) - OutData%NacPosition(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%NacOrientation,1) - i1_u = UBOUND(OutData%NacOrientation,1) - i2_l = LBOUND(OutData%NacOrientation,2) - i2_u = UBOUND(OutData%NacOrientation,2) - DO i2 = LBOUND(OutData%NacOrientation,2), UBOUND(OutData%NacOrientation,2) - DO i1 = LBOUND(OutData%NacOrientation,1), UBOUND(OutData%NacOrientation,1) - OutData%NacOrientation(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%TwrBasePos,1) - i1_u = UBOUND(OutData%TwrBasePos,1) - DO i1 = LBOUND(OutData%TwrBasePos,1), UBOUND(OutData%TwrBasePos,1) - OutData%TwrBasePos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TwrBaseOrient,1) - i1_u = UBOUND(OutData%TwrBaseOrient,1) - i2_l = LBOUND(OutData%TwrBaseOrient,2) - i2_u = UBOUND(OutData%TwrBaseOrient,2) - DO i2 = LBOUND(OutData%TwrBaseOrient,2), UBOUND(OutData%TwrBaseOrient,2) - DO i1 = LBOUND(OutData%TwrBaseOrient,1), UBOUND(OutData%TwrBaseOrient,1) - OutData%TwrBaseOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%PlatformPos,1) - i1_u = UBOUND(OutData%PlatformPos,1) - DO i1 = LBOUND(OutData%PlatformPos,1), UBOUND(OutData%PlatformPos,1) - OutData%PlatformPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PlatformOrient,1) - i1_u = UBOUND(OutData%PlatformOrient,1) - i2_l = LBOUND(OutData%PlatformOrient,2) - i2_u = UBOUND(OutData%PlatformOrient,2) - DO i2 = LBOUND(OutData%PlatformOrient,2), UBOUND(OutData%PlatformOrient,2) - DO i1 = LBOUND(OutData%PlatformOrient,1), UBOUND(OutData%PlatformOrient,1) - OutData%PlatformOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - OutData%Tmax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%AvgWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumSC2CtrlGlob = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TrimCase = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TrimGain = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeedRef = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootPosition not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeRootPosition)) DEALLOCATE(OutData%BladeRootPosition) - ALLOCATE(OutData%BladeRootPosition(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BladeRootPosition,2), UBOUND(OutData%BladeRootPosition,2) - DO i1 = LBOUND(OutData%BladeRootPosition,1), UBOUND(OutData%BladeRootPosition,1) - OutData%BladeRootPosition(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootOrientation not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeRootOrientation)) DEALLOCATE(OutData%BladeRootOrientation) - ALLOCATE(OutData%BladeRootOrientation(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootOrientation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%BladeRootOrientation,3), UBOUND(OutData%BladeRootOrientation,3) - DO i2 = LBOUND(OutData%BladeRootOrientation,2), UBOUND(OutData%BladeRootOrientation,2) - DO i1 = LBOUND(OutData%BladeRootOrientation,1), UBOUND(OutData%BladeRootOrientation,1) - OutData%BladeRootOrientation(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackfileinfotype( Re_Buf, Db_Buf, Int_Buf, OutData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) ! PassedPrimaryInputData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSCGlob not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%fromSCGlob)) DEALLOCATE(OutData%fromSCGlob) - ALLOCATE(OutData%fromSCGlob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCGlob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSCGlob,1), UBOUND(OutData%fromSCGlob,1) - OutData%fromSCGlob(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%fromSC)) DEALLOCATE(OutData%fromSC) - ALLOCATE(OutData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) - OutData%fromSC(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SrvD_UnPackInitInput - - SUBROUTINE SrvD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SrvD_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitOutputData%CouplingScheme = SrcInitOutputData%CouplingScheme - DstInitOutputData%UseHSSBrake = SrcInitOutputData%UseHSSBrake -IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN - ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN - ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_y)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_y,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_y)) THEN - ALLOCATE(DstInitOutputData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_u)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_u,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_u)) THEN - ALLOCATE(DstInitOutputData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN - i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) - i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN - ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u -ENDIF - END SUBROUTINE SrvD_CopyInitOutput - - SUBROUTINE SrvD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(SrvD_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyInitOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, ErrMsg ) -IF (ALLOCATED(InitOutputData%LinNames_y)) THEN - DEALLOCATE(InitOutputData%LinNames_y) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_u)) THEN - DEALLOCATE(InitOutputData%LinNames_u) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_y)) THEN - DEALLOCATE(InitOutputData%RotFrame_y) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_u)) THEN - DEALLOCATE(InitOutputData%RotFrame_u) -ENDIF -IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN - DEALLOCATE(InitOutputData%IsLoad_u) -ENDIF - END SUBROUTINE SrvD_DestroyInitOutput - - SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! CouplingScheme - Int_BufSz = Int_BufSz + 1 ! UseHSSBrake - Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%CouplingScheme - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseHSSBrake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SrvD_PackInitOutput - - SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%CouplingScheme = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UseHSSBrake = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseHSSBrake) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) - ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) - OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) - OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SrvD_UnPackInitOutput - - SUBROUTINE SrvD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(SrvD_InputFile), INTENT(INOUT) :: DstInputFileData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%DT = SrcInputFileData%DT - DstInputFileData%Echo = SrcInputFileData%Echo - DstInputFileData%PCMode = SrcInputFileData%PCMode - DstInputFileData%TPCOn = SrcInputFileData%TPCOn - DstInputFileData%TPitManS = SrcInputFileData%TPitManS - DstInputFileData%PitManRat = SrcInputFileData%PitManRat - DstInputFileData%BlPitchF = SrcInputFileData%BlPitchF - DstInputFileData%VSContrl = SrcInputFileData%VSContrl - DstInputFileData%GenModel = SrcInputFileData%GenModel - DstInputFileData%GenEff = SrcInputFileData%GenEff - DstInputFileData%GenTiStr = SrcInputFileData%GenTiStr - DstInputFileData%GenTiStp = SrcInputFileData%GenTiStp - DstInputFileData%SpdGenOn = SrcInputFileData%SpdGenOn - DstInputFileData%TimGenOn = SrcInputFileData%TimGenOn - DstInputFileData%TimGenOf = SrcInputFileData%TimGenOf - DstInputFileData%VS_RtGnSp = SrcInputFileData%VS_RtGnSp - DstInputFileData%VS_RtTq = SrcInputFileData%VS_RtTq - DstInputFileData%VS_Rgn2K = SrcInputFileData%VS_Rgn2K - DstInputFileData%VS_SlPc = SrcInputFileData%VS_SlPc - DstInputFileData%SIG_SlPc = SrcInputFileData%SIG_SlPc - DstInputFileData%SIG_SySp = SrcInputFileData%SIG_SySp - DstInputFileData%SIG_RtTq = SrcInputFileData%SIG_RtTq - DstInputFileData%SIG_PORt = SrcInputFileData%SIG_PORt - DstInputFileData%TEC_Freq = SrcInputFileData%TEC_Freq - DstInputFileData%TEC_NPol = SrcInputFileData%TEC_NPol - DstInputFileData%TEC_SRes = SrcInputFileData%TEC_SRes - DstInputFileData%TEC_RRes = SrcInputFileData%TEC_RRes - DstInputFileData%TEC_VLL = SrcInputFileData%TEC_VLL - DstInputFileData%TEC_SLR = SrcInputFileData%TEC_SLR - DstInputFileData%TEC_RLR = SrcInputFileData%TEC_RLR - DstInputFileData%TEC_MR = SrcInputFileData%TEC_MR - DstInputFileData%HSSBrMode = SrcInputFileData%HSSBrMode - DstInputFileData%THSSBrDp = SrcInputFileData%THSSBrDp - DstInputFileData%HSSBrDT = SrcInputFileData%HSSBrDT - DstInputFileData%HSSBrTqF = SrcInputFileData%HSSBrTqF - DstInputFileData%YCMode = SrcInputFileData%YCMode - DstInputFileData%TYCOn = SrcInputFileData%TYCOn - DstInputFileData%YawNeut = SrcInputFileData%YawNeut - DstInputFileData%YawSpr = SrcInputFileData%YawSpr - DstInputFileData%YawDamp = SrcInputFileData%YawDamp - DstInputFileData%TYawManS = SrcInputFileData%TYawManS - DstInputFileData%YawManRat = SrcInputFileData%YawManRat - DstInputFileData%NacYawF = SrcInputFileData%NacYawF - DstInputFileData%SumPrint = SrcInputFileData%SumPrint - DstInputFileData%OutFile = SrcInputFileData%OutFile - DstInputFileData%TabDelim = SrcInputFileData%TabDelim - DstInputFileData%OutFmt = SrcInputFileData%OutFmt - DstInputFileData%Tstart = SrcInputFileData%Tstart - DstInputFileData%NumOuts = SrcInputFileData%NumOuts -IF (ALLOCATED(SrcInputFileData%OutList)) THEN - i1_l = LBOUND(SrcInputFileData%OutList,1) - i1_u = UBOUND(SrcInputFileData%OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN - ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%OutList = SrcInputFileData%OutList -ENDIF - DstInputFileData%DLL_FileName = SrcInputFileData%DLL_FileName - DstInputFileData%DLL_ProcName = SrcInputFileData%DLL_ProcName - DstInputFileData%DLL_InFile = SrcInputFileData%DLL_InFile - DstInputFileData%DLL_DT = SrcInputFileData%DLL_DT - DstInputFileData%DLL_Ramp = SrcInputFileData%DLL_Ramp - DstInputFileData%BPCutoff = SrcInputFileData%BPCutoff - DstInputFileData%NacYaw_North = SrcInputFileData%NacYaw_North - DstInputFileData%Ptch_Cntrl = SrcInputFileData%Ptch_Cntrl - DstInputFileData%Ptch_SetPnt = SrcInputFileData%Ptch_SetPnt - DstInputFileData%Ptch_Min = SrcInputFileData%Ptch_Min - DstInputFileData%Ptch_Max = SrcInputFileData%Ptch_Max - DstInputFileData%PtchRate_Min = SrcInputFileData%PtchRate_Min - DstInputFileData%PtchRate_Max = SrcInputFileData%PtchRate_Max - DstInputFileData%Gain_OM = SrcInputFileData%Gain_OM - DstInputFileData%GenSpd_MinOM = SrcInputFileData%GenSpd_MinOM - DstInputFileData%GenSpd_MaxOM = SrcInputFileData%GenSpd_MaxOM - DstInputFileData%GenSpd_Dem = SrcInputFileData%GenSpd_Dem - DstInputFileData%GenTrq_Dem = SrcInputFileData%GenTrq_Dem - DstInputFileData%GenPwr_Dem = SrcInputFileData%GenPwr_Dem - DstInputFileData%DLL_NumTrq = SrcInputFileData%DLL_NumTrq -IF (ALLOCATED(SrcInputFileData%GenSpd_TLU)) THEN - i1_l = LBOUND(SrcInputFileData%GenSpd_TLU,1) - i1_u = UBOUND(SrcInputFileData%GenSpd_TLU,1) - IF (.NOT. ALLOCATED(DstInputFileData%GenSpd_TLU)) THEN - ALLOCATE(DstInputFileData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%GenSpd_TLU = SrcInputFileData%GenSpd_TLU -ENDIF -IF (ALLOCATED(SrcInputFileData%GenTrq_TLU)) THEN - i1_l = LBOUND(SrcInputFileData%GenTrq_TLU,1) - i1_u = UBOUND(SrcInputFileData%GenTrq_TLU,1) - IF (.NOT. ALLOCATED(DstInputFileData%GenTrq_TLU)) THEN - ALLOCATE(DstInputFileData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%GenTrq_TLU = SrcInputFileData%GenTrq_TLU -ENDIF - DstInputFileData%UseLegacyInterface = SrcInputFileData%UseLegacyInterface - DstInputFileData%NumBStC = SrcInputFileData%NumBStC -IF (ALLOCATED(SrcInputFileData%BStCfiles)) THEN - i1_l = LBOUND(SrcInputFileData%BStCfiles,1) - i1_u = UBOUND(SrcInputFileData%BStCfiles,1) - IF (.NOT. ALLOCATED(DstInputFileData%BStCfiles)) THEN - ALLOCATE(DstInputFileData%BStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%BStCfiles = SrcInputFileData%BStCfiles -ENDIF - DstInputFileData%NumNStC = SrcInputFileData%NumNStC -IF (ALLOCATED(SrcInputFileData%NStCfiles)) THEN - i1_l = LBOUND(SrcInputFileData%NStCfiles,1) - i1_u = UBOUND(SrcInputFileData%NStCfiles,1) - IF (.NOT. ALLOCATED(DstInputFileData%NStCfiles)) THEN - ALLOCATE(DstInputFileData%NStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%NStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%NStCfiles = SrcInputFileData%NStCfiles -ENDIF - DstInputFileData%NumTStC = SrcInputFileData%NumTStC -IF (ALLOCATED(SrcInputFileData%TStCfiles)) THEN - i1_l = LBOUND(SrcInputFileData%TStCfiles,1) - i1_u = UBOUND(SrcInputFileData%TStCfiles,1) - IF (.NOT. ALLOCATED(DstInputFileData%TStCfiles)) THEN - ALLOCATE(DstInputFileData%TStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TStCfiles = SrcInputFileData%TStCfiles -ENDIF - DstInputFileData%NumSStC = SrcInputFileData%NumSStC -IF (ALLOCATED(SrcInputFileData%SStCfiles)) THEN - i1_l = LBOUND(SrcInputFileData%SStCfiles,1) - i1_u = UBOUND(SrcInputFileData%SStCfiles,1) - IF (.NOT. ALLOCATED(DstInputFileData%SStCfiles)) THEN - ALLOCATE(DstInputFileData%SStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%SStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%SStCfiles = SrcInputFileData%SStCfiles -ENDIF - END SUBROUTINE SrvD_CopyInputFile - - SUBROUTINE SrvD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(SrvD_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyInputFile' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF -IF (ALLOCATED(InputFileData%GenSpd_TLU)) THEN - DEALLOCATE(InputFileData%GenSpd_TLU) -ENDIF -IF (ALLOCATED(InputFileData%GenTrq_TLU)) THEN - DEALLOCATE(InputFileData%GenTrq_TLU) -ENDIF -IF (ALLOCATED(InputFileData%BStCfiles)) THEN - DEALLOCATE(InputFileData%BStCfiles) -ENDIF -IF (ALLOCATED(InputFileData%NStCfiles)) THEN - DEALLOCATE(InputFileData%NStCfiles) -ENDIF -IF (ALLOCATED(InputFileData%TStCfiles)) THEN - DEALLOCATE(InputFileData%TStCfiles) -ENDIF -IF (ALLOCATED(InputFileData%SStCfiles)) THEN - DEALLOCATE(InputFileData%SStCfiles) -ENDIF - END SUBROUTINE SrvD_DestroyInputFile - - SUBROUTINE SrvD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_InputFile), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackInputFile' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! Echo - Int_BufSz = Int_BufSz + 1 ! PCMode - Db_BufSz = Db_BufSz + 1 ! TPCOn - Db_BufSz = Db_BufSz + SIZE(InData%TPitManS) ! TPitManS - Re_BufSz = Re_BufSz + SIZE(InData%PitManRat) ! PitManRat - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchF) ! BlPitchF - Int_BufSz = Int_BufSz + 1 ! VSContrl - Int_BufSz = Int_BufSz + 1 ! GenModel - Re_BufSz = Re_BufSz + 1 ! GenEff - Int_BufSz = Int_BufSz + 1 ! GenTiStr - Int_BufSz = Int_BufSz + 1 ! GenTiStp - Re_BufSz = Re_BufSz + 1 ! SpdGenOn - Db_BufSz = Db_BufSz + 1 ! TimGenOn - Db_BufSz = Db_BufSz + 1 ! TimGenOf - Re_BufSz = Re_BufSz + 1 ! VS_RtGnSp - Re_BufSz = Re_BufSz + 1 ! VS_RtTq - Re_BufSz = Re_BufSz + 1 ! VS_Rgn2K - Re_BufSz = Re_BufSz + 1 ! VS_SlPc - Re_BufSz = Re_BufSz + 1 ! SIG_SlPc - Re_BufSz = Re_BufSz + 1 ! SIG_SySp - Re_BufSz = Re_BufSz + 1 ! SIG_RtTq - Re_BufSz = Re_BufSz + 1 ! SIG_PORt - Re_BufSz = Re_BufSz + 1 ! TEC_Freq - Int_BufSz = Int_BufSz + 1 ! TEC_NPol - Re_BufSz = Re_BufSz + 1 ! TEC_SRes - Re_BufSz = Re_BufSz + 1 ! TEC_RRes - Re_BufSz = Re_BufSz + 1 ! TEC_VLL - Re_BufSz = Re_BufSz + 1 ! TEC_SLR - Re_BufSz = Re_BufSz + 1 ! TEC_RLR - Re_BufSz = Re_BufSz + 1 ! TEC_MR - Int_BufSz = Int_BufSz + 1 ! HSSBrMode - Db_BufSz = Db_BufSz + 1 ! THSSBrDp - Db_BufSz = Db_BufSz + 1 ! HSSBrDT - Re_BufSz = Re_BufSz + 1 ! HSSBrTqF - Int_BufSz = Int_BufSz + 1 ! YCMode - Db_BufSz = Db_BufSz + 1 ! TYCOn - Re_BufSz = Re_BufSz + 1 ! YawNeut - Re_BufSz = Re_BufSz + 1 ! YawSpr - Re_BufSz = Re_BufSz + 1 ! YawDamp - Db_BufSz = Db_BufSz + 1 ! TYawManS - Re_BufSz = Re_BufSz + 1 ! YawManRat - Re_BufSz = Re_BufSz + 1 ! NacYawF - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! OutFile - Int_BufSz = Int_BufSz + 1 ! TabDelim - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Db_BufSz = Db_BufSz + 1 ! Tstart - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_FileName) ! DLL_FileName - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_ProcName) ! DLL_ProcName - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_InFile) ! DLL_InFile - Db_BufSz = Db_BufSz + 1 ! DLL_DT - Int_BufSz = Int_BufSz + 1 ! DLL_Ramp - Re_BufSz = Re_BufSz + 1 ! BPCutoff - Re_BufSz = Re_BufSz + 1 ! NacYaw_North - Int_BufSz = Int_BufSz + 1 ! Ptch_Cntrl - Re_BufSz = Re_BufSz + 1 ! Ptch_SetPnt - Re_BufSz = Re_BufSz + 1 ! Ptch_Min - Re_BufSz = Re_BufSz + 1 ! Ptch_Max - Re_BufSz = Re_BufSz + 1 ! PtchRate_Min - Re_BufSz = Re_BufSz + 1 ! PtchRate_Max - Re_BufSz = Re_BufSz + 1 ! Gain_OM - Re_BufSz = Re_BufSz + 1 ! GenSpd_MinOM - Re_BufSz = Re_BufSz + 1 ! GenSpd_MaxOM - Re_BufSz = Re_BufSz + 1 ! GenSpd_Dem - Re_BufSz = Re_BufSz + 1 ! GenTrq_Dem - Re_BufSz = Re_BufSz + 1 ! GenPwr_Dem - Int_BufSz = Int_BufSz + 1 ! DLL_NumTrq - Int_BufSz = Int_BufSz + 1 ! GenSpd_TLU allocated yes/no - IF ( ALLOCATED(InData%GenSpd_TLU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! GenSpd_TLU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GenSpd_TLU) ! GenSpd_TLU - END IF - Int_BufSz = Int_BufSz + 1 ! GenTrq_TLU allocated yes/no - IF ( ALLOCATED(InData%GenTrq_TLU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! GenTrq_TLU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GenTrq_TLU) ! GenTrq_TLU - END IF - Int_BufSz = Int_BufSz + 1 ! UseLegacyInterface - Int_BufSz = Int_BufSz + 1 ! NumBStC - Int_BufSz = Int_BufSz + 1 ! BStCfiles allocated yes/no - IF ( ALLOCATED(InData%BStCfiles) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStCfiles upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BStCfiles)*LEN(InData%BStCfiles) ! BStCfiles - END IF - Int_BufSz = Int_BufSz + 1 ! NumNStC - Int_BufSz = Int_BufSz + 1 ! NStCfiles allocated yes/no - IF ( ALLOCATED(InData%NStCfiles) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStCfiles upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NStCfiles)*LEN(InData%NStCfiles) ! NStCfiles - END IF - Int_BufSz = Int_BufSz + 1 ! NumTStC - Int_BufSz = Int_BufSz + 1 ! TStCfiles allocated yes/no - IF ( ALLOCATED(InData%TStCfiles) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStCfiles upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%TStCfiles)*LEN(InData%TStCfiles) ! TStCfiles - END IF - Int_BufSz = Int_BufSz + 1 ! NumSStC - Int_BufSz = Int_BufSz + 1 ! SStCfiles allocated yes/no - IF ( ALLOCATED(InData%SStCfiles) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStCfiles upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%SStCfiles)*LEN(InData%SStCfiles) ! SStCfiles - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%PCMode - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TPCOn - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%TPitManS,1), UBOUND(InData%TPitManS,1) - DbKiBuf(Db_Xferred) = InData%TPitManS(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PitManRat,1), UBOUND(InData%PitManRat,1) - ReKiBuf(Re_Xferred) = InData%PitManRat(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%BlPitchF,1), UBOUND(InData%BlPitchF,1) - ReKiBuf(Re_Xferred) = InData%BlPitchF(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%VSContrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%GenModel - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenEff - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStr, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdGenOn - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TimGenOn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TimGenOf - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_RtGnSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_RtTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_Rgn2K - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_RtTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_PORt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_Freq - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TEC_NPol - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_SRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_RRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_VLL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_SLR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_RLR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_MR - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%HSSBrMode - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%THSSBrDp - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%HSSBrDT - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSSBrTqF - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%YCMode - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TYCOn - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawNeut - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawDamp - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TYawManS - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawManRat - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYawF - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%Tstart - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(InData%DLL_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_ProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_ProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_InFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%DLL_DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DLL_Ramp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%BPCutoff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYaw_North - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Ptch_Cntrl - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ptch_SetPnt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ptch_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ptch_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtchRate_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtchRate_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gain_OM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenSpd_MinOM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenSpd_MaxOM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenSpd_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenTrq_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenPwr_Dem - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DLL_NumTrq - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%GenSpd_TLU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GenSpd_TLU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenSpd_TLU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%GenSpd_TLU,1), UBOUND(InData%GenSpd_TLU,1) - ReKiBuf(Re_Xferred) = InData%GenSpd_TLU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GenTrq_TLU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GenTrq_TLU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenTrq_TLU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%GenTrq_TLU,1), UBOUND(InData%GenTrq_TLU,1) - ReKiBuf(Re_Xferred) = InData%GenTrq_TLU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseLegacyInterface, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBStC - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BStCfiles) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStCfiles,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStCfiles,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStCfiles,1), UBOUND(InData%BStCfiles,1) - DO I = 1, LEN(InData%BStCfiles) - IntKiBuf(Int_Xferred) = ICHAR(InData%BStCfiles(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumNStC - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NStCfiles) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStCfiles,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStCfiles,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStCfiles,1), UBOUND(InData%NStCfiles,1) - DO I = 1, LEN(InData%NStCfiles) - IntKiBuf(Int_Xferred) = ICHAR(InData%NStCfiles(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumTStC - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TStCfiles) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStCfiles,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStCfiles,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStCfiles,1), UBOUND(InData%TStCfiles,1) - DO I = 1, LEN(InData%TStCfiles) - IntKiBuf(Int_Xferred) = ICHAR(InData%TStCfiles(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumSStC - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%SStCfiles) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStCfiles,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStCfiles,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStCfiles,1), UBOUND(InData%SStCfiles,1) - DO I = 1, LEN(InData%SStCfiles) - IntKiBuf(Int_Xferred) = ICHAR(InData%SStCfiles(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE SrvD_PackInputFile - - SUBROUTINE SrvD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_InputFile), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackInputFile' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_Xferred + 1 - OutData%PCMode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TPCOn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%TPitManS,1) - i1_u = UBOUND(OutData%TPitManS,1) - DO i1 = LBOUND(OutData%TPitManS,1), UBOUND(OutData%TPitManS,1) - OutData%TPitManS(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PitManRat,1) - i1_u = UBOUND(OutData%PitManRat,1) - DO i1 = LBOUND(OutData%PitManRat,1), UBOUND(OutData%PitManRat,1) - OutData%PitManRat(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%BlPitchF,1) - i1_u = UBOUND(OutData%BlPitchF,1) - DO i1 = LBOUND(OutData%BlPitchF,1), UBOUND(OutData%BlPitchF,1) - OutData%BlPitchF(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%VSContrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%GenModel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%GenEff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenTiStr = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStr) - Int_Xferred = Int_Xferred + 1 - OutData%GenTiStp = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStp) - Int_Xferred = Int_Xferred + 1 - OutData%SpdGenOn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TimGenOn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%TimGenOf = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%VS_RtGnSp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_RtTq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_Rgn2K = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_SlPc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SlPc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SySp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_RtTq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_PORt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_Freq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_NPol = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TEC_SRes = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RRes = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_VLL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_SLR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RLR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_MR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrMode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%THSSBrDp = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrTqF = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YCMode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TYCOn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%YawNeut = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawDamp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TYawManS = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%YawManRat = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacYawF = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%OutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Tstart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutList)) DEALLOCATE(OutData%OutList) - ALLOCATE(OutData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(OutData%DLL_FileName) - OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_ProcName) - OutData%DLL_ProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_InFile) - OutData%DLL_InFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%DLL_DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%DLL_Ramp = TRANSFER(IntKiBuf(Int_Xferred), OutData%DLL_Ramp) - Int_Xferred = Int_Xferred + 1 - OutData%BPCutoff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacYaw_North = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Cntrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Ptch_SetPnt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Min = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Max = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Min = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Max = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Gain_OM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MinOM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MaxOM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_Dem = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq_Dem = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenPwr_Dem = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DLL_NumTrq = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenSpd_TLU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GenSpd_TLU)) DEALLOCATE(OutData%GenSpd_TLU) - ALLOCATE(OutData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%GenSpd_TLU,1), UBOUND(OutData%GenSpd_TLU,1) - OutData%GenSpd_TLU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenTrq_TLU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GenTrq_TLU)) DEALLOCATE(OutData%GenTrq_TLU) - ALLOCATE(OutData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%GenTrq_TLU,1), UBOUND(OutData%GenTrq_TLU,1) - OutData%GenTrq_TLU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%UseLegacyInterface = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseLegacyInterface) - Int_Xferred = Int_Xferred + 1 - OutData%NumBStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStCfiles not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStCfiles)) DEALLOCATE(OutData%BStCfiles) - ALLOCATE(OutData%BStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStCfiles,1), UBOUND(OutData%BStCfiles,1) - DO I = 1, LEN(OutData%BStCfiles) - OutData%BStCfiles(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%NumNStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStCfiles not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NStCfiles)) DEALLOCATE(OutData%NStCfiles) - ALLOCATE(OutData%NStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStCfiles,1), UBOUND(OutData%NStCfiles,1) - DO I = 1, LEN(OutData%NStCfiles) - OutData%NStCfiles(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%NumTStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStCfiles not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TStCfiles)) DEALLOCATE(OutData%TStCfiles) - ALLOCATE(OutData%TStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStCfiles,1), UBOUND(OutData%TStCfiles,1) - DO I = 1, LEN(OutData%TStCfiles) - OutData%TStCfiles(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%NumSStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStCfiles not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SStCfiles)) DEALLOCATE(OutData%SStCfiles) - ALLOCATE(OutData%SStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStCfiles,1), UBOUND(OutData%SStCfiles,1) - DO I = 1, LEN(OutData%SStCfiles) - OutData%SStCfiles(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE SrvD_UnPackInputFile - - SUBROUTINE SrvD_CopyBladedDLLType( SrcBladedDLLTypeData, DstBladedDLLTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BladedDLLType), INTENT(IN) :: SrcBladedDLLTypeData - TYPE(BladedDLLType), INTENT(INOUT) :: DstBladedDLLTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyBladedDLLType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcBladedDLLTypeData%avrSWAP)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%avrSWAP,1) - i1_u = UBOUND(SrcBladedDLLTypeData%avrSWAP,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%avrSWAP)) THEN - ALLOCATE(DstBladedDLLTypeData%avrSWAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%avrSWAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%avrSWAP = SrcBladedDLLTypeData%avrSWAP -ENDIF - DstBladedDLLTypeData%HSSBrTrqDemand = SrcBladedDLLTypeData%HSSBrTrqDemand - DstBladedDLLTypeData%YawRateCom = SrcBladedDLLTypeData%YawRateCom - DstBladedDLLTypeData%GenTrq = SrcBladedDLLTypeData%GenTrq - DstBladedDLLTypeData%GenState = SrcBladedDLLTypeData%GenState - DstBladedDLLTypeData%BlPitchCom = SrcBladedDLLTypeData%BlPitchCom - DstBladedDLLTypeData%PrevBlPitch = SrcBladedDLLTypeData%PrevBlPitch - DstBladedDLLTypeData%BlAirfoilCom = SrcBladedDLLTypeData%BlAirfoilCom - DstBladedDLLTypeData%ElecPwr_prev = SrcBladedDLLTypeData%ElecPwr_prev - DstBladedDLLTypeData%GenTrq_prev = SrcBladedDLLTypeData%GenTrq_prev -IF (ALLOCATED(SrcBladedDLLTypeData%toSC)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%toSC,1) - i1_u = UBOUND(SrcBladedDLLTypeData%toSC,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%toSC)) THEN - ALLOCATE(DstBladedDLLTypeData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%toSC = SrcBladedDLLTypeData%toSC -ENDIF - DstBladedDLLTypeData%initialized = SrcBladedDLLTypeData%initialized - DstBladedDLLTypeData%NumLogChannels = SrcBladedDLLTypeData%NumLogChannels -IF (ALLOCATED(SrcBladedDLLTypeData%LogChannels_OutParam)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1) - i1_u = UBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%LogChannels_OutParam)) THEN - ALLOCATE(DstBladedDLLTypeData%LogChannels_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LogChannels_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1), UBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcBladedDLLTypeData%LogChannels_OutParam(i1), DstBladedDLLTypeData%LogChannels_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%LogChannels)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%LogChannels,1) - i1_u = UBOUND(SrcBladedDLLTypeData%LogChannels,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%LogChannels)) THEN - ALLOCATE(DstBladedDLLTypeData%LogChannels(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LogChannels.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%LogChannels = SrcBladedDLLTypeData%LogChannels -ENDIF - DstBladedDLLTypeData%ErrStat = SrcBladedDLLTypeData%ErrStat - DstBladedDLLTypeData%ErrMsg = SrcBladedDLLTypeData%ErrMsg - DstBladedDLLTypeData%CurrentTime = SrcBladedDLLTypeData%CurrentTime - DstBladedDLLTypeData%SimStatus = SrcBladedDLLTypeData%SimStatus - DstBladedDLLTypeData%ShaftBrakeStatusBinaryFlag = SrcBladedDLLTypeData%ShaftBrakeStatusBinaryFlag - DstBladedDLLTypeData%HSSBrDeployed = SrcBladedDLLTypeData%HSSBrDeployed - DstBladedDLLTypeData%TimeHSSBrFullyDeployed = SrcBladedDLLTypeData%TimeHSSBrFullyDeployed - DstBladedDLLTypeData%TimeHSSBrDeployed = SrcBladedDLLTypeData%TimeHSSBrDeployed - DstBladedDLLTypeData%OverrideYawRateWithTorque = SrcBladedDLLTypeData%OverrideYawRateWithTorque - DstBladedDLLTypeData%YawTorqueDemand = SrcBladedDLLTypeData%YawTorqueDemand -IF (ALLOCATED(SrcBladedDLLTypeData%BlPitchInput)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%BlPitchInput,1) - i1_u = UBOUND(SrcBladedDLLTypeData%BlPitchInput,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%BlPitchInput)) THEN - ALLOCATE(DstBladedDLLTypeData%BlPitchInput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%BlPitchInput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%BlPitchInput = SrcBladedDLLTypeData%BlPitchInput -ENDIF - DstBladedDLLTypeData%YawAngleFromNorth = SrcBladedDLLTypeData%YawAngleFromNorth - DstBladedDLLTypeData%HorWindV = SrcBladedDLLTypeData%HorWindV - DstBladedDLLTypeData%HSS_Spd = SrcBladedDLLTypeData%HSS_Spd - DstBladedDLLTypeData%YawErr = SrcBladedDLLTypeData%YawErr - DstBladedDLLTypeData%RotSpeed = SrcBladedDLLTypeData%RotSpeed - DstBladedDLLTypeData%YawBrTAxp = SrcBladedDLLTypeData%YawBrTAxp - DstBladedDLLTypeData%YawBrTAyp = SrcBladedDLLTypeData%YawBrTAyp - DstBladedDLLTypeData%LSSTipMys = SrcBladedDLLTypeData%LSSTipMys - DstBladedDLLTypeData%LSSTipMzs = SrcBladedDLLTypeData%LSSTipMzs - DstBladedDLLTypeData%LSSTipMya = SrcBladedDLLTypeData%LSSTipMya - DstBladedDLLTypeData%LSSTipMza = SrcBladedDLLTypeData%LSSTipMza - DstBladedDLLTypeData%LSSTipPxa = SrcBladedDLLTypeData%LSSTipPxa - DstBladedDLLTypeData%Yaw = SrcBladedDLLTypeData%Yaw - DstBladedDLLTypeData%YawRate = SrcBladedDLLTypeData%YawRate - DstBladedDLLTypeData%YawBrMyn = SrcBladedDLLTypeData%YawBrMyn - DstBladedDLLTypeData%YawBrMzn = SrcBladedDLLTypeData%YawBrMzn - DstBladedDLLTypeData%NcIMURAxs = SrcBladedDLLTypeData%NcIMURAxs - DstBladedDLLTypeData%NcIMURAys = SrcBladedDLLTypeData%NcIMURAys - DstBladedDLLTypeData%NcIMURAzs = SrcBladedDLLTypeData%NcIMURAzs - DstBladedDLLTypeData%RotPwr = SrcBladedDLLTypeData%RotPwr - DstBladedDLLTypeData%LSSTipMxa = SrcBladedDLLTypeData%LSSTipMxa - DstBladedDLLTypeData%RootMyc = SrcBladedDLLTypeData%RootMyc - DstBladedDLLTypeData%RootMxc = SrcBladedDLLTypeData%RootMxc - DstBladedDLLTypeData%DLL_DT = SrcBladedDLLTypeData%DLL_DT - DstBladedDLLTypeData%DLL_InFile = SrcBladedDLLTypeData%DLL_InFile - DstBladedDLLTypeData%RootName = SrcBladedDLLTypeData%RootName - DstBladedDLLTypeData%GenTrq_Dem = SrcBladedDLLTypeData%GenTrq_Dem - DstBladedDLLTypeData%GenSpd_Dem = SrcBladedDLLTypeData%GenSpd_Dem - DstBladedDLLTypeData%Ptch_Max = SrcBladedDLLTypeData%Ptch_Max - DstBladedDLLTypeData%Ptch_Min = SrcBladedDLLTypeData%Ptch_Min - DstBladedDLLTypeData%Ptch_SetPnt = SrcBladedDLLTypeData%Ptch_SetPnt - DstBladedDLLTypeData%PtchRate_Max = SrcBladedDLLTypeData%PtchRate_Max - DstBladedDLLTypeData%PtchRate_Min = SrcBladedDLLTypeData%PtchRate_Min - DstBladedDLLTypeData%GenPwr_Dem = SrcBladedDLLTypeData%GenPwr_Dem - DstBladedDLLTypeData%Gain_OM = SrcBladedDLLTypeData%Gain_OM - DstBladedDLLTypeData%GenSpd_MaxOM = SrcBladedDLLTypeData%GenSpd_MaxOM - DstBladedDLLTypeData%GenSpd_MinOM = SrcBladedDLLTypeData%GenSpd_MinOM - DstBladedDLLTypeData%Ptch_Cntrl = SrcBladedDLLTypeData%Ptch_Cntrl - DstBladedDLLTypeData%DLL_NumTrq = SrcBladedDLLTypeData%DLL_NumTrq -IF (ALLOCATED(SrcBladedDLLTypeData%GenSpd_TLU)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%GenSpd_TLU,1) - i1_u = UBOUND(SrcBladedDLLTypeData%GenSpd_TLU,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%GenSpd_TLU)) THEN - ALLOCATE(DstBladedDLLTypeData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%GenSpd_TLU = SrcBladedDLLTypeData%GenSpd_TLU -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%GenTrq_TLU)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%GenTrq_TLU,1) - i1_u = UBOUND(SrcBladedDLLTypeData%GenTrq_TLU,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%GenTrq_TLU)) THEN - ALLOCATE(DstBladedDLLTypeData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%GenTrq_TLU = SrcBladedDLLTypeData%GenTrq_TLU -ENDIF - DstBladedDLLTypeData%Yaw_Cntrl = SrcBladedDLLTypeData%Yaw_Cntrl - END SUBROUTINE SrvD_CopyBladedDLLType - - SUBROUTINE SrvD_DestroyBladedDLLType( BladedDLLTypeData, ErrStat, ErrMsg ) - TYPE(BladedDLLType), INTENT(INOUT) :: BladedDLLTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyBladedDLLType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(BladedDLLTypeData%avrSWAP)) THEN - DEALLOCATE(BladedDLLTypeData%avrSWAP) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%toSC)) THEN - DEALLOCATE(BladedDLLTypeData%toSC) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%LogChannels_OutParam)) THEN -DO i1 = LBOUND(BladedDLLTypeData%LogChannels_OutParam,1), UBOUND(BladedDLLTypeData%LogChannels_OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( BladedDLLTypeData%LogChannels_OutParam(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(BladedDLLTypeData%LogChannels_OutParam) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%LogChannels)) THEN - DEALLOCATE(BladedDLLTypeData%LogChannels) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%BlPitchInput)) THEN - DEALLOCATE(BladedDLLTypeData%BlPitchInput) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%GenSpd_TLU)) THEN - DEALLOCATE(BladedDLLTypeData%GenSpd_TLU) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%GenTrq_TLU)) THEN - DEALLOCATE(BladedDLLTypeData%GenTrq_TLU) -ENDIF - END SUBROUTINE SrvD_DestroyBladedDLLType - - SUBROUTINE SrvD_PackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BladedDLLType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackBladedDLLType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! avrSWAP allocated yes/no - IF ( ALLOCATED(InData%avrSWAP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! avrSWAP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%avrSWAP) ! avrSWAP - END IF - Re_BufSz = Re_BufSz + 1 ! HSSBrTrqDemand - Re_BufSz = Re_BufSz + 1 ! YawRateCom - Re_BufSz = Re_BufSz + 1 ! GenTrq - Int_BufSz = Int_BufSz + 1 ! GenState - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchCom) ! BlPitchCom - Re_BufSz = Re_BufSz + SIZE(InData%PrevBlPitch) ! PrevBlPitch - Re_BufSz = Re_BufSz + SIZE(InData%BlAirfoilCom) ! BlAirfoilCom - Re_BufSz = Re_BufSz + 1 ! ElecPwr_prev - Re_BufSz = Re_BufSz + 1 ! GenTrq_prev - Int_BufSz = Int_BufSz + 1 ! toSC allocated yes/no - IF ( ALLOCATED(InData%toSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! toSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%toSC) ! toSC - END IF - Int_BufSz = Int_BufSz + 1 ! initialized - Int_BufSz = Int_BufSz + 1 ! NumLogChannels - Int_BufSz = Int_BufSz + 1 ! LogChannels_OutParam allocated yes/no - IF ( ALLOCATED(InData%LogChannels_OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LogChannels_OutParam upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%LogChannels_OutParam,1), UBOUND(InData%LogChannels_OutParam,1) - Int_BufSz = Int_BufSz + 3 ! LogChannels_OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! LogChannels_OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LogChannels_OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LogChannels_OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LogChannels_OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! LogChannels allocated yes/no - IF ( ALLOCATED(InData%LogChannels) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LogChannels upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LogChannels) ! LogChannels - END IF - Int_BufSz = Int_BufSz + 1 ! ErrStat - Int_BufSz = Int_BufSz + 1*LEN(InData%ErrMsg) ! ErrMsg - Db_BufSz = Db_BufSz + 1 ! CurrentTime - Int_BufSz = Int_BufSz + 1 ! SimStatus - Int_BufSz = Int_BufSz + 1 ! ShaftBrakeStatusBinaryFlag - Int_BufSz = Int_BufSz + 1 ! HSSBrDeployed - Db_BufSz = Db_BufSz + 1 ! TimeHSSBrFullyDeployed - Db_BufSz = Db_BufSz + 1 ! TimeHSSBrDeployed - Int_BufSz = Int_BufSz + 1 ! OverrideYawRateWithTorque - Re_BufSz = Re_BufSz + 1 ! YawTorqueDemand - Int_BufSz = Int_BufSz + 1 ! BlPitchInput allocated yes/no - IF ( ALLOCATED(InData%BlPitchInput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitchInput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchInput) ! BlPitchInput - END IF - Re_BufSz = Re_BufSz + 1 ! YawAngleFromNorth - Re_BufSz = Re_BufSz + 1 ! HorWindV - Re_BufSz = Re_BufSz + 1 ! HSS_Spd - Re_BufSz = Re_BufSz + 1 ! YawErr - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Re_BufSz = Re_BufSz + 1 ! YawBrTAxp - Re_BufSz = Re_BufSz + 1 ! YawBrTAyp - Re_BufSz = Re_BufSz + 1 ! LSSTipMys - Re_BufSz = Re_BufSz + 1 ! LSSTipMzs - Re_BufSz = Re_BufSz + 1 ! LSSTipMya - Re_BufSz = Re_BufSz + 1 ! LSSTipMza - Re_BufSz = Re_BufSz + 1 ! LSSTipPxa - Re_BufSz = Re_BufSz + 1 ! Yaw - Re_BufSz = Re_BufSz + 1 ! YawRate - Re_BufSz = Re_BufSz + 1 ! YawBrMyn - Re_BufSz = Re_BufSz + 1 ! YawBrMzn - Re_BufSz = Re_BufSz + 1 ! NcIMURAxs - Re_BufSz = Re_BufSz + 1 ! NcIMURAys - Re_BufSz = Re_BufSz + 1 ! NcIMURAzs - Re_BufSz = Re_BufSz + 1 ! RotPwr - Re_BufSz = Re_BufSz + 1 ! LSSTipMxa - Re_BufSz = Re_BufSz + SIZE(InData%RootMyc) ! RootMyc - Re_BufSz = Re_BufSz + SIZE(InData%RootMxc) ! RootMxc - Db_BufSz = Db_BufSz + 1 ! DLL_DT - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_InFile) ! DLL_InFile - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + 1 ! GenTrq_Dem - Re_BufSz = Re_BufSz + 1 ! GenSpd_Dem - Re_BufSz = Re_BufSz + 1 ! Ptch_Max - Re_BufSz = Re_BufSz + 1 ! Ptch_Min - Re_BufSz = Re_BufSz + 1 ! Ptch_SetPnt - Re_BufSz = Re_BufSz + 1 ! PtchRate_Max - Re_BufSz = Re_BufSz + 1 ! PtchRate_Min - Re_BufSz = Re_BufSz + 1 ! GenPwr_Dem - Re_BufSz = Re_BufSz + 1 ! Gain_OM - Re_BufSz = Re_BufSz + 1 ! GenSpd_MaxOM - Re_BufSz = Re_BufSz + 1 ! GenSpd_MinOM - Int_BufSz = Int_BufSz + 1 ! Ptch_Cntrl - Int_BufSz = Int_BufSz + 1 ! DLL_NumTrq - Int_BufSz = Int_BufSz + 1 ! GenSpd_TLU allocated yes/no - IF ( ALLOCATED(InData%GenSpd_TLU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! GenSpd_TLU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GenSpd_TLU) ! GenSpd_TLU - END IF - Int_BufSz = Int_BufSz + 1 ! GenTrq_TLU allocated yes/no - IF ( ALLOCATED(InData%GenTrq_TLU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! GenTrq_TLU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GenTrq_TLU) ! GenTrq_TLU - END IF - Int_BufSz = Int_BufSz + 1 ! Yaw_Cntrl - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%avrSWAP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%avrSWAP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%avrSWAP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%avrSWAP,1), UBOUND(InData%avrSWAP,1) - ReKiBuf(Re_Xferred) = InData%avrSWAP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%HSSBrTrqDemand - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawRateCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%GenState - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) - ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PrevBlPitch,1), UBOUND(InData%PrevBlPitch,1) - ReKiBuf(Re_Xferred) = InData%PrevBlPitch(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%BlAirfoilCom,1), UBOUND(InData%BlAirfoilCom,1) - ReKiBuf(Re_Xferred) = InData%BlAirfoilCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%ElecPwr_prev - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenTrq_prev - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%toSC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%toSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%toSC,1), UBOUND(InData%toSC,1) - ReKiBuf(Re_Xferred) = InData%toSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%initialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumLogChannels - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LogChannels_OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LogChannels_OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LogChannels_OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LogChannels_OutParam,1), UBOUND(InData%LogChannels_OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! LogChannels_OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LogChannels) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LogChannels,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LogChannels,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LogChannels,1), UBOUND(InData%LogChannels,1) - ReKiBuf(Re_Xferred) = InData%LogChannels(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%ErrStat - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%ErrMsg) - IntKiBuf(Int_Xferred) = ICHAR(InData%ErrMsg(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%CurrentTime - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SimStatus - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ShaftBrakeStatusBinaryFlag - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%HSSBrDeployed, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TimeHSSBrFullyDeployed - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TimeHSSBrDeployed - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OverrideYawRateWithTorque, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawTorqueDemand - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlPitchInput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitchInput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchInput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitchInput,1), UBOUND(InData%BlPitchInput,1) - ReKiBuf(Re_Xferred) = InData%BlPitchInput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%YawAngleFromNorth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HorWindV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawErr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrTAxp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrTAyp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMya - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMza - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipPxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Yaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAxs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMxa - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%RootMyc,1), UBOUND(InData%RootMyc,1) - ReKiBuf(Re_Xferred) = InData%RootMyc(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%RootMxc,1), UBOUND(InData%RootMxc,1) - ReKiBuf(Re_Xferred) = InData%RootMxc(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%DLL_DT - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%DLL_InFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%GenTrq_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenSpd_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ptch_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ptch_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ptch_SetPnt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtchRate_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtchRate_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenPwr_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gain_OM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenSpd_MaxOM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenSpd_MinOM - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Ptch_Cntrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DLL_NumTrq - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%GenSpd_TLU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GenSpd_TLU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenSpd_TLU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%GenSpd_TLU,1), UBOUND(InData%GenSpd_TLU,1) - ReKiBuf(Re_Xferred) = InData%GenSpd_TLU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GenTrq_TLU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GenTrq_TLU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenTrq_TLU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%GenTrq_TLU,1), UBOUND(InData%GenTrq_TLU,1) - ReKiBuf(Re_Xferred) = InData%GenTrq_TLU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Yaw_Cntrl - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SrvD_PackBladedDLLType - - SUBROUTINE SrvD_UnPackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BladedDLLType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackBladedDLLType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! avrSWAP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%avrSWAP)) DEALLOCATE(OutData%avrSWAP) - ALLOCATE(OutData%avrSWAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%avrSWAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%avrSWAP,1), UBOUND(OutData%avrSWAP,1) - OutData%avrSWAP(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%HSSBrTrqDemand = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawRateCom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenState = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%BlPitchCom,1) - i1_u = UBOUND(OutData%BlPitchCom,1) - DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) - OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PrevBlPitch,1) - i1_u = UBOUND(OutData%PrevBlPitch,1) - DO i1 = LBOUND(OutData%PrevBlPitch,1), UBOUND(OutData%PrevBlPitch,1) - OutData%PrevBlPitch(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%BlAirfoilCom,1) - i1_u = UBOUND(OutData%BlAirfoilCom,1) - DO i1 = LBOUND(OutData%BlAirfoilCom,1), UBOUND(OutData%BlAirfoilCom,1) - OutData%BlAirfoilCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%ElecPwr_prev = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq_prev = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! toSC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%toSC)) DEALLOCATE(OutData%toSC) - ALLOCATE(OutData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%toSC,1), UBOUND(OutData%toSC,1) - OutData%toSC(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%initialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%initialized) - Int_Xferred = Int_Xferred + 1 - OutData%NumLogChannels = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LogChannels_OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LogChannels_OutParam)) DEALLOCATE(OutData%LogChannels_OutParam) - ALLOCATE(OutData%LogChannels_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LogChannels_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LogChannels_OutParam,1), UBOUND(OutData%LogChannels_OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2 ) ! LogChannels_OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LogChannels not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LogChannels)) DEALLOCATE(OutData%LogChannels) - ALLOCATE(OutData%LogChannels(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LogChannels.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LogChannels,1), UBOUND(OutData%LogChannels,1) - OutData%LogChannels(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%ErrStat = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%ErrMsg) - OutData%ErrMsg(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CurrentTime = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SimStatus = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ShaftBrakeStatusBinaryFlag = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HSSBrDeployed = TRANSFER(IntKiBuf(Int_Xferred), OutData%HSSBrDeployed) - Int_Xferred = Int_Xferred + 1 - OutData%TimeHSSBrFullyDeployed = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%TimeHSSBrDeployed = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%OverrideYawRateWithTorque = TRANSFER(IntKiBuf(Int_Xferred), OutData%OverrideYawRateWithTorque) - Int_Xferred = Int_Xferred + 1 - OutData%YawTorqueDemand = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchInput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlPitchInput)) DEALLOCATE(OutData%BlPitchInput) - ALLOCATE(OutData%BlPitchInput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitchInput,1), UBOUND(OutData%BlPitchInput,1) - OutData%BlPitchInput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%YawAngleFromNorth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HorWindV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HSS_Spd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawErr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrTAxp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrTAyp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMya = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMza = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipPxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Yaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawRate = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAxs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotPwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%RootMyc,1) - i1_u = UBOUND(OutData%RootMyc,1) - DO i1 = LBOUND(OutData%RootMyc,1), UBOUND(OutData%RootMyc,1) - OutData%RootMyc(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%RootMxc,1) - i1_u = UBOUND(OutData%RootMxc,1) - DO i1 = LBOUND(OutData%RootMxc,1), UBOUND(OutData%RootMxc,1) - OutData%RootMxc(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%DLL_DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%DLL_InFile) - OutData%DLL_InFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%GenTrq_Dem = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_Dem = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Max = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Min = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_SetPnt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Max = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Min = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenPwr_Dem = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Gain_OM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MaxOM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MinOM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Cntrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DLL_NumTrq = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenSpd_TLU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GenSpd_TLU)) DEALLOCATE(OutData%GenSpd_TLU) - ALLOCATE(OutData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%GenSpd_TLU,1), UBOUND(OutData%GenSpd_TLU,1) - OutData%GenSpd_TLU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenTrq_TLU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GenTrq_TLU)) DEALLOCATE(OutData%GenTrq_TLU) - ALLOCATE(OutData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%GenTrq_TLU,1), UBOUND(OutData%GenTrq_TLU,1) - OutData%GenTrq_TLU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Yaw_Cntrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SrvD_UnPackBladedDLLType - - SUBROUTINE SrvD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(SrvD_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState -IF (ALLOCATED(SrcContStateData%BStC)) THEN - i1_l = LBOUND(SrcContStateData%BStC,1) - i1_u = UBOUND(SrcContStateData%BStC,1) - IF (.NOT. ALLOCATED(DstContStateData%BStC)) THEN - ALLOCATE(DstContStateData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%BStC,1), UBOUND(SrcContStateData%BStC,1) - CALL StC_CopyContState( SrcContStateData%BStC(i1), DstContStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcContStateData%NStC)) THEN - i1_l = LBOUND(SrcContStateData%NStC,1) - i1_u = UBOUND(SrcContStateData%NStC,1) - IF (.NOT. ALLOCATED(DstContStateData%NStC)) THEN - ALLOCATE(DstContStateData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%NStC,1), UBOUND(SrcContStateData%NStC,1) - CALL StC_CopyContState( SrcContStateData%NStC(i1), DstContStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcContStateData%TStC)) THEN - i1_l = LBOUND(SrcContStateData%TStC,1) - i1_u = UBOUND(SrcContStateData%TStC,1) - IF (.NOT. ALLOCATED(DstContStateData%TStC)) THEN - ALLOCATE(DstContStateData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%TStC,1), UBOUND(SrcContStateData%TStC,1) - CALL StC_CopyContState( SrcContStateData%TStC(i1), DstContStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcContStateData%SStC)) THEN - i1_l = LBOUND(SrcContStateData%SStC,1) - i1_u = UBOUND(SrcContStateData%SStC,1) - IF (.NOT. ALLOCATED(DstContStateData%SStC)) THEN - ALLOCATE(DstContStateData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%SStC,1), UBOUND(SrcContStateData%SStC,1) - CALL StC_CopyContState( SrcContStateData%SStC(i1), DstContStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE SrvD_CopyContState - - SUBROUTINE SrvD_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(SrvD_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyContState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ContStateData%BStC)) THEN -DO i1 = LBOUND(ContStateData%BStC,1), UBOUND(ContStateData%BStC,1) - CALL StC_DestroyContState( ContStateData%BStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ContStateData%BStC) -ENDIF -IF (ALLOCATED(ContStateData%NStC)) THEN -DO i1 = LBOUND(ContStateData%NStC,1), UBOUND(ContStateData%NStC,1) - CALL StC_DestroyContState( ContStateData%NStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ContStateData%NStC) -ENDIF -IF (ALLOCATED(ContStateData%TStC)) THEN -DO i1 = LBOUND(ContStateData%TStC,1), UBOUND(ContStateData%TStC,1) - CALL StC_DestroyContState( ContStateData%TStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ContStateData%TStC) -ENDIF -IF (ALLOCATED(ContStateData%SStC)) THEN -DO i1 = LBOUND(ContStateData%SStC,1), UBOUND(ContStateData%SStC,1) - CALL StC_DestroyContState( ContStateData%SStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ContStateData%SStC) -ENDIF - END SUBROUTINE SrvD_DestroyContState - - SUBROUTINE SrvD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyContState - Int_BufSz = Int_BufSz + 1 ! BStC allocated yes/no - IF ( ALLOCATED(InData%BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStC upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC: size of buffers for each call to pack subtype - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC allocated yes/no - IF ( ALLOCATED(InData%NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC: size of buffers for each call to pack subtype - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC allocated yes/no - IF ( ALLOCATED(InData%TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC: size of buffers for each call to pack subtype - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC allocated yes/no - IF ( ALLOCATED(InData%SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC: size of buffers for each call to pack subtype - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE SrvD_PackContState - - SUBROUTINE SrvD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyContState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC)) DEALLOCATE(OutData%BStC) - ALLOCATE(OutData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStC,1), UBOUND(OutData%BStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%BStC(i1), ErrStat2, ErrMsg2 ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NStC)) DEALLOCATE(OutData%NStC) - ALLOCATE(OutData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC,1), UBOUND(OutData%NStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%NStC(i1), ErrStat2, ErrMsg2 ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TStC)) DEALLOCATE(OutData%TStC) - ALLOCATE(OutData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC,1), UBOUND(OutData%TStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%TStC(i1), ErrStat2, ErrMsg2 ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SStC)) DEALLOCATE(OutData%SStC) - ALLOCATE(OutData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC,1), UBOUND(OutData%SStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%SStC(i1), ErrStat2, ErrMsg2 ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE SrvD_UnPackContState - - SUBROUTINE SrvD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(SrvD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%CtrlOffset = SrcDiscStateData%CtrlOffset -IF (ALLOCATED(SrcDiscStateData%BStC)) THEN - i1_l = LBOUND(SrcDiscStateData%BStC,1) - i1_u = UBOUND(SrcDiscStateData%BStC,1) - IF (.NOT. ALLOCATED(DstDiscStateData%BStC)) THEN - ALLOCATE(DstDiscStateData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%BStC,1), UBOUND(SrcDiscStateData%BStC,1) - CALL StC_CopyDiscState( SrcDiscStateData%BStC(i1), DstDiscStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcDiscStateData%NStC)) THEN - i1_l = LBOUND(SrcDiscStateData%NStC,1) - i1_u = UBOUND(SrcDiscStateData%NStC,1) - IF (.NOT. ALLOCATED(DstDiscStateData%NStC)) THEN - ALLOCATE(DstDiscStateData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%NStC,1), UBOUND(SrcDiscStateData%NStC,1) - CALL StC_CopyDiscState( SrcDiscStateData%NStC(i1), DstDiscStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcDiscStateData%TStC)) THEN - i1_l = LBOUND(SrcDiscStateData%TStC,1) - i1_u = UBOUND(SrcDiscStateData%TStC,1) - IF (.NOT. ALLOCATED(DstDiscStateData%TStC)) THEN - ALLOCATE(DstDiscStateData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%TStC,1), UBOUND(SrcDiscStateData%TStC,1) - CALL StC_CopyDiscState( SrcDiscStateData%TStC(i1), DstDiscStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcDiscStateData%SStC)) THEN - i1_l = LBOUND(SrcDiscStateData%SStC,1) - i1_u = UBOUND(SrcDiscStateData%SStC,1) - IF (.NOT. ALLOCATED(DstDiscStateData%SStC)) THEN - ALLOCATE(DstDiscStateData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%SStC,1), UBOUND(SrcDiscStateData%SStC,1) - CALL StC_CopyDiscState( SrcDiscStateData%SStC(i1), DstDiscStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE SrvD_CopyDiscState - - SUBROUTINE SrvD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(SrvD_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyDiscState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(DiscStateData%BStC)) THEN -DO i1 = LBOUND(DiscStateData%BStC,1), UBOUND(DiscStateData%BStC,1) - CALL StC_DestroyDiscState( DiscStateData%BStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(DiscStateData%BStC) -ENDIF -IF (ALLOCATED(DiscStateData%NStC)) THEN -DO i1 = LBOUND(DiscStateData%NStC,1), UBOUND(DiscStateData%NStC,1) - CALL StC_DestroyDiscState( DiscStateData%NStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(DiscStateData%NStC) -ENDIF -IF (ALLOCATED(DiscStateData%TStC)) THEN -DO i1 = LBOUND(DiscStateData%TStC,1), UBOUND(DiscStateData%TStC,1) - CALL StC_DestroyDiscState( DiscStateData%TStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(DiscStateData%TStC) -ENDIF -IF (ALLOCATED(DiscStateData%SStC)) THEN -DO i1 = LBOUND(DiscStateData%SStC,1), UBOUND(DiscStateData%SStC,1) - CALL StC_DestroyDiscState( DiscStateData%SStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(DiscStateData%SStC) -ENDIF - END SUBROUTINE SrvD_DestroyDiscState - - SUBROUTINE SrvD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! CtrlOffset - Int_BufSz = Int_BufSz + 1 ! BStC allocated yes/no - IF ( ALLOCATED(InData%BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStC upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC: size of buffers for each call to pack subtype - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC allocated yes/no - IF ( ALLOCATED(InData%NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC: size of buffers for each call to pack subtype - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC allocated yes/no - IF ( ALLOCATED(InData%TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC: size of buffers for each call to pack subtype - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC allocated yes/no - IF ( ALLOCATED(InData%SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC: size of buffers for each call to pack subtype - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%CtrlOffset - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE SrvD_PackDiscState - - SUBROUTINE SrvD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%CtrlOffset = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC)) DEALLOCATE(OutData%BStC) - ALLOCATE(OutData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStC,1), UBOUND(OutData%BStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%BStC(i1), ErrStat2, ErrMsg2 ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NStC)) DEALLOCATE(OutData%NStC) - ALLOCATE(OutData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC,1), UBOUND(OutData%NStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%NStC(i1), ErrStat2, ErrMsg2 ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TStC)) DEALLOCATE(OutData%TStC) - ALLOCATE(OutData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC,1), UBOUND(OutData%TStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%TStC(i1), ErrStat2, ErrMsg2 ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SStC)) DEALLOCATE(OutData%SStC) - ALLOCATE(OutData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC,1), UBOUND(OutData%SStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%SStC(i1), ErrStat2, ErrMsg2 ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE SrvD_UnPackDiscState - - SUBROUTINE SrvD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(SrvD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState -IF (ALLOCATED(SrcConstrStateData%BStC)) THEN - i1_l = LBOUND(SrcConstrStateData%BStC,1) - i1_u = UBOUND(SrcConstrStateData%BStC,1) - IF (.NOT. ALLOCATED(DstConstrStateData%BStC)) THEN - ALLOCATE(DstConstrStateData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcConstrStateData%BStC,1), UBOUND(SrcConstrStateData%BStC,1) - CALL StC_CopyConstrState( SrcConstrStateData%BStC(i1), DstConstrStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcConstrStateData%NStC)) THEN - i1_l = LBOUND(SrcConstrStateData%NStC,1) - i1_u = UBOUND(SrcConstrStateData%NStC,1) - IF (.NOT. ALLOCATED(DstConstrStateData%NStC)) THEN - ALLOCATE(DstConstrStateData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcConstrStateData%NStC,1), UBOUND(SrcConstrStateData%NStC,1) - CALL StC_CopyConstrState( SrcConstrStateData%NStC(i1), DstConstrStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcConstrStateData%TStC)) THEN - i1_l = LBOUND(SrcConstrStateData%TStC,1) - i1_u = UBOUND(SrcConstrStateData%TStC,1) - IF (.NOT. ALLOCATED(DstConstrStateData%TStC)) THEN - ALLOCATE(DstConstrStateData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcConstrStateData%TStC,1), UBOUND(SrcConstrStateData%TStC,1) - CALL StC_CopyConstrState( SrcConstrStateData%TStC(i1), DstConstrStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcConstrStateData%SStC)) THEN - i1_l = LBOUND(SrcConstrStateData%SStC,1) - i1_u = UBOUND(SrcConstrStateData%SStC,1) - IF (.NOT. ALLOCATED(DstConstrStateData%SStC)) THEN - ALLOCATE(DstConstrStateData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcConstrStateData%SStC,1), UBOUND(SrcConstrStateData%SStC,1) - CALL StC_CopyConstrState( SrcConstrStateData%SStC(i1), DstConstrStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE SrvD_CopyConstrState - - SUBROUTINE SrvD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(SrvD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyConstrState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ConstrStateData%BStC)) THEN -DO i1 = LBOUND(ConstrStateData%BStC,1), UBOUND(ConstrStateData%BStC,1) - CALL StC_DestroyConstrState( ConstrStateData%BStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ConstrStateData%BStC) -ENDIF -IF (ALLOCATED(ConstrStateData%NStC)) THEN -DO i1 = LBOUND(ConstrStateData%NStC,1), UBOUND(ConstrStateData%NStC,1) - CALL StC_DestroyConstrState( ConstrStateData%NStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ConstrStateData%NStC) -ENDIF -IF (ALLOCATED(ConstrStateData%TStC)) THEN -DO i1 = LBOUND(ConstrStateData%TStC,1), UBOUND(ConstrStateData%TStC,1) - CALL StC_DestroyConstrState( ConstrStateData%TStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ConstrStateData%TStC) -ENDIF -IF (ALLOCATED(ConstrStateData%SStC)) THEN -DO i1 = LBOUND(ConstrStateData%SStC,1), UBOUND(ConstrStateData%SStC,1) - CALL StC_DestroyConstrState( ConstrStateData%SStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ConstrStateData%SStC) -ENDIF - END SUBROUTINE SrvD_DestroyConstrState - - SUBROUTINE SrvD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - Int_BufSz = Int_BufSz + 1 ! BStC allocated yes/no - IF ( ALLOCATED(InData%BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStC upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC: size of buffers for each call to pack subtype - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC allocated yes/no - IF ( ALLOCATED(InData%NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC: size of buffers for each call to pack subtype - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC allocated yes/no - IF ( ALLOCATED(InData%TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC: size of buffers for each call to pack subtype - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC allocated yes/no - IF ( ALLOCATED(InData%SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC: size of buffers for each call to pack subtype - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE SrvD_PackConstrState - - SUBROUTINE SrvD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC)) DEALLOCATE(OutData%BStC) - ALLOCATE(OutData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStC,1), UBOUND(OutData%BStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%BStC(i1), ErrStat2, ErrMsg2 ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NStC)) DEALLOCATE(OutData%NStC) - ALLOCATE(OutData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC,1), UBOUND(OutData%NStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%NStC(i1), ErrStat2, ErrMsg2 ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TStC)) DEALLOCATE(OutData%TStC) - ALLOCATE(OutData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC,1), UBOUND(OutData%TStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%TStC(i1), ErrStat2, ErrMsg2 ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SStC)) DEALLOCATE(OutData%SStC) - ALLOCATE(OutData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC,1), UBOUND(OutData%SStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%SStC(i1), ErrStat2, ErrMsg2 ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE SrvD_UnPackConstrState - - SUBROUTINE SrvD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(SrvD_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%BegPitMan)) THEN - i1_l = LBOUND(SrcOtherStateData%BegPitMan,1) - i1_u = UBOUND(SrcOtherStateData%BegPitMan,1) - IF (.NOT. ALLOCATED(DstOtherStateData%BegPitMan)) THEN - ALLOCATE(DstOtherStateData%BegPitMan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BegPitMan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%BegPitMan = SrcOtherStateData%BegPitMan -ENDIF -IF (ALLOCATED(SrcOtherStateData%BlPitchI)) THEN - i1_l = LBOUND(SrcOtherStateData%BlPitchI,1) - i1_u = UBOUND(SrcOtherStateData%BlPitchI,1) - IF (.NOT. ALLOCATED(DstOtherStateData%BlPitchI)) THEN - ALLOCATE(DstOtherStateData%BlPitchI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BlPitchI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%BlPitchI = SrcOtherStateData%BlPitchI -ENDIF -IF (ALLOCATED(SrcOtherStateData%TPitManE)) THEN - i1_l = LBOUND(SrcOtherStateData%TPitManE,1) - i1_u = UBOUND(SrcOtherStateData%TPitManE,1) - IF (.NOT. ALLOCATED(DstOtherStateData%TPitManE)) THEN - ALLOCATE(DstOtherStateData%TPitManE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%TPitManE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%TPitManE = SrcOtherStateData%TPitManE -ENDIF - DstOtherStateData%BegYawMan = SrcOtherStateData%BegYawMan - DstOtherStateData%NacYawI = SrcOtherStateData%NacYawI - DstOtherStateData%TYawManE = SrcOtherStateData%TYawManE - DstOtherStateData%YawPosComInt = SrcOtherStateData%YawPosComInt -IF (ALLOCATED(SrcOtherStateData%BegTpBr)) THEN - i1_l = LBOUND(SrcOtherStateData%BegTpBr,1) - i1_u = UBOUND(SrcOtherStateData%BegTpBr,1) - IF (.NOT. ALLOCATED(DstOtherStateData%BegTpBr)) THEN - ALLOCATE(DstOtherStateData%BegTpBr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BegTpBr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%BegTpBr = SrcOtherStateData%BegTpBr -ENDIF -IF (ALLOCATED(SrcOtherStateData%TTpBrDp)) THEN - i1_l = LBOUND(SrcOtherStateData%TTpBrDp,1) - i1_u = UBOUND(SrcOtherStateData%TTpBrDp,1) - IF (.NOT. ALLOCATED(DstOtherStateData%TTpBrDp)) THEN - ALLOCATE(DstOtherStateData%TTpBrDp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%TTpBrDp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%TTpBrDp = SrcOtherStateData%TTpBrDp -ENDIF -IF (ALLOCATED(SrcOtherStateData%TTpBrFl)) THEN - i1_l = LBOUND(SrcOtherStateData%TTpBrFl,1) - i1_u = UBOUND(SrcOtherStateData%TTpBrFl,1) - IF (.NOT. ALLOCATED(DstOtherStateData%TTpBrFl)) THEN - ALLOCATE(DstOtherStateData%TTpBrFl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%TTpBrFl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%TTpBrFl = SrcOtherStateData%TTpBrFl -ENDIF - DstOtherStateData%Off4Good = SrcOtherStateData%Off4Good - DstOtherStateData%GenOnLine = SrcOtherStateData%GenOnLine -IF (ALLOCATED(SrcOtherStateData%BStC)) THEN - i1_l = LBOUND(SrcOtherStateData%BStC,1) - i1_u = UBOUND(SrcOtherStateData%BStC,1) - IF (.NOT. ALLOCATED(DstOtherStateData%BStC)) THEN - ALLOCATE(DstOtherStateData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%BStC,1), UBOUND(SrcOtherStateData%BStC,1) - CALL StC_CopyOtherState( SrcOtherStateData%BStC(i1), DstOtherStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOtherStateData%NStC)) THEN - i1_l = LBOUND(SrcOtherStateData%NStC,1) - i1_u = UBOUND(SrcOtherStateData%NStC,1) - IF (.NOT. ALLOCATED(DstOtherStateData%NStC)) THEN - ALLOCATE(DstOtherStateData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%NStC,1), UBOUND(SrcOtherStateData%NStC,1) - CALL StC_CopyOtherState( SrcOtherStateData%NStC(i1), DstOtherStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOtherStateData%TStC)) THEN - i1_l = LBOUND(SrcOtherStateData%TStC,1) - i1_u = UBOUND(SrcOtherStateData%TStC,1) - IF (.NOT. ALLOCATED(DstOtherStateData%TStC)) THEN - ALLOCATE(DstOtherStateData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%TStC,1), UBOUND(SrcOtherStateData%TStC,1) - CALL StC_CopyOtherState( SrcOtherStateData%TStC(i1), DstOtherStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOtherStateData%SStC)) THEN - i1_l = LBOUND(SrcOtherStateData%SStC,1) - i1_u = UBOUND(SrcOtherStateData%SStC,1) - IF (.NOT. ALLOCATED(DstOtherStateData%SStC)) THEN - ALLOCATE(DstOtherStateData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%SStC,1), UBOUND(SrcOtherStateData%SStC,1) - CALL StC_CopyOtherState( SrcOtherStateData%SStC(i1), DstOtherStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE SrvD_CopyOtherState - - SUBROUTINE SrvD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(SrvD_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyOtherState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(OtherStateData%BegPitMan)) THEN - DEALLOCATE(OtherStateData%BegPitMan) -ENDIF -IF (ALLOCATED(OtherStateData%BlPitchI)) THEN - DEALLOCATE(OtherStateData%BlPitchI) -ENDIF -IF (ALLOCATED(OtherStateData%TPitManE)) THEN - DEALLOCATE(OtherStateData%TPitManE) -ENDIF -IF (ALLOCATED(OtherStateData%BegTpBr)) THEN - DEALLOCATE(OtherStateData%BegTpBr) -ENDIF -IF (ALLOCATED(OtherStateData%TTpBrDp)) THEN - DEALLOCATE(OtherStateData%TTpBrDp) -ENDIF -IF (ALLOCATED(OtherStateData%TTpBrFl)) THEN - DEALLOCATE(OtherStateData%TTpBrFl) -ENDIF -IF (ALLOCATED(OtherStateData%BStC)) THEN -DO i1 = LBOUND(OtherStateData%BStC,1), UBOUND(OtherStateData%BStC,1) - CALL StC_DestroyOtherState( OtherStateData%BStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(OtherStateData%BStC) -ENDIF -IF (ALLOCATED(OtherStateData%NStC)) THEN -DO i1 = LBOUND(OtherStateData%NStC,1), UBOUND(OtherStateData%NStC,1) - CALL StC_DestroyOtherState( OtherStateData%NStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(OtherStateData%NStC) -ENDIF -IF (ALLOCATED(OtherStateData%TStC)) THEN -DO i1 = LBOUND(OtherStateData%TStC,1), UBOUND(OtherStateData%TStC,1) - CALL StC_DestroyOtherState( OtherStateData%TStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(OtherStateData%TStC) -ENDIF -IF (ALLOCATED(OtherStateData%SStC)) THEN -DO i1 = LBOUND(OtherStateData%SStC,1), UBOUND(OtherStateData%SStC,1) - CALL StC_DestroyOtherState( OtherStateData%SStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(OtherStateData%SStC) -ENDIF - END SUBROUTINE SrvD_DestroyOtherState - - SUBROUTINE SrvD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! BegPitMan allocated yes/no - IF ( ALLOCATED(InData%BegPitMan) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BegPitMan upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BegPitMan) ! BegPitMan - END IF - Int_BufSz = Int_BufSz + 1 ! BlPitchI allocated yes/no - IF ( ALLOCATED(InData%BlPitchI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitchI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchI) ! BlPitchI - END IF - Int_BufSz = Int_BufSz + 1 ! TPitManE allocated yes/no - IF ( ALLOCATED(InData%TPitManE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TPitManE upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%TPitManE) ! TPitManE - END IF - Int_BufSz = Int_BufSz + 1 ! BegYawMan - Re_BufSz = Re_BufSz + 1 ! NacYawI - Db_BufSz = Db_BufSz + 1 ! TYawManE - Re_BufSz = Re_BufSz + 1 ! YawPosComInt - Int_BufSz = Int_BufSz + 1 ! BegTpBr allocated yes/no - IF ( ALLOCATED(InData%BegTpBr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BegTpBr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BegTpBr) ! BegTpBr - END IF - Int_BufSz = Int_BufSz + 1 ! TTpBrDp allocated yes/no - IF ( ALLOCATED(InData%TTpBrDp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TTpBrDp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%TTpBrDp) ! TTpBrDp - END IF - Int_BufSz = Int_BufSz + 1 ! TTpBrFl allocated yes/no - IF ( ALLOCATED(InData%TTpBrFl) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TTpBrFl upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%TTpBrFl) ! TTpBrFl - END IF - Int_BufSz = Int_BufSz + 1 ! Off4Good - Int_BufSz = Int_BufSz + 1 ! GenOnLine - Int_BufSz = Int_BufSz + 1 ! BStC allocated yes/no - IF ( ALLOCATED(InData%BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStC upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC: size of buffers for each call to pack subtype - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC allocated yes/no - IF ( ALLOCATED(InData%NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC: size of buffers for each call to pack subtype - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC allocated yes/no - IF ( ALLOCATED(InData%TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC: size of buffers for each call to pack subtype - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC allocated yes/no - IF ( ALLOCATED(InData%SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC: size of buffers for each call to pack subtype - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%BegPitMan) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BegPitMan,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BegPitMan,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BegPitMan,1), UBOUND(InData%BegPitMan,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%BegPitMan(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlPitchI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitchI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitchI,1), UBOUND(InData%BlPitchI,1) - ReKiBuf(Re_Xferred) = InData%BlPitchI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TPitManE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TPitManE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TPitManE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TPitManE,1), UBOUND(InData%TPitManE,1) - DbKiBuf(Db_Xferred) = InData%TPitManE(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%BegYawMan, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYawI - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TYawManE - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawPosComInt - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BegTpBr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BegTpBr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BegTpBr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BegTpBr,1), UBOUND(InData%BegTpBr,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%BegTpBr(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TTpBrDp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TTpBrDp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TTpBrDp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TTpBrDp,1), UBOUND(InData%TTpBrDp,1) - DbKiBuf(Db_Xferred) = InData%TTpBrDp(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TTpBrFl) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TTpBrFl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TTpBrFl,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TTpBrFl,1), UBOUND(InData%TTpBrFl,1) - DbKiBuf(Db_Xferred) = InData%TTpBrFl(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%Off4Good, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GenOnLine, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE SrvD_PackOtherState - - SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BegPitMan not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BegPitMan)) DEALLOCATE(OutData%BegPitMan) - ALLOCATE(OutData%BegPitMan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BegPitMan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BegPitMan,1), UBOUND(OutData%BegPitMan,1) - OutData%BegPitMan(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BegPitMan(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchI not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlPitchI)) DEALLOCATE(OutData%BlPitchI) - ALLOCATE(OutData%BlPitchI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitchI,1), UBOUND(OutData%BlPitchI,1) - OutData%BlPitchI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TPitManE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TPitManE)) DEALLOCATE(OutData%TPitManE) - ALLOCATE(OutData%TPitManE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TPitManE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TPitManE,1), UBOUND(OutData%TPitManE,1) - OutData%TPitManE(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%BegYawMan = TRANSFER(IntKiBuf(Int_Xferred), OutData%BegYawMan) - Int_Xferred = Int_Xferred + 1 - OutData%NacYawI = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TYawManE = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%YawPosComInt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BegTpBr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BegTpBr)) DEALLOCATE(OutData%BegTpBr) - ALLOCATE(OutData%BegTpBr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BegTpBr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BegTpBr,1), UBOUND(OutData%BegTpBr,1) - OutData%BegTpBr(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BegTpBr(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TTpBrDp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TTpBrDp)) DEALLOCATE(OutData%TTpBrDp) - ALLOCATE(OutData%TTpBrDp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TTpBrDp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TTpBrDp,1), UBOUND(OutData%TTpBrDp,1) - OutData%TTpBrDp(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TTpBrFl not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TTpBrFl)) DEALLOCATE(OutData%TTpBrFl) - ALLOCATE(OutData%TTpBrFl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TTpBrFl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TTpBrFl,1), UBOUND(OutData%TTpBrFl,1) - OutData%TTpBrFl(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%Off4Good = TRANSFER(IntKiBuf(Int_Xferred), OutData%Off4Good) - Int_Xferred = Int_Xferred + 1 - OutData%GenOnLine = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenOnLine) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC)) DEALLOCATE(OutData%BStC) - ALLOCATE(OutData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStC,1), UBOUND(OutData%BStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%BStC(i1), ErrStat2, ErrMsg2 ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NStC)) DEALLOCATE(OutData%NStC) - ALLOCATE(OutData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC,1), UBOUND(OutData%NStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%NStC(i1), ErrStat2, ErrMsg2 ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TStC)) DEALLOCATE(OutData%TStC) - ALLOCATE(OutData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC,1), UBOUND(OutData%TStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%TStC(i1), ErrStat2, ErrMsg2 ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SStC)) DEALLOCATE(OutData%SStC) - ALLOCATE(OutData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC,1), UBOUND(OutData%SStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%SStC(i1), ErrStat2, ErrMsg2 ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE SrvD_UnPackOtherState - - SUBROUTINE SrvD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%LastTimeCalled = SrcMiscData%LastTimeCalled - CALL SrvD_Copybladeddlltype( SrcMiscData%dll_data, DstMiscData%dll_data, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%FirstWarn = SrcMiscData%FirstWarn - DstMiscData%LastTimeFiltered = SrcMiscData%LastTimeFiltered -IF (ALLOCATED(SrcMiscData%xd_BlPitchFilter)) THEN - i1_l = LBOUND(SrcMiscData%xd_BlPitchFilter,1) - i1_u = UBOUND(SrcMiscData%xd_BlPitchFilter,1) - IF (.NOT. ALLOCATED(DstMiscData%xd_BlPitchFilter)) THEN - ALLOCATE(DstMiscData%xd_BlPitchFilter(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xd_BlPitchFilter.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%xd_BlPitchFilter = SrcMiscData%xd_BlPitchFilter -ENDIF -IF (ALLOCATED(SrcMiscData%BStC)) THEN - i1_l = LBOUND(SrcMiscData%BStC,1) - i1_u = UBOUND(SrcMiscData%BStC,1) - IF (.NOT. ALLOCATED(DstMiscData%BStC)) THEN - ALLOCATE(DstMiscData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%BStC,1), UBOUND(SrcMiscData%BStC,1) - CALL StC_CopyMisc( SrcMiscData%BStC(i1), DstMiscData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%NStC)) THEN - i1_l = LBOUND(SrcMiscData%NStC,1) - i1_u = UBOUND(SrcMiscData%NStC,1) - IF (.NOT. ALLOCATED(DstMiscData%NStC)) THEN - ALLOCATE(DstMiscData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%NStC,1), UBOUND(SrcMiscData%NStC,1) - CALL StC_CopyMisc( SrcMiscData%NStC(i1), DstMiscData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%TStC)) THEN - i1_l = LBOUND(SrcMiscData%TStC,1) - i1_u = UBOUND(SrcMiscData%TStC,1) - IF (.NOT. ALLOCATED(DstMiscData%TStC)) THEN - ALLOCATE(DstMiscData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%TStC,1), UBOUND(SrcMiscData%TStC,1) - CALL StC_CopyMisc( SrcMiscData%TStC(i1), DstMiscData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%SStC)) THEN - i1_l = LBOUND(SrcMiscData%SStC,1) - i1_u = UBOUND(SrcMiscData%SStC,1) - IF (.NOT. ALLOCATED(DstMiscData%SStC)) THEN - ALLOCATE(DstMiscData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%SStC,1), UBOUND(SrcMiscData%SStC,1) - CALL StC_CopyMisc( SrcMiscData%SStC(i1), DstMiscData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE SrvD_CopyMisc - - SUBROUTINE SrvD_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyMisc' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - CALL SrvD_Destroybladeddlltype( MiscData%dll_data, ErrStat, ErrMsg ) -IF (ALLOCATED(MiscData%xd_BlPitchFilter)) THEN - DEALLOCATE(MiscData%xd_BlPitchFilter) -ENDIF -IF (ALLOCATED(MiscData%BStC)) THEN -DO i1 = LBOUND(MiscData%BStC,1), UBOUND(MiscData%BStC,1) - CALL StC_DestroyMisc( MiscData%BStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(MiscData%BStC) -ENDIF -IF (ALLOCATED(MiscData%NStC)) THEN -DO i1 = LBOUND(MiscData%NStC,1), UBOUND(MiscData%NStC,1) - CALL StC_DestroyMisc( MiscData%NStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(MiscData%NStC) -ENDIF -IF (ALLOCATED(MiscData%TStC)) THEN -DO i1 = LBOUND(MiscData%TStC,1), UBOUND(MiscData%TStC,1) - CALL StC_DestroyMisc( MiscData%TStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(MiscData%TStC) -ENDIF -IF (ALLOCATED(MiscData%SStC)) THEN -DO i1 = LBOUND(MiscData%SStC,1), UBOUND(MiscData%SStC,1) - CALL StC_DestroyMisc( MiscData%SStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(MiscData%SStC) -ENDIF - END SUBROUTINE SrvD_DestroyMisc - - SUBROUTINE SrvD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! LastTimeCalled - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! dll_data: size of buffers for each call to pack subtype - CALL SrvD_Packbladeddlltype( Re_Buf, Db_Buf, Int_Buf, InData%dll_data, ErrStat2, ErrMsg2, .TRUE. ) ! dll_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! dll_data - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! dll_data - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! dll_data - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! FirstWarn - Db_BufSz = Db_BufSz + 1 ! LastTimeFiltered - Int_BufSz = Int_BufSz + 1 ! xd_BlPitchFilter allocated yes/no - IF ( ALLOCATED(InData%xd_BlPitchFilter) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_BlPitchFilter upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%xd_BlPitchFilter) ! xd_BlPitchFilter - END IF - Int_BufSz = Int_BufSz + 1 ! BStC allocated yes/no - IF ( ALLOCATED(InData%BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC: size of buffers for each call to pack subtype - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC allocated yes/no - IF ( ALLOCATED(InData%NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC: size of buffers for each call to pack subtype - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC allocated yes/no - IF ( ALLOCATED(InData%TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC: size of buffers for each call to pack subtype - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC allocated yes/no - IF ( ALLOCATED(InData%SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC: size of buffers for each call to pack subtype - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%LastTimeCalled - Db_Xferred = Db_Xferred + 1 - CALL SrvD_Packbladeddlltype( Re_Buf, Db_Buf, Int_Buf, InData%dll_data, ErrStat2, ErrMsg2, OnlySize ) ! dll_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%LastTimeFiltered - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%xd_BlPitchFilter) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_BlPitchFilter,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_BlPitchFilter,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_BlPitchFilter,1), UBOUND(InData%xd_BlPitchFilter,1) - ReKiBuf(Re_Xferred) = InData%xd_BlPitchFilter(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE SrvD_PackMisc - - SUBROUTINE SrvD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%LastTimeCalled = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_Unpackbladeddlltype( Re_Buf, Db_Buf, Int_Buf, OutData%dll_data, ErrStat2, ErrMsg2 ) ! dll_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%FirstWarn = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn) - Int_Xferred = Int_Xferred + 1 - OutData%LastTimeFiltered = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_BlPitchFilter not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd_BlPitchFilter)) DEALLOCATE(OutData%xd_BlPitchFilter) - ALLOCATE(OutData%xd_BlPitchFilter(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BlPitchFilter.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_BlPitchFilter,1), UBOUND(OutData%xd_BlPitchFilter,1) - OutData%xd_BlPitchFilter(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC)) DEALLOCATE(OutData%BStC) - ALLOCATE(OutData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStC,1), UBOUND(OutData%BStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%BStC(i1), ErrStat2, ErrMsg2 ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NStC)) DEALLOCATE(OutData%NStC) - ALLOCATE(OutData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC,1), UBOUND(OutData%NStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%NStC(i1), ErrStat2, ErrMsg2 ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TStC)) DEALLOCATE(OutData%TStC) - ALLOCATE(OutData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC,1), UBOUND(OutData%TStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%TStC(i1), ErrStat2, ErrMsg2 ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SStC)) DEALLOCATE(OutData%SStC) - ALLOCATE(OutData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC,1), UBOUND(OutData%SStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%SStC(i1), ErrStat2, ErrMsg2 ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE SrvD_UnPackMisc - - SUBROUTINE SrvD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SrvD_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%HSSBrDT = SrcParamData%HSSBrDT - DstParamData%HSSBrTqF = SrcParamData%HSSBrTqF - DstParamData%SIG_POSl = SrcParamData%SIG_POSl - DstParamData%SIG_POTq = SrcParamData%SIG_POTq - DstParamData%SIG_SlPc = SrcParamData%SIG_SlPc - DstParamData%SIG_Slop = SrcParamData%SIG_Slop - DstParamData%SIG_SySp = SrcParamData%SIG_SySp - DstParamData%TEC_A0 = SrcParamData%TEC_A0 - DstParamData%TEC_C0 = SrcParamData%TEC_C0 - DstParamData%TEC_C1 = SrcParamData%TEC_C1 - DstParamData%TEC_C2 = SrcParamData%TEC_C2 - DstParamData%TEC_K2 = SrcParamData%TEC_K2 - DstParamData%TEC_MR = SrcParamData%TEC_MR - DstParamData%TEC_Re1 = SrcParamData%TEC_Re1 - DstParamData%TEC_RLR = SrcParamData%TEC_RLR - DstParamData%TEC_RRes = SrcParamData%TEC_RRes - DstParamData%TEC_SRes = SrcParamData%TEC_SRes - DstParamData%TEC_SySp = SrcParamData%TEC_SySp - DstParamData%TEC_V1a = SrcParamData%TEC_V1a - DstParamData%TEC_VLL = SrcParamData%TEC_VLL - DstParamData%TEC_Xe1 = SrcParamData%TEC_Xe1 - DstParamData%GenEff = SrcParamData%GenEff -IF (ALLOCATED(SrcParamData%BlPitchInit)) THEN - i1_l = LBOUND(SrcParamData%BlPitchInit,1) - i1_u = UBOUND(SrcParamData%BlPitchInit,1) - IF (.NOT. ALLOCATED(DstParamData%BlPitchInit)) THEN - ALLOCATE(DstParamData%BlPitchInit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlPitchInit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BlPitchInit = SrcParamData%BlPitchInit -ENDIF -IF (ALLOCATED(SrcParamData%BlPitchF)) THEN - i1_l = LBOUND(SrcParamData%BlPitchF,1) - i1_u = UBOUND(SrcParamData%BlPitchF,1) - IF (.NOT. ALLOCATED(DstParamData%BlPitchF)) THEN - ALLOCATE(DstParamData%BlPitchF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlPitchF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BlPitchF = SrcParamData%BlPitchF -ENDIF -IF (ALLOCATED(SrcParamData%PitManRat)) THEN - i1_l = LBOUND(SrcParamData%PitManRat,1) - i1_u = UBOUND(SrcParamData%PitManRat,1) - IF (.NOT. ALLOCATED(DstParamData%PitManRat)) THEN - ALLOCATE(DstParamData%PitManRat(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PitManRat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PitManRat = SrcParamData%PitManRat -ENDIF - DstParamData%YawManRat = SrcParamData%YawManRat - DstParamData%NacYawF = SrcParamData%NacYawF - DstParamData%SpdGenOn = SrcParamData%SpdGenOn - DstParamData%THSSBrDp = SrcParamData%THSSBrDp - DstParamData%THSSBrFl = SrcParamData%THSSBrFl - DstParamData%TimGenOf = SrcParamData%TimGenOf - DstParamData%TimGenOn = SrcParamData%TimGenOn - DstParamData%TPCOn = SrcParamData%TPCOn -IF (ALLOCATED(SrcParamData%TPitManS)) THEN - i1_l = LBOUND(SrcParamData%TPitManS,1) - i1_u = UBOUND(SrcParamData%TPitManS,1) - IF (.NOT. ALLOCATED(DstParamData%TPitManS)) THEN - ALLOCATE(DstParamData%TPitManS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TPitManS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TPitManS = SrcParamData%TPitManS -ENDIF - DstParamData%TYawManS = SrcParamData%TYawManS - DstParamData%TYCOn = SrcParamData%TYCOn - DstParamData%VS_RtGnSp = SrcParamData%VS_RtGnSp - DstParamData%VS_RtTq = SrcParamData%VS_RtTq - DstParamData%VS_Slope = SrcParamData%VS_Slope - DstParamData%VS_SlPc = SrcParamData%VS_SlPc - DstParamData%VS_SySp = SrcParamData%VS_SySp - DstParamData%VS_TrGnSp = SrcParamData%VS_TrGnSp - DstParamData%YawPosCom = SrcParamData%YawPosCom - DstParamData%YawRateCom = SrcParamData%YawRateCom - DstParamData%GenModel = SrcParamData%GenModel - DstParamData%HSSBrMode = SrcParamData%HSSBrMode - DstParamData%PCMode = SrcParamData%PCMode - DstParamData%VSContrl = SrcParamData%VSContrl - DstParamData%YCMode = SrcParamData%YCMode - DstParamData%GenTiStp = SrcParamData%GenTiStp - DstParamData%GenTiStr = SrcParamData%GenTiStr - DstParamData%VS_Rgn2K = SrcParamData%VS_Rgn2K - DstParamData%YawNeut = SrcParamData%YawNeut - DstParamData%YawSpr = SrcParamData%YawSpr - DstParamData%YawDamp = SrcParamData%YawDamp - DstParamData%TpBrDT = SrcParamData%TpBrDT -IF (ALLOCATED(SrcParamData%TBDepISp)) THEN - i1_l = LBOUND(SrcParamData%TBDepISp,1) - i1_u = UBOUND(SrcParamData%TBDepISp,1) - IF (.NOT. ALLOCATED(DstParamData%TBDepISp)) THEN - ALLOCATE(DstParamData%TBDepISp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TBDepISp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TBDepISp = SrcParamData%TBDepISp -ENDIF - DstParamData%TBDrConN = SrcParamData%TBDrConN - DstParamData%TBDrConD = SrcParamData%TBDrConD - DstParamData%NumBl = SrcParamData%NumBl - DstParamData%NumBStC = SrcParamData%NumBStC - DstParamData%NumNStC = SrcParamData%NumNStC - DstParamData%NumTStC = SrcParamData%NumTStC - DstParamData%NumSStC = SrcParamData%NumSStC - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%NumOuts_DLL = SrcParamData%NumOuts_DLL - DstParamData%RootName = SrcParamData%RootName -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,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 - ENDDO -ENDIF - DstParamData%Delim = SrcParamData%Delim - DstParamData%UseBladedInterface = SrcParamData%UseBladedInterface - DstParamData%UseLegacyInterface = SrcParamData%UseLegacyInterface - DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt - DstParamData%DLL_Ramp = SrcParamData%DLL_Ramp - DstParamData%BlAlpha = SrcParamData%BlAlpha - DstParamData%DLL_n = SrcParamData%DLL_n - DstParamData%avcOUTNAME_LEN = SrcParamData%avcOUTNAME_LEN - DstParamData%NacYaw_North = SrcParamData%NacYaw_North - DstParamData%AvgWindSpeed = SrcParamData%AvgWindSpeed - DstParamData%AirDens = SrcParamData%AirDens - DstParamData%TrimCase = SrcParamData%TrimCase - DstParamData%TrimGain = SrcParamData%TrimGain - DstParamData%RotSpeedRef = SrcParamData%RotSpeedRef -IF (ALLOCATED(SrcParamData%BStC)) THEN - i1_l = LBOUND(SrcParamData%BStC,1) - i1_u = UBOUND(SrcParamData%BStC,1) - IF (.NOT. ALLOCATED(DstParamData%BStC)) THEN - ALLOCATE(DstParamData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%BStC,1), UBOUND(SrcParamData%BStC,1) - CALL StC_CopyParam( SrcParamData%BStC(i1), DstParamData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%NStC)) THEN - i1_l = LBOUND(SrcParamData%NStC,1) - i1_u = UBOUND(SrcParamData%NStC,1) - IF (.NOT. ALLOCATED(DstParamData%NStC)) THEN - ALLOCATE(DstParamData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%NStC,1), UBOUND(SrcParamData%NStC,1) - CALL StC_CopyParam( SrcParamData%NStC(i1), DstParamData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%TStC)) THEN - i1_l = LBOUND(SrcParamData%TStC,1) - i1_u = UBOUND(SrcParamData%TStC,1) - IF (.NOT. ALLOCATED(DstParamData%TStC)) THEN - ALLOCATE(DstParamData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%TStC,1), UBOUND(SrcParamData%TStC,1) - CALL StC_CopyParam( SrcParamData%TStC(i1), DstParamData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%SStC)) THEN - i1_l = LBOUND(SrcParamData%SStC,1) - i1_u = UBOUND(SrcParamData%SStC,1) - IF (.NOT. ALLOCATED(DstParamData%SStC)) THEN - ALLOCATE(DstParamData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%SStC,1), UBOUND(SrcParamData%SStC,1) - CALL StC_CopyParam( SrcParamData%SStC(i1), DstParamData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%UseSC = SrcParamData%UseSC - END SUBROUTINE SrvD_CopyParam - - SUBROUTINE SrvD_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(SrvD_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyParam' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ParamData%BlPitchInit)) THEN - DEALLOCATE(ParamData%BlPitchInit) -ENDIF -IF (ALLOCATED(ParamData%BlPitchF)) THEN - DEALLOCATE(ParamData%BlPitchF) -ENDIF -IF (ALLOCATED(ParamData%PitManRat)) THEN - DEALLOCATE(ParamData%PitManRat) -ENDIF -IF (ALLOCATED(ParamData%TPitManS)) THEN - DEALLOCATE(ParamData%TPitManS) -ENDIF -IF (ALLOCATED(ParamData%TBDepISp)) THEN - DEALLOCATE(ParamData%TBDepISp) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF - CALL FreeDynamicLib( ParamData%DLL_Trgt, ErrStat, ErrMsg ) -IF (ALLOCATED(ParamData%BStC)) THEN -DO i1 = LBOUND(ParamData%BStC,1), UBOUND(ParamData%BStC,1) - CALL StC_DestroyParam( ParamData%BStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ParamData%BStC) -ENDIF -IF (ALLOCATED(ParamData%NStC)) THEN -DO i1 = LBOUND(ParamData%NStC,1), UBOUND(ParamData%NStC,1) - CALL StC_DestroyParam( ParamData%NStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ParamData%NStC) -ENDIF -IF (ALLOCATED(ParamData%TStC)) THEN -DO i1 = LBOUND(ParamData%TStC,1), UBOUND(ParamData%TStC,1) - CALL StC_DestroyParam( ParamData%TStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ParamData%TStC) -ENDIF -IF (ALLOCATED(ParamData%SStC)) THEN -DO i1 = LBOUND(ParamData%SStC,1), UBOUND(ParamData%SStC,1) - CALL StC_DestroyParam( ParamData%SStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ParamData%SStC) -ENDIF - END SUBROUTINE SrvD_DestroyParam - - SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Db_BufSz = Db_BufSz + 1 ! HSSBrDT - Re_BufSz = Re_BufSz + 1 ! HSSBrTqF - Re_BufSz = Re_BufSz + 1 ! SIG_POSl - Re_BufSz = Re_BufSz + 1 ! SIG_POTq - Re_BufSz = Re_BufSz + 1 ! SIG_SlPc - Re_BufSz = Re_BufSz + 1 ! SIG_Slop - Re_BufSz = Re_BufSz + 1 ! SIG_SySp - Re_BufSz = Re_BufSz + 1 ! TEC_A0 - Re_BufSz = Re_BufSz + 1 ! TEC_C0 - Re_BufSz = Re_BufSz + 1 ! TEC_C1 - Re_BufSz = Re_BufSz + 1 ! TEC_C2 - Re_BufSz = Re_BufSz + 1 ! TEC_K2 - Re_BufSz = Re_BufSz + 1 ! TEC_MR - Re_BufSz = Re_BufSz + 1 ! TEC_Re1 - Re_BufSz = Re_BufSz + 1 ! TEC_RLR - Re_BufSz = Re_BufSz + 1 ! TEC_RRes - Re_BufSz = Re_BufSz + 1 ! TEC_SRes - Re_BufSz = Re_BufSz + 1 ! TEC_SySp - Re_BufSz = Re_BufSz + 1 ! TEC_V1a - Re_BufSz = Re_BufSz + 1 ! TEC_VLL - Re_BufSz = Re_BufSz + 1 ! TEC_Xe1 - Re_BufSz = Re_BufSz + 1 ! GenEff - Int_BufSz = Int_BufSz + 1 ! BlPitchInit allocated yes/no - IF ( ALLOCATED(InData%BlPitchInit) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitchInit upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchInit) ! BlPitchInit - END IF - Int_BufSz = Int_BufSz + 1 ! BlPitchF allocated yes/no - IF ( ALLOCATED(InData%BlPitchF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitchF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchF) ! BlPitchF - END IF - Int_BufSz = Int_BufSz + 1 ! PitManRat allocated yes/no - IF ( ALLOCATED(InData%PitManRat) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PitManRat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PitManRat) ! PitManRat - END IF - Re_BufSz = Re_BufSz + 1 ! YawManRat - Re_BufSz = Re_BufSz + 1 ! NacYawF - Re_BufSz = Re_BufSz + 1 ! SpdGenOn - Db_BufSz = Db_BufSz + 1 ! THSSBrDp - Db_BufSz = Db_BufSz + 1 ! THSSBrFl - Db_BufSz = Db_BufSz + 1 ! TimGenOf - Db_BufSz = Db_BufSz + 1 ! TimGenOn - Db_BufSz = Db_BufSz + 1 ! TPCOn - Int_BufSz = Int_BufSz + 1 ! TPitManS allocated yes/no - IF ( ALLOCATED(InData%TPitManS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TPitManS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%TPitManS) ! TPitManS - END IF - Db_BufSz = Db_BufSz + 1 ! TYawManS - Db_BufSz = Db_BufSz + 1 ! TYCOn - Re_BufSz = Re_BufSz + 1 ! VS_RtGnSp - Re_BufSz = Re_BufSz + 1 ! VS_RtTq - Re_BufSz = Re_BufSz + 1 ! VS_Slope - Re_BufSz = Re_BufSz + 1 ! VS_SlPc - Re_BufSz = Re_BufSz + 1 ! VS_SySp - Re_BufSz = Re_BufSz + 1 ! VS_TrGnSp - Re_BufSz = Re_BufSz + 1 ! YawPosCom - Re_BufSz = Re_BufSz + 1 ! YawRateCom - Int_BufSz = Int_BufSz + 1 ! GenModel - Int_BufSz = Int_BufSz + 1 ! HSSBrMode - Int_BufSz = Int_BufSz + 1 ! PCMode - Int_BufSz = Int_BufSz + 1 ! VSContrl - Int_BufSz = Int_BufSz + 1 ! YCMode - Int_BufSz = Int_BufSz + 1 ! GenTiStp - Int_BufSz = Int_BufSz + 1 ! GenTiStr - Re_BufSz = Re_BufSz + 1 ! VS_Rgn2K - Re_BufSz = Re_BufSz + 1 ! YawNeut - Re_BufSz = Re_BufSz + 1 ! YawSpr - Re_BufSz = Re_BufSz + 1 ! YawDamp - Db_BufSz = Db_BufSz + 1 ! TpBrDT - Int_BufSz = Int_BufSz + 1 ! TBDepISp allocated yes/no - IF ( ALLOCATED(InData%TBDepISp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TBDepISp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TBDepISp) ! TBDepISp - END IF - Re_BufSz = Re_BufSz + 1 ! TBDrConN - Re_BufSz = Re_BufSz + 1 ! TBDrConD - Int_BufSz = Int_BufSz + 1 ! NumBl - Int_BufSz = Int_BufSz + 1 ! NumBStC - Int_BufSz = Int_BufSz + 1 ! NumNStC - Int_BufSz = Int_BufSz + 1 ! NumTStC - Int_BufSz = Int_BufSz + 1 ! NumSStC - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! NumOuts_DLL - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1 ! UseBladedInterface - Int_BufSz = Int_BufSz + 1 ! UseLegacyInterface - Int_BufSz = Int_BufSz + 3 ! DLL_Trgt: size of buffers for each call to pack subtype - CALL DLLTypePack( InData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! DLL_Trgt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DLL_Trgt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DLL_Trgt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DLL_Trgt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! DLL_Ramp - Re_BufSz = Re_BufSz + 1 ! BlAlpha - Int_BufSz = Int_BufSz + 1 ! DLL_n - Int_BufSz = Int_BufSz + 1 ! avcOUTNAME_LEN - Re_BufSz = Re_BufSz + 1 ! NacYaw_North - Re_BufSz = Re_BufSz + 1 ! AvgWindSpeed - Re_BufSz = Re_BufSz + 1 ! AirDens - Int_BufSz = Int_BufSz + 1 ! TrimCase - Re_BufSz = Re_BufSz + 1 ! TrimGain - Re_BufSz = Re_BufSz + 1 ! RotSpeedRef - Int_BufSz = Int_BufSz + 1 ! BStC allocated yes/no - IF ( ALLOCATED(InData%BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC: size of buffers for each call to pack subtype - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC allocated yes/no - IF ( ALLOCATED(InData%NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC: size of buffers for each call to pack subtype - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC allocated yes/no - IF ( ALLOCATED(InData%TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC: size of buffers for each call to pack subtype - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC allocated yes/no - IF ( ALLOCATED(InData%SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC: size of buffers for each call to pack subtype - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! UseSC - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%HSSBrDT - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSSBrTqF - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_POSl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_POTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_Slop - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_A0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_C0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_C1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_C2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_K2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_MR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_Re1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_RLR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_RRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_SRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_V1a - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_VLL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_Xe1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenEff - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlPitchInit) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitchInit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchInit,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitchInit,1), UBOUND(InData%BlPitchInit,1) - ReKiBuf(Re_Xferred) = InData%BlPitchInit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlPitchF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitchF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitchF,1), UBOUND(InData%BlPitchF,1) - ReKiBuf(Re_Xferred) = InData%BlPitchF(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PitManRat) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PitManRat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitManRat,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PitManRat,1), UBOUND(InData%PitManRat,1) - ReKiBuf(Re_Xferred) = InData%PitManRat(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%YawManRat - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYawF - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdGenOn - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%THSSBrDp - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%THSSBrFl - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TimGenOf - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TimGenOn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TPCOn - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TPitManS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TPitManS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TPitManS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TPitManS,1), UBOUND(InData%TPitManS,1) - DbKiBuf(Db_Xferred) = InData%TPitManS(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%TYawManS - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TYCOn - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_RtGnSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_RtTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_Slope - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_TrGnSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawPosCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawRateCom - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%GenModel - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%HSSBrMode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%PCMode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VSContrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%YCMode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStr, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_Rgn2K - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawNeut - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawDamp - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TpBrDT - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TBDepISp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TBDepISp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TBDepISp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TBDepISp,1), UBOUND(InData%TBDepISp,1) - ReKiBuf(Re_Xferred) = InData%TBDepISp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TBDrConN - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TBDrConD - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBStC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumNStC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumTStC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSStC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts_DLL - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseBladedInterface, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseLegacyInterface, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL DLLTypePack( InData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! DLL_Trgt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%DLL_Ramp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%BlAlpha - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DLL_n - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%avcOUTNAME_LEN - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYaw_North - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AvgWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TrimCase - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TrimGain - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeedRef - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseSC, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SrvD_PackParam - - SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrTqF = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_POSl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_POTq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SlPc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_Slop = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SySp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_A0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_C0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_C1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_C2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_K2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_MR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_Re1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RLR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RRes = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_SRes = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_SySp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_V1a = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_VLL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_Xe1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenEff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchInit not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlPitchInit)) DEALLOCATE(OutData%BlPitchInit) - ALLOCATE(OutData%BlPitchInit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitchInit,1), UBOUND(OutData%BlPitchInit,1) - OutData%BlPitchInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlPitchF)) DEALLOCATE(OutData%BlPitchF) - ALLOCATE(OutData%BlPitchF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitchF,1), UBOUND(OutData%BlPitchF,1) - OutData%BlPitchF(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitManRat not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PitManRat)) DEALLOCATE(OutData%PitManRat) - ALLOCATE(OutData%PitManRat(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitManRat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PitManRat,1), UBOUND(OutData%PitManRat,1) - OutData%PitManRat(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%YawManRat = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacYawF = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpdGenOn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%THSSBrDp = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%THSSBrFl = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%TimGenOf = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%TimGenOn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%TPCOn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TPitManS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TPitManS)) DEALLOCATE(OutData%TPitManS) - ALLOCATE(OutData%TPitManS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TPitManS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TPitManS,1), UBOUND(OutData%TPitManS,1) - OutData%TPitManS(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%TYawManS = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%TYCOn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%VS_RtGnSp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_RtTq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_Slope = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_SlPc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_SySp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_TrGnSp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawPosCom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawRateCom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenModel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HSSBrMode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PCMode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VSContrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%YCMode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%GenTiStp = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStp) - Int_Xferred = Int_Xferred + 1 - OutData%GenTiStr = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStr) - Int_Xferred = Int_Xferred + 1 - OutData%VS_Rgn2K = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawNeut = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawDamp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TpBrDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TBDepISp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TBDepISp)) DEALLOCATE(OutData%TBDepISp) - ALLOCATE(OutData%TBDepISp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TBDepISp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TBDepISp,1), UBOUND(OutData%TBDepISp,1) - OutData%TBDepISp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%TBDrConN = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TBDrConD = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumNStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumTStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumSStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts_DLL = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UseBladedInterface = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseBladedInterface) - Int_Xferred = Int_Xferred + 1 - OutData%UseLegacyInterface = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseLegacyInterface) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DLLTypeUnpack( OutData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! DLL_Trgt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%DLL_Ramp = TRANSFER(IntKiBuf(Int_Xferred), OutData%DLL_Ramp) - Int_Xferred = Int_Xferred + 1 - OutData%BlAlpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DLL_n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%avcOUTNAME_LEN = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NacYaw_North = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AvgWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TrimCase = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TrimGain = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeedRef = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC)) DEALLOCATE(OutData%BStC) - ALLOCATE(OutData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStC,1), UBOUND(OutData%BStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%BStC(i1), ErrStat2, ErrMsg2 ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NStC)) DEALLOCATE(OutData%NStC) - ALLOCATE(OutData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC,1), UBOUND(OutData%NStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%NStC(i1), ErrStat2, ErrMsg2 ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TStC)) DEALLOCATE(OutData%TStC) - ALLOCATE(OutData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC,1), UBOUND(OutData%TStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%TStC(i1), ErrStat2, ErrMsg2 ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SStC)) DEALLOCATE(OutData%SStC) - ALLOCATE(OutData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC,1), UBOUND(OutData%SStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%SStC(i1), ErrStat2, ErrMsg2 ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%UseSC = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseSC) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SrvD_UnPackParam - - SUBROUTINE SrvD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_InputType), INTENT(INOUT) :: SrcInputData - TYPE(SrvD_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%BlPitch)) THEN - i1_l = LBOUND(SrcInputData%BlPitch,1) - i1_u = UBOUND(SrcInputData%BlPitch,1) - IF (.NOT. ALLOCATED(DstInputData%BlPitch)) THEN - ALLOCATE(DstInputData%BlPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BlPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%BlPitch = SrcInputData%BlPitch -ENDIF - DstInputData%Yaw = SrcInputData%Yaw - DstInputData%YawRate = SrcInputData%YawRate - DstInputData%LSS_Spd = SrcInputData%LSS_Spd - DstInputData%HSS_Spd = SrcInputData%HSS_Spd - DstInputData%RotSpeed = SrcInputData%RotSpeed - DstInputData%ExternalYawPosCom = SrcInputData%ExternalYawPosCom - DstInputData%ExternalYawRateCom = SrcInputData%ExternalYawRateCom -IF (ALLOCATED(SrcInputData%ExternalBlPitchCom)) THEN - i1_l = LBOUND(SrcInputData%ExternalBlPitchCom,1) - i1_u = UBOUND(SrcInputData%ExternalBlPitchCom,1) - IF (.NOT. ALLOCATED(DstInputData%ExternalBlPitchCom)) THEN - ALLOCATE(DstInputData%ExternalBlPitchCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalBlPitchCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%ExternalBlPitchCom = SrcInputData%ExternalBlPitchCom -ENDIF - DstInputData%ExternalGenTrq = SrcInputData%ExternalGenTrq - DstInputData%ExternalElecPwr = SrcInputData%ExternalElecPwr - DstInputData%ExternalHSSBrFrac = SrcInputData%ExternalHSSBrFrac - DstInputData%TwrAccel = SrcInputData%TwrAccel - DstInputData%YawErr = SrcInputData%YawErr - DstInputData%WindDir = SrcInputData%WindDir - DstInputData%RootMyc = SrcInputData%RootMyc - DstInputData%YawBrTAxp = SrcInputData%YawBrTAxp - DstInputData%YawBrTAyp = SrcInputData%YawBrTAyp - DstInputData%LSSTipPxa = SrcInputData%LSSTipPxa - DstInputData%RootMxc = SrcInputData%RootMxc - DstInputData%LSSTipMxa = SrcInputData%LSSTipMxa - DstInputData%LSSTipMya = SrcInputData%LSSTipMya - DstInputData%LSSTipMza = SrcInputData%LSSTipMza - DstInputData%LSSTipMys = SrcInputData%LSSTipMys - DstInputData%LSSTipMzs = SrcInputData%LSSTipMzs - DstInputData%YawBrMyn = SrcInputData%YawBrMyn - DstInputData%YawBrMzn = SrcInputData%YawBrMzn - DstInputData%NcIMURAxs = SrcInputData%NcIMURAxs - DstInputData%NcIMURAys = SrcInputData%NcIMURAys - DstInputData%NcIMURAzs = SrcInputData%NcIMURAzs - DstInputData%RotPwr = SrcInputData%RotPwr - DstInputData%HorWindV = SrcInputData%HorWindV - DstInputData%YawAngle = SrcInputData%YawAngle -IF (ALLOCATED(SrcInputData%BStC)) THEN - i1_l = LBOUND(SrcInputData%BStC,1) - i1_u = UBOUND(SrcInputData%BStC,1) - IF (.NOT. ALLOCATED(DstInputData%BStC)) THEN - ALLOCATE(DstInputData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%BStC,1), UBOUND(SrcInputData%BStC,1) - CALL StC_CopyInput( SrcInputData%BStC(i1), DstInputData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%NStC)) THEN - i1_l = LBOUND(SrcInputData%NStC,1) - i1_u = UBOUND(SrcInputData%NStC,1) - IF (.NOT. ALLOCATED(DstInputData%NStC)) THEN - ALLOCATE(DstInputData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%NStC,1), UBOUND(SrcInputData%NStC,1) - CALL StC_CopyInput( SrcInputData%NStC(i1), DstInputData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%TStC)) THEN - i1_l = LBOUND(SrcInputData%TStC,1) - i1_u = UBOUND(SrcInputData%TStC,1) - IF (.NOT. ALLOCATED(DstInputData%TStC)) THEN - ALLOCATE(DstInputData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%TStC,1), UBOUND(SrcInputData%TStC,1) - CALL StC_CopyInput( SrcInputData%TStC(i1), DstInputData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%SStC)) THEN - i1_l = LBOUND(SrcInputData%SStC,1) - i1_u = UBOUND(SrcInputData%SStC,1) - IF (.NOT. ALLOCATED(DstInputData%SStC)) THEN - ALLOCATE(DstInputData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%SStC,1), UBOUND(SrcInputData%SStC,1) - CALL StC_CopyInput( SrcInputData%SStC(i1), DstInputData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%fromSC)) THEN - i1_l = LBOUND(SrcInputData%fromSC,1) - i1_u = UBOUND(SrcInputData%fromSC,1) - IF (.NOT. ALLOCATED(DstInputData%fromSC)) THEN - ALLOCATE(DstInputData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%fromSC = SrcInputData%fromSC -ENDIF -IF (ALLOCATED(SrcInputData%fromSCglob)) THEN - i1_l = LBOUND(SrcInputData%fromSCglob,1) - i1_u = UBOUND(SrcInputData%fromSCglob,1) - IF (.NOT. ALLOCATED(DstInputData%fromSCglob)) THEN - ALLOCATE(DstInputData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%fromSCglob = SrcInputData%fromSCglob -ENDIF -IF (ALLOCATED(SrcInputData%Lidar)) THEN - i1_l = LBOUND(SrcInputData%Lidar,1) - i1_u = UBOUND(SrcInputData%Lidar,1) - IF (.NOT. ALLOCATED(DstInputData%Lidar)) THEN - ALLOCATE(DstInputData%Lidar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Lidar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Lidar = SrcInputData%Lidar -ENDIF - END SUBROUTINE SrvD_CopyInput - - SUBROUTINE SrvD_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(SrvD_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InputData%BlPitch)) THEN - DEALLOCATE(InputData%BlPitch) -ENDIF -IF (ALLOCATED(InputData%ExternalBlPitchCom)) THEN - DEALLOCATE(InputData%ExternalBlPitchCom) -ENDIF -IF (ALLOCATED(InputData%BStC)) THEN -DO i1 = LBOUND(InputData%BStC,1), UBOUND(InputData%BStC,1) - CALL StC_DestroyInput( InputData%BStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(InputData%BStC) -ENDIF -IF (ALLOCATED(InputData%NStC)) THEN -DO i1 = LBOUND(InputData%NStC,1), UBOUND(InputData%NStC,1) - CALL StC_DestroyInput( InputData%NStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(InputData%NStC) -ENDIF -IF (ALLOCATED(InputData%TStC)) THEN -DO i1 = LBOUND(InputData%TStC,1), UBOUND(InputData%TStC,1) - CALL StC_DestroyInput( InputData%TStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(InputData%TStC) -ENDIF -IF (ALLOCATED(InputData%SStC)) THEN -DO i1 = LBOUND(InputData%SStC,1), UBOUND(InputData%SStC,1) - CALL StC_DestroyInput( InputData%SStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(InputData%SStC) -ENDIF -IF (ALLOCATED(InputData%fromSC)) THEN - DEALLOCATE(InputData%fromSC) -ENDIF -IF (ALLOCATED(InputData%fromSCglob)) THEN - DEALLOCATE(InputData%fromSCglob) -ENDIF -IF (ALLOCATED(InputData%Lidar)) THEN - DEALLOCATE(InputData%Lidar) -ENDIF - END SUBROUTINE SrvD_DestroyInput - - SUBROUTINE SrvD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! BlPitch allocated yes/no - IF ( ALLOCATED(InData%BlPitch) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitch upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitch) ! BlPitch - END IF - Re_BufSz = Re_BufSz + 1 ! Yaw - Re_BufSz = Re_BufSz + 1 ! YawRate - Re_BufSz = Re_BufSz + 1 ! LSS_Spd - Re_BufSz = Re_BufSz + 1 ! HSS_Spd - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Re_BufSz = Re_BufSz + 1 ! ExternalYawPosCom - Re_BufSz = Re_BufSz + 1 ! ExternalYawRateCom - Int_BufSz = Int_BufSz + 1 ! ExternalBlPitchCom allocated yes/no - IF ( ALLOCATED(InData%ExternalBlPitchCom) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ExternalBlPitchCom upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ExternalBlPitchCom) ! ExternalBlPitchCom - END IF - Re_BufSz = Re_BufSz + 1 ! ExternalGenTrq - Re_BufSz = Re_BufSz + 1 ! ExternalElecPwr - Re_BufSz = Re_BufSz + 1 ! ExternalHSSBrFrac - Re_BufSz = Re_BufSz + 1 ! TwrAccel - Re_BufSz = Re_BufSz + 1 ! YawErr - Re_BufSz = Re_BufSz + 1 ! WindDir - Re_BufSz = Re_BufSz + SIZE(InData%RootMyc) ! RootMyc - Re_BufSz = Re_BufSz + 1 ! YawBrTAxp - Re_BufSz = Re_BufSz + 1 ! YawBrTAyp - Re_BufSz = Re_BufSz + 1 ! LSSTipPxa - Re_BufSz = Re_BufSz + SIZE(InData%RootMxc) ! RootMxc - Re_BufSz = Re_BufSz + 1 ! LSSTipMxa - Re_BufSz = Re_BufSz + 1 ! LSSTipMya - Re_BufSz = Re_BufSz + 1 ! LSSTipMza - Re_BufSz = Re_BufSz + 1 ! LSSTipMys - Re_BufSz = Re_BufSz + 1 ! LSSTipMzs - Re_BufSz = Re_BufSz + 1 ! YawBrMyn - Re_BufSz = Re_BufSz + 1 ! YawBrMzn - Re_BufSz = Re_BufSz + 1 ! NcIMURAxs - Re_BufSz = Re_BufSz + 1 ! NcIMURAys - Re_BufSz = Re_BufSz + 1 ! NcIMURAzs - Re_BufSz = Re_BufSz + 1 ! RotPwr - Re_BufSz = Re_BufSz + 1 ! HorWindV - Re_BufSz = Re_BufSz + 1 ! YawAngle - Int_BufSz = Int_BufSz + 1 ! BStC allocated yes/no - IF ( ALLOCATED(InData%BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStC upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC: size of buffers for each call to pack subtype - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC allocated yes/no - IF ( ALLOCATED(InData%NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC: size of buffers for each call to pack subtype - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC allocated yes/no - IF ( ALLOCATED(InData%TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC: size of buffers for each call to pack subtype - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC allocated yes/no - IF ( ALLOCATED(InData%SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC: size of buffers for each call to pack subtype - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! fromSC allocated yes/no - IF ( ALLOCATED(InData%fromSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSC) ! fromSC - END IF - Int_BufSz = Int_BufSz + 1 ! fromSCglob allocated yes/no - IF ( ALLOCATED(InData%fromSCglob) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSCglob upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSCglob) ! fromSCglob - END IF - Int_BufSz = Int_BufSz + 1 ! Lidar allocated yes/no - IF ( ALLOCATED(InData%Lidar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Lidar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Lidar) ! Lidar - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%BlPitch) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitch,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitch,1), UBOUND(InData%BlPitch,1) - ReKiBuf(Re_Xferred) = InData%BlPitch(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Yaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ExternalYawPosCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ExternalYawRateCom - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ExternalBlPitchCom) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ExternalBlPitchCom,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ExternalBlPitchCom,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ExternalBlPitchCom,1), UBOUND(InData%ExternalBlPitchCom,1) - ReKiBuf(Re_Xferred) = InData%ExternalBlPitchCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%ExternalGenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ExternalElecPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ExternalHSSBrFrac - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TwrAccel - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawErr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WindDir - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%RootMyc,1), UBOUND(InData%RootMyc,1) - ReKiBuf(Re_Xferred) = InData%RootMyc(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%YawBrTAxp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrTAyp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipPxa - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%RootMxc,1), UBOUND(InData%RootMxc,1) - ReKiBuf(Re_Xferred) = InData%RootMxc(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%LSSTipMxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMya - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMza - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAxs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HorWindV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawAngle - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fromSC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSC,1), UBOUND(InData%fromSC,1) - ReKiBuf(Re_Xferred) = InData%fromSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fromSCglob) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSCglob,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSCglob,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSCglob,1), UBOUND(InData%fromSCglob,1) - ReKiBuf(Re_Xferred) = InData%fromSCglob(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Lidar) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Lidar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Lidar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Lidar,1), UBOUND(InData%Lidar,1) - ReKiBuf(Re_Xferred) = InData%Lidar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SrvD_PackInput - - SUBROUTINE SrvD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitch not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlPitch)) DEALLOCATE(OutData%BlPitch) - ALLOCATE(OutData%BlPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitch,1), UBOUND(OutData%BlPitch,1) - OutData%BlPitch(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Yaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawRate = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSS_Spd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HSS_Spd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalYawPosCom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalYawRateCom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ExternalBlPitchCom not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ExternalBlPitchCom)) DEALLOCATE(OutData%ExternalBlPitchCom) - ALLOCATE(OutData%ExternalBlPitchCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalBlPitchCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ExternalBlPitchCom,1), UBOUND(OutData%ExternalBlPitchCom,1) - OutData%ExternalBlPitchCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%ExternalGenTrq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalElecPwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalHSSBrFrac = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TwrAccel = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawErr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WindDir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%RootMyc,1) - i1_u = UBOUND(OutData%RootMyc,1) - DO i1 = LBOUND(OutData%RootMyc,1), UBOUND(OutData%RootMyc,1) - OutData%RootMyc(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%YawBrTAxp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrTAyp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipPxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%RootMxc,1) - i1_u = UBOUND(OutData%RootMxc,1) - DO i1 = LBOUND(OutData%RootMxc,1), UBOUND(OutData%RootMxc,1) - OutData%RootMxc(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%LSSTipMxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMya = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMza = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAxs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotPwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HorWindV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawAngle = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC)) DEALLOCATE(OutData%BStC) - ALLOCATE(OutData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStC,1), UBOUND(OutData%BStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%BStC(i1), ErrStat2, ErrMsg2 ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NStC)) DEALLOCATE(OutData%NStC) - ALLOCATE(OutData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC,1), UBOUND(OutData%NStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%NStC(i1), ErrStat2, ErrMsg2 ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TStC)) DEALLOCATE(OutData%TStC) - ALLOCATE(OutData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC,1), UBOUND(OutData%TStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%TStC(i1), ErrStat2, ErrMsg2 ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SStC)) DEALLOCATE(OutData%SStC) - ALLOCATE(OutData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC,1), UBOUND(OutData%SStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%SStC(i1), ErrStat2, ErrMsg2 ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%fromSC)) DEALLOCATE(OutData%fromSC) - ALLOCATE(OutData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) - OutData%fromSC(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSCglob not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%fromSCglob)) DEALLOCATE(OutData%fromSCglob) - ALLOCATE(OutData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSCglob,1), UBOUND(OutData%fromSCglob,1) - OutData%fromSCglob(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Lidar not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Lidar)) DEALLOCATE(OutData%Lidar) - ALLOCATE(OutData%Lidar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lidar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Lidar,1), UBOUND(OutData%Lidar,1) - OutData%Lidar(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SrvD_UnPackInput - - SUBROUTINE SrvD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(SrvD_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF -IF (ALLOCATED(SrcOutputData%BlPitchCom)) THEN - i1_l = LBOUND(SrcOutputData%BlPitchCom,1) - i1_u = UBOUND(SrcOutputData%BlPitchCom,1) - IF (.NOT. ALLOCATED(DstOutputData%BlPitchCom)) THEN - ALLOCATE(DstOutputData%BlPitchCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlPitchCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%BlPitchCom = SrcOutputData%BlPitchCom -ENDIF -IF (ALLOCATED(SrcOutputData%BlAirfoilCom)) THEN - i1_l = LBOUND(SrcOutputData%BlAirfoilCom,1) - i1_u = UBOUND(SrcOutputData%BlAirfoilCom,1) - IF (.NOT. ALLOCATED(DstOutputData%BlAirfoilCom)) THEN - ALLOCATE(DstOutputData%BlAirfoilCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlAirfoilCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%BlAirfoilCom = SrcOutputData%BlAirfoilCom -ENDIF - DstOutputData%YawMom = SrcOutputData%YawMom - DstOutputData%GenTrq = SrcOutputData%GenTrq - DstOutputData%HSSBrTrqC = SrcOutputData%HSSBrTrqC - DstOutputData%ElecPwr = SrcOutputData%ElecPwr -IF (ALLOCATED(SrcOutputData%TBDrCon)) THEN - i1_l = LBOUND(SrcOutputData%TBDrCon,1) - i1_u = UBOUND(SrcOutputData%TBDrCon,1) - IF (.NOT. ALLOCATED(DstOutputData%TBDrCon)) THEN - ALLOCATE(DstOutputData%TBDrCon(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TBDrCon.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%TBDrCon = SrcOutputData%TBDrCon -ENDIF -IF (ALLOCATED(SrcOutputData%BStC)) THEN - i1_l = LBOUND(SrcOutputData%BStC,1) - i1_u = UBOUND(SrcOutputData%BStC,1) - IF (.NOT. ALLOCATED(DstOutputData%BStC)) THEN - ALLOCATE(DstOutputData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%BStC,1), UBOUND(SrcOutputData%BStC,1) - CALL StC_CopyOutput( SrcOutputData%BStC(i1), DstOutputData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%NStC)) THEN - i1_l = LBOUND(SrcOutputData%NStC,1) - i1_u = UBOUND(SrcOutputData%NStC,1) - IF (.NOT. ALLOCATED(DstOutputData%NStC)) THEN - ALLOCATE(DstOutputData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%NStC,1), UBOUND(SrcOutputData%NStC,1) - CALL StC_CopyOutput( SrcOutputData%NStC(i1), DstOutputData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%TStC)) THEN - i1_l = LBOUND(SrcOutputData%TStC,1) - i1_u = UBOUND(SrcOutputData%TStC,1) - IF (.NOT. ALLOCATED(DstOutputData%TStC)) THEN - ALLOCATE(DstOutputData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%TStC,1), UBOUND(SrcOutputData%TStC,1) - CALL StC_CopyOutput( SrcOutputData%TStC(i1), DstOutputData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%SStC)) THEN - i1_l = LBOUND(SrcOutputData%SStC,1) - i1_u = UBOUND(SrcOutputData%SStC,1) - IF (.NOT. ALLOCATED(DstOutputData%SStC)) THEN - ALLOCATE(DstOutputData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%SStC,1), UBOUND(SrcOutputData%SStC,1) - CALL StC_CopyOutput( SrcOutputData%SStC(i1), DstOutputData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%toSC)) THEN - i1_l = LBOUND(SrcOutputData%toSC,1) - i1_u = UBOUND(SrcOutputData%toSC,1) - IF (.NOT. ALLOCATED(DstOutputData%toSC)) THEN - ALLOCATE(DstOutputData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%toSC = SrcOutputData%toSC -ENDIF -IF (ALLOCATED(SrcOutputData%Lidar)) THEN - i1_l = LBOUND(SrcOutputData%Lidar,1) - i1_u = UBOUND(SrcOutputData%Lidar,1) - IF (.NOT. ALLOCATED(DstOutputData%Lidar)) THEN - ALLOCATE(DstOutputData%Lidar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Lidar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Lidar = SrcOutputData%Lidar -ENDIF - END SUBROUTINE SrvD_CopyOutput - - SUBROUTINE SrvD_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(SrvD_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF -IF (ALLOCATED(OutputData%BlPitchCom)) THEN - DEALLOCATE(OutputData%BlPitchCom) -ENDIF -IF (ALLOCATED(OutputData%BlAirfoilCom)) THEN - DEALLOCATE(OutputData%BlAirfoilCom) -ENDIF -IF (ALLOCATED(OutputData%TBDrCon)) THEN - DEALLOCATE(OutputData%TBDrCon) -ENDIF -IF (ALLOCATED(OutputData%BStC)) THEN -DO i1 = LBOUND(OutputData%BStC,1), UBOUND(OutputData%BStC,1) - CALL StC_DestroyOutput( OutputData%BStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(OutputData%BStC) -ENDIF -IF (ALLOCATED(OutputData%NStC)) THEN -DO i1 = LBOUND(OutputData%NStC,1), UBOUND(OutputData%NStC,1) - CALL StC_DestroyOutput( OutputData%NStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(OutputData%NStC) -ENDIF -IF (ALLOCATED(OutputData%TStC)) THEN -DO i1 = LBOUND(OutputData%TStC,1), UBOUND(OutputData%TStC,1) - CALL StC_DestroyOutput( OutputData%TStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(OutputData%TStC) -ENDIF -IF (ALLOCATED(OutputData%SStC)) THEN -DO i1 = LBOUND(OutputData%SStC,1), UBOUND(OutputData%SStC,1) - CALL StC_DestroyOutput( OutputData%SStC(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(OutputData%SStC) -ENDIF -IF (ALLOCATED(OutputData%toSC)) THEN - DEALLOCATE(OutputData%toSC) -ENDIF -IF (ALLOCATED(OutputData%Lidar)) THEN - DEALLOCATE(OutputData%Lidar) -ENDIF - END SUBROUTINE SrvD_DestroyOutput - - SUBROUTINE SrvD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - Int_BufSz = Int_BufSz + 1 ! BlPitchCom allocated yes/no - IF ( ALLOCATED(InData%BlPitchCom) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitchCom upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchCom) ! BlPitchCom - END IF - Int_BufSz = Int_BufSz + 1 ! BlAirfoilCom allocated yes/no - IF ( ALLOCATED(InData%BlAirfoilCom) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlAirfoilCom upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlAirfoilCom) ! BlAirfoilCom - END IF - Re_BufSz = Re_BufSz + 1 ! YawMom - Re_BufSz = Re_BufSz + 1 ! GenTrq - Re_BufSz = Re_BufSz + 1 ! HSSBrTrqC - Re_BufSz = Re_BufSz + 1 ! ElecPwr - Int_BufSz = Int_BufSz + 1 ! TBDrCon allocated yes/no - IF ( ALLOCATED(InData%TBDrCon) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TBDrCon upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TBDrCon) ! TBDrCon - END IF - Int_BufSz = Int_BufSz + 1 ! BStC allocated yes/no - IF ( ALLOCATED(InData%BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStC upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC: size of buffers for each call to pack subtype - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC allocated yes/no - IF ( ALLOCATED(InData%NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC: size of buffers for each call to pack subtype - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC allocated yes/no - IF ( ALLOCATED(InData%TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC: size of buffers for each call to pack subtype - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC allocated yes/no - IF ( ALLOCATED(InData%SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC: size of buffers for each call to pack subtype - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! toSC allocated yes/no - IF ( ALLOCATED(InData%toSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! toSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%toSC) ! toSC - END IF - Int_BufSz = Int_BufSz + 1 ! Lidar allocated yes/no - IF ( ALLOCATED(InData%Lidar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Lidar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Lidar) ! Lidar - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlPitchCom) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitchCom,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchCom,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) - ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlAirfoilCom) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAirfoilCom,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAirfoilCom,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlAirfoilCom,1), UBOUND(InData%BlAirfoilCom,1) - ReKiBuf(Re_Xferred) = InData%BlAirfoilCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%YawMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSSBrTrqC - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ElecPwr - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TBDrCon) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TBDrCon,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TBDrCon,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TBDrCon,1), UBOUND(InData%TBDrCon,1) - ReKiBuf(Re_Xferred) = InData%TBDrCon(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%toSC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%toSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%toSC,1), UBOUND(InData%toSC,1) - ReKiBuf(Re_Xferred) = InData%toSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Lidar) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Lidar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Lidar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Lidar,1), UBOUND(InData%Lidar,1) - ReKiBuf(Re_Xferred) = InData%Lidar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SrvD_PackOutput - - SUBROUTINE SrvD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchCom not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlPitchCom)) DEALLOCATE(OutData%BlPitchCom) - ALLOCATE(OutData%BlPitchCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) - OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAirfoilCom not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlAirfoilCom)) DEALLOCATE(OutData%BlAirfoilCom) - ALLOCATE(OutData%BlAirfoilCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAirfoilCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlAirfoilCom,1), UBOUND(OutData%BlAirfoilCom,1) - OutData%BlAirfoilCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%YawMom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTrqC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ElecPwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TBDrCon not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TBDrCon)) DEALLOCATE(OutData%TBDrCon) - ALLOCATE(OutData%TBDrCon(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TBDrCon.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TBDrCon,1), UBOUND(OutData%TBDrCon,1) - OutData%TBDrCon(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC)) DEALLOCATE(OutData%BStC) - ALLOCATE(OutData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStC,1), UBOUND(OutData%BStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%BStC(i1), ErrStat2, ErrMsg2 ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NStC)) DEALLOCATE(OutData%NStC) - ALLOCATE(OutData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC,1), UBOUND(OutData%NStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%NStC(i1), ErrStat2, ErrMsg2 ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TStC)) DEALLOCATE(OutData%TStC) - ALLOCATE(OutData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC,1), UBOUND(OutData%TStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%TStC(i1), ErrStat2, ErrMsg2 ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SStC)) DEALLOCATE(OutData%SStC) - ALLOCATE(OutData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC,1), UBOUND(OutData%SStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%SStC(i1), ErrStat2, ErrMsg2 ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! toSC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%toSC)) DEALLOCATE(OutData%toSC) - ALLOCATE(OutData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%toSC,1), UBOUND(OutData%toSC,1) - OutData%toSC(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Lidar not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Lidar)) DEALLOCATE(OutData%Lidar) - ALLOCATE(OutData%Lidar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lidar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Lidar,1), UBOUND(OutData%Lidar,1) - OutData%Lidar(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SrvD_UnPackOutput - - - SUBROUTINE SrvD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(SrvD_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(SrvD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL SrvD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SrvD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL SrvD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE SrvD_Input_ExtrapInterp - - - SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = u1, f(t2) = u2 -! -!.................................................................................................................................. - - TYPE(SrvD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(SrvD_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(SrvD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN - DO i1 = LBOUND(u_out%BlPitch,1),UBOUND(u_out%BlPitch,1) - CALL Angles_ExtrapInterp( u1%BlPitch(i1), u2%BlPitch(i1), tin, u_out%BlPitch(i1), tin_out ) - END DO -END IF ! check if allocated - CALL Angles_ExtrapInterp( u1%Yaw, u2%Yaw, tin, u_out%Yaw, tin_out ) - b = -(u1%YawRate - u2%YawRate) - u_out%YawRate = u1%YawRate + b * ScaleFactor - b = -(u1%LSS_Spd - u2%LSS_Spd) - u_out%LSS_Spd = u1%LSS_Spd + b * ScaleFactor - b = -(u1%HSS_Spd - u2%HSS_Spd) - u_out%HSS_Spd = u1%HSS_Spd + b * ScaleFactor - b = -(u1%RotSpeed - u2%RotSpeed) - u_out%RotSpeed = u1%RotSpeed + b * ScaleFactor - CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) - b = -(u1%ExternalYawRateCom - u2%ExternalYawRateCom) - u_out%ExternalYawRateCom = u1%ExternalYawRateCom + b * ScaleFactor -IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN - DO i1 = LBOUND(u_out%ExternalBlPitchCom,1),UBOUND(u_out%ExternalBlPitchCom,1) - CALL Angles_ExtrapInterp( u1%ExternalBlPitchCom(i1), u2%ExternalBlPitchCom(i1), tin, u_out%ExternalBlPitchCom(i1), tin_out ) - END DO -END IF ! check if allocated - b = -(u1%ExternalGenTrq - u2%ExternalGenTrq) - u_out%ExternalGenTrq = u1%ExternalGenTrq + b * ScaleFactor - b = -(u1%ExternalElecPwr - u2%ExternalElecPwr) - u_out%ExternalElecPwr = u1%ExternalElecPwr + b * ScaleFactor - b = -(u1%ExternalHSSBrFrac - u2%ExternalHSSBrFrac) - u_out%ExternalHSSBrFrac = u1%ExternalHSSBrFrac + b * ScaleFactor - b = -(u1%TwrAccel - u2%TwrAccel) - u_out%TwrAccel = u1%TwrAccel + b * ScaleFactor - CALL Angles_ExtrapInterp( u1%YawErr, u2%YawErr, tin, u_out%YawErr, tin_out ) - CALL Angles_ExtrapInterp( u1%WindDir, u2%WindDir, tin, u_out%WindDir, tin_out ) - DO i1 = LBOUND(u_out%RootMyc,1),UBOUND(u_out%RootMyc,1) - b = -(u1%RootMyc(i1) - u2%RootMyc(i1)) - u_out%RootMyc(i1) = u1%RootMyc(i1) + b * ScaleFactor - END DO - b = -(u1%YawBrTAxp - u2%YawBrTAxp) - u_out%YawBrTAxp = u1%YawBrTAxp + b * ScaleFactor - b = -(u1%YawBrTAyp - u2%YawBrTAyp) - u_out%YawBrTAyp = u1%YawBrTAyp + b * ScaleFactor - b = -(u1%LSSTipPxa - u2%LSSTipPxa) - u_out%LSSTipPxa = u1%LSSTipPxa + b * ScaleFactor - DO i1 = LBOUND(u_out%RootMxc,1),UBOUND(u_out%RootMxc,1) - b = -(u1%RootMxc(i1) - u2%RootMxc(i1)) - u_out%RootMxc(i1) = u1%RootMxc(i1) + b * ScaleFactor - END DO - b = -(u1%LSSTipMxa - u2%LSSTipMxa) - u_out%LSSTipMxa = u1%LSSTipMxa + b * ScaleFactor - b = -(u1%LSSTipMya - u2%LSSTipMya) - u_out%LSSTipMya = u1%LSSTipMya + b * ScaleFactor - b = -(u1%LSSTipMza - u2%LSSTipMza) - u_out%LSSTipMza = u1%LSSTipMza + b * ScaleFactor - b = -(u1%LSSTipMys - u2%LSSTipMys) - u_out%LSSTipMys = u1%LSSTipMys + b * ScaleFactor - b = -(u1%LSSTipMzs - u2%LSSTipMzs) - u_out%LSSTipMzs = u1%LSSTipMzs + b * ScaleFactor - b = -(u1%YawBrMyn - u2%YawBrMyn) - u_out%YawBrMyn = u1%YawBrMyn + b * ScaleFactor - b = -(u1%YawBrMzn - u2%YawBrMzn) - u_out%YawBrMzn = u1%YawBrMzn + b * ScaleFactor - b = -(u1%NcIMURAxs - u2%NcIMURAxs) - u_out%NcIMURAxs = u1%NcIMURAxs + b * ScaleFactor - b = -(u1%NcIMURAys - u2%NcIMURAys) - u_out%NcIMURAys = u1%NcIMURAys + b * ScaleFactor - b = -(u1%NcIMURAzs - u2%NcIMURAzs) - u_out%NcIMURAzs = u1%NcIMURAzs + b * ScaleFactor - b = -(u1%RotPwr - u2%RotPwr) - u_out%RotPwr = u1%RotPwr + b * ScaleFactor - b = -(u1%HorWindV - u2%HorWindV) - u_out%HorWindV = u1%HorWindV + b * ScaleFactor - CALL Angles_ExtrapInterp( u1%YawAngle, u2%YawAngle, tin, u_out%YawAngle, tin_out ) -IF (ALLOCATED(u_out%BStC) .AND. ALLOCATED(u1%BStC)) THEN - DO i1 = LBOUND(u_out%BStC,1),UBOUND(u_out%BStC,1) - CALL StC_Input_ExtrapInterp1( u1%BStC(i1), u2%BStC(i1), tin, u_out%BStC(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%NStC) .AND. ALLOCATED(u1%NStC)) THEN - DO i1 = LBOUND(u_out%NStC,1),UBOUND(u_out%NStC,1) - CALL StC_Input_ExtrapInterp1( u1%NStC(i1), u2%NStC(i1), tin, u_out%NStC(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%TStC) .AND. ALLOCATED(u1%TStC)) THEN - DO i1 = LBOUND(u_out%TStC,1),UBOUND(u_out%TStC,1) - CALL StC_Input_ExtrapInterp1( u1%TStC(i1), u2%TStC(i1), tin, u_out%TStC(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%SStC) .AND. ALLOCATED(u1%SStC)) THEN - DO i1 = LBOUND(u_out%SStC,1),UBOUND(u_out%SStC,1) - CALL StC_Input_ExtrapInterp1( u1%SStC(i1), u2%SStC(i1), tin, u_out%SStC(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%fromSC) .AND. ALLOCATED(u1%fromSC)) THEN - DO i1 = LBOUND(u_out%fromSC,1),UBOUND(u_out%fromSC,1) - b = -(u1%fromSC(i1) - u2%fromSC(i1)) - u_out%fromSC(i1) = u1%fromSC(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%fromSCglob) .AND. ALLOCATED(u1%fromSCglob)) THEN - DO i1 = LBOUND(u_out%fromSCglob,1),UBOUND(u_out%fromSCglob,1) - b = -(u1%fromSCglob(i1) - u2%fromSCglob(i1)) - u_out%fromSCglob(i1) = u1%fromSCglob(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Lidar) .AND. ALLOCATED(u1%Lidar)) THEN - DO i1 = LBOUND(u_out%Lidar,1),UBOUND(u_out%Lidar,1) - b = -(u1%Lidar(i1) - u2%Lidar(i1)) - u_out%Lidar(i1) = u1%Lidar(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SrvD_Input_ExtrapInterp1 - - - SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 -! -!.................................................................................................................................. - - TYPE(SrvD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(SrvD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(SrvD_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(SrvD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN - DO i1 = LBOUND(u_out%BlPitch,1),UBOUND(u_out%BlPitch,1) - CALL Angles_ExtrapInterp( u1%BlPitch(i1), u2%BlPitch(i1), u3%BlPitch(i1), tin, u_out%BlPitch(i1), tin_out ) - END DO -END IF ! check if allocated - CALL Angles_ExtrapInterp( u1%Yaw, u2%Yaw, u3%Yaw, tin, u_out%Yaw, tin_out ) - b = (t(3)**2*(u1%YawRate - u2%YawRate) + t(2)**2*(-u1%YawRate + u3%YawRate))* scaleFactor - c = ( (t(2)-t(3))*u1%YawRate + t(3)*u2%YawRate - t(2)*u3%YawRate ) * scaleFactor - u_out%YawRate = u1%YawRate + b + c * t_out - b = (t(3)**2*(u1%LSS_Spd - u2%LSS_Spd) + t(2)**2*(-u1%LSS_Spd + u3%LSS_Spd))* scaleFactor - c = ( (t(2)-t(3))*u1%LSS_Spd + t(3)*u2%LSS_Spd - t(2)*u3%LSS_Spd ) * scaleFactor - u_out%LSS_Spd = u1%LSS_Spd + b + c * t_out - b = (t(3)**2*(u1%HSS_Spd - u2%HSS_Spd) + t(2)**2*(-u1%HSS_Spd + u3%HSS_Spd))* scaleFactor - c = ( (t(2)-t(3))*u1%HSS_Spd + t(3)*u2%HSS_Spd - t(2)*u3%HSS_Spd ) * scaleFactor - u_out%HSS_Spd = u1%HSS_Spd + b + c * t_out - b = (t(3)**2*(u1%RotSpeed - u2%RotSpeed) + t(2)**2*(-u1%RotSpeed + u3%RotSpeed))* scaleFactor - c = ( (t(2)-t(3))*u1%RotSpeed + t(3)*u2%RotSpeed - t(2)*u3%RotSpeed ) * scaleFactor - u_out%RotSpeed = u1%RotSpeed + b + c * t_out - CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, u3%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) - b = (t(3)**2*(u1%ExternalYawRateCom - u2%ExternalYawRateCom) + t(2)**2*(-u1%ExternalYawRateCom + u3%ExternalYawRateCom))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalYawRateCom + t(3)*u2%ExternalYawRateCom - t(2)*u3%ExternalYawRateCom ) * scaleFactor - u_out%ExternalYawRateCom = u1%ExternalYawRateCom + b + c * t_out -IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN - DO i1 = LBOUND(u_out%ExternalBlPitchCom,1),UBOUND(u_out%ExternalBlPitchCom,1) - CALL Angles_ExtrapInterp( u1%ExternalBlPitchCom(i1), u2%ExternalBlPitchCom(i1), u3%ExternalBlPitchCom(i1), tin, u_out%ExternalBlPitchCom(i1), tin_out ) - END DO -END IF ! check if allocated - b = (t(3)**2*(u1%ExternalGenTrq - u2%ExternalGenTrq) + t(2)**2*(-u1%ExternalGenTrq + u3%ExternalGenTrq))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalGenTrq + t(3)*u2%ExternalGenTrq - t(2)*u3%ExternalGenTrq ) * scaleFactor - u_out%ExternalGenTrq = u1%ExternalGenTrq + b + c * t_out - b = (t(3)**2*(u1%ExternalElecPwr - u2%ExternalElecPwr) + t(2)**2*(-u1%ExternalElecPwr + u3%ExternalElecPwr))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalElecPwr + t(3)*u2%ExternalElecPwr - t(2)*u3%ExternalElecPwr ) * scaleFactor - u_out%ExternalElecPwr = u1%ExternalElecPwr + b + c * t_out - b = (t(3)**2*(u1%ExternalHSSBrFrac - u2%ExternalHSSBrFrac) + t(2)**2*(-u1%ExternalHSSBrFrac + u3%ExternalHSSBrFrac))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalHSSBrFrac + t(3)*u2%ExternalHSSBrFrac - t(2)*u3%ExternalHSSBrFrac ) * scaleFactor - u_out%ExternalHSSBrFrac = u1%ExternalHSSBrFrac + b + c * t_out - b = (t(3)**2*(u1%TwrAccel - u2%TwrAccel) + t(2)**2*(-u1%TwrAccel + u3%TwrAccel))* scaleFactor - c = ( (t(2)-t(3))*u1%TwrAccel + t(3)*u2%TwrAccel - t(2)*u3%TwrAccel ) * scaleFactor - u_out%TwrAccel = u1%TwrAccel + b + c * t_out - CALL Angles_ExtrapInterp( u1%YawErr, u2%YawErr, u3%YawErr, tin, u_out%YawErr, tin_out ) - CALL Angles_ExtrapInterp( u1%WindDir, u2%WindDir, u3%WindDir, tin, u_out%WindDir, tin_out ) - DO i1 = LBOUND(u_out%RootMyc,1),UBOUND(u_out%RootMyc,1) - b = (t(3)**2*(u1%RootMyc(i1) - u2%RootMyc(i1)) + t(2)**2*(-u1%RootMyc(i1) + u3%RootMyc(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%RootMyc(i1) + t(3)*u2%RootMyc(i1) - t(2)*u3%RootMyc(i1) ) * scaleFactor - u_out%RootMyc(i1) = u1%RootMyc(i1) + b + c * t_out - END DO - b = (t(3)**2*(u1%YawBrTAxp - u2%YawBrTAxp) + t(2)**2*(-u1%YawBrTAxp + u3%YawBrTAxp))* scaleFactor - c = ( (t(2)-t(3))*u1%YawBrTAxp + t(3)*u2%YawBrTAxp - t(2)*u3%YawBrTAxp ) * scaleFactor - u_out%YawBrTAxp = u1%YawBrTAxp + b + c * t_out - b = (t(3)**2*(u1%YawBrTAyp - u2%YawBrTAyp) + t(2)**2*(-u1%YawBrTAyp + u3%YawBrTAyp))* scaleFactor - c = ( (t(2)-t(3))*u1%YawBrTAyp + t(3)*u2%YawBrTAyp - t(2)*u3%YawBrTAyp ) * scaleFactor - u_out%YawBrTAyp = u1%YawBrTAyp + b + c * t_out - b = (t(3)**2*(u1%LSSTipPxa - u2%LSSTipPxa) + t(2)**2*(-u1%LSSTipPxa + u3%LSSTipPxa))* scaleFactor - c = ( (t(2)-t(3))*u1%LSSTipPxa + t(3)*u2%LSSTipPxa - t(2)*u3%LSSTipPxa ) * scaleFactor - u_out%LSSTipPxa = u1%LSSTipPxa + b + c * t_out - DO i1 = LBOUND(u_out%RootMxc,1),UBOUND(u_out%RootMxc,1) - b = (t(3)**2*(u1%RootMxc(i1) - u2%RootMxc(i1)) + t(2)**2*(-u1%RootMxc(i1) + u3%RootMxc(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%RootMxc(i1) + t(3)*u2%RootMxc(i1) - t(2)*u3%RootMxc(i1) ) * scaleFactor - u_out%RootMxc(i1) = u1%RootMxc(i1) + b + c * t_out - END DO - b = (t(3)**2*(u1%LSSTipMxa - u2%LSSTipMxa) + t(2)**2*(-u1%LSSTipMxa + u3%LSSTipMxa))* scaleFactor - c = ( (t(2)-t(3))*u1%LSSTipMxa + t(3)*u2%LSSTipMxa - t(2)*u3%LSSTipMxa ) * scaleFactor - u_out%LSSTipMxa = u1%LSSTipMxa + b + c * t_out - b = (t(3)**2*(u1%LSSTipMya - u2%LSSTipMya) + t(2)**2*(-u1%LSSTipMya + u3%LSSTipMya))* scaleFactor - c = ( (t(2)-t(3))*u1%LSSTipMya + t(3)*u2%LSSTipMya - t(2)*u3%LSSTipMya ) * scaleFactor - u_out%LSSTipMya = u1%LSSTipMya + b + c * t_out - b = (t(3)**2*(u1%LSSTipMza - u2%LSSTipMza) + t(2)**2*(-u1%LSSTipMza + u3%LSSTipMza))* scaleFactor - c = ( (t(2)-t(3))*u1%LSSTipMza + t(3)*u2%LSSTipMza - t(2)*u3%LSSTipMza ) * scaleFactor - u_out%LSSTipMza = u1%LSSTipMza + b + c * t_out - b = (t(3)**2*(u1%LSSTipMys - u2%LSSTipMys) + t(2)**2*(-u1%LSSTipMys + u3%LSSTipMys))* scaleFactor - c = ( (t(2)-t(3))*u1%LSSTipMys + t(3)*u2%LSSTipMys - t(2)*u3%LSSTipMys ) * scaleFactor - u_out%LSSTipMys = u1%LSSTipMys + b + c * t_out - b = (t(3)**2*(u1%LSSTipMzs - u2%LSSTipMzs) + t(2)**2*(-u1%LSSTipMzs + u3%LSSTipMzs))* scaleFactor - c = ( (t(2)-t(3))*u1%LSSTipMzs + t(3)*u2%LSSTipMzs - t(2)*u3%LSSTipMzs ) * scaleFactor - u_out%LSSTipMzs = u1%LSSTipMzs + b + c * t_out - b = (t(3)**2*(u1%YawBrMyn - u2%YawBrMyn) + t(2)**2*(-u1%YawBrMyn + u3%YawBrMyn))* scaleFactor - c = ( (t(2)-t(3))*u1%YawBrMyn + t(3)*u2%YawBrMyn - t(2)*u3%YawBrMyn ) * scaleFactor - u_out%YawBrMyn = u1%YawBrMyn + b + c * t_out - b = (t(3)**2*(u1%YawBrMzn - u2%YawBrMzn) + t(2)**2*(-u1%YawBrMzn + u3%YawBrMzn))* scaleFactor - c = ( (t(2)-t(3))*u1%YawBrMzn + t(3)*u2%YawBrMzn - t(2)*u3%YawBrMzn ) * scaleFactor - u_out%YawBrMzn = u1%YawBrMzn + b + c * t_out - b = (t(3)**2*(u1%NcIMURAxs - u2%NcIMURAxs) + t(2)**2*(-u1%NcIMURAxs + u3%NcIMURAxs))* scaleFactor - c = ( (t(2)-t(3))*u1%NcIMURAxs + t(3)*u2%NcIMURAxs - t(2)*u3%NcIMURAxs ) * scaleFactor - u_out%NcIMURAxs = u1%NcIMURAxs + b + c * t_out - b = (t(3)**2*(u1%NcIMURAys - u2%NcIMURAys) + t(2)**2*(-u1%NcIMURAys + u3%NcIMURAys))* scaleFactor - c = ( (t(2)-t(3))*u1%NcIMURAys + t(3)*u2%NcIMURAys - t(2)*u3%NcIMURAys ) * scaleFactor - u_out%NcIMURAys = u1%NcIMURAys + b + c * t_out - b = (t(3)**2*(u1%NcIMURAzs - u2%NcIMURAzs) + t(2)**2*(-u1%NcIMURAzs + u3%NcIMURAzs))* scaleFactor - c = ( (t(2)-t(3))*u1%NcIMURAzs + t(3)*u2%NcIMURAzs - t(2)*u3%NcIMURAzs ) * scaleFactor - u_out%NcIMURAzs = u1%NcIMURAzs + b + c * t_out - b = (t(3)**2*(u1%RotPwr - u2%RotPwr) + t(2)**2*(-u1%RotPwr + u3%RotPwr))* scaleFactor - c = ( (t(2)-t(3))*u1%RotPwr + t(3)*u2%RotPwr - t(2)*u3%RotPwr ) * scaleFactor - u_out%RotPwr = u1%RotPwr + b + c * t_out - b = (t(3)**2*(u1%HorWindV - u2%HorWindV) + t(2)**2*(-u1%HorWindV + u3%HorWindV))* scaleFactor - c = ( (t(2)-t(3))*u1%HorWindV + t(3)*u2%HorWindV - t(2)*u3%HorWindV ) * scaleFactor - u_out%HorWindV = u1%HorWindV + b + c * t_out - CALL Angles_ExtrapInterp( u1%YawAngle, u2%YawAngle, u3%YawAngle, tin, u_out%YawAngle, tin_out ) -IF (ALLOCATED(u_out%BStC) .AND. ALLOCATED(u1%BStC)) THEN - DO i1 = LBOUND(u_out%BStC,1),UBOUND(u_out%BStC,1) - CALL StC_Input_ExtrapInterp2( u1%BStC(i1), u2%BStC(i1), u3%BStC(i1), tin, u_out%BStC(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%NStC) .AND. ALLOCATED(u1%NStC)) THEN - DO i1 = LBOUND(u_out%NStC,1),UBOUND(u_out%NStC,1) - CALL StC_Input_ExtrapInterp2( u1%NStC(i1), u2%NStC(i1), u3%NStC(i1), tin, u_out%NStC(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%TStC) .AND. ALLOCATED(u1%TStC)) THEN - DO i1 = LBOUND(u_out%TStC,1),UBOUND(u_out%TStC,1) - CALL StC_Input_ExtrapInterp2( u1%TStC(i1), u2%TStC(i1), u3%TStC(i1), tin, u_out%TStC(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%SStC) .AND. ALLOCATED(u1%SStC)) THEN - DO i1 = LBOUND(u_out%SStC,1),UBOUND(u_out%SStC,1) - CALL StC_Input_ExtrapInterp2( u1%SStC(i1), u2%SStC(i1), u3%SStC(i1), tin, u_out%SStC(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%fromSC) .AND. ALLOCATED(u1%fromSC)) THEN - DO i1 = LBOUND(u_out%fromSC,1),UBOUND(u_out%fromSC,1) - b = (t(3)**2*(u1%fromSC(i1) - u2%fromSC(i1)) + t(2)**2*(-u1%fromSC(i1) + u3%fromSC(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%fromSC(i1) + t(3)*u2%fromSC(i1) - t(2)*u3%fromSC(i1) ) * scaleFactor - u_out%fromSC(i1) = u1%fromSC(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%fromSCglob) .AND. ALLOCATED(u1%fromSCglob)) THEN - DO i1 = LBOUND(u_out%fromSCglob,1),UBOUND(u_out%fromSCglob,1) - b = (t(3)**2*(u1%fromSCglob(i1) - u2%fromSCglob(i1)) + t(2)**2*(-u1%fromSCglob(i1) + u3%fromSCglob(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%fromSCglob(i1) + t(3)*u2%fromSCglob(i1) - t(2)*u3%fromSCglob(i1) ) * scaleFactor - u_out%fromSCglob(i1) = u1%fromSCglob(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Lidar) .AND. ALLOCATED(u1%Lidar)) THEN - DO i1 = LBOUND(u_out%Lidar,1),UBOUND(u_out%Lidar,1) - b = (t(3)**2*(u1%Lidar(i1) - u2%Lidar(i1)) + t(2)**2*(-u1%Lidar(i1) + u3%Lidar(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Lidar(i1) + t(3)*u2%Lidar(i1) - t(2)*u3%Lidar(i1) ) * scaleFactor - u_out%Lidar(i1) = u1%Lidar(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SrvD_Input_ExtrapInterp2 - - - SUBROUTINE SrvD_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(SrvD_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(SrvD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL SrvD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SrvD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL SrvD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE SrvD_Output_ExtrapInterp - - - SUBROUTINE SrvD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = y1, f(t2) = y2 -! -!.................................................................................................................................. - - TYPE(SrvD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(SrvD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(SrvD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN - DO i1 = LBOUND(y_out%BlPitchCom,1),UBOUND(y_out%BlPitchCom,1) - CALL Angles_ExtrapInterp( y1%BlPitchCom(i1), y2%BlPitchCom(i1), tin, y_out%BlPitchCom(i1), tin_out ) - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%BlAirfoilCom) .AND. ALLOCATED(y1%BlAirfoilCom)) THEN - DO i1 = LBOUND(y_out%BlAirfoilCom,1),UBOUND(y_out%BlAirfoilCom,1) - b = -(y1%BlAirfoilCom(i1) - y2%BlAirfoilCom(i1)) - y_out%BlAirfoilCom(i1) = y1%BlAirfoilCom(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - b = -(y1%YawMom - y2%YawMom) - y_out%YawMom = y1%YawMom + b * ScaleFactor - b = -(y1%GenTrq - y2%GenTrq) - y_out%GenTrq = y1%GenTrq + b * ScaleFactor - b = -(y1%HSSBrTrqC - y2%HSSBrTrqC) - y_out%HSSBrTrqC = y1%HSSBrTrqC + b * ScaleFactor - b = -(y1%ElecPwr - y2%ElecPwr) - y_out%ElecPwr = y1%ElecPwr + b * ScaleFactor -IF (ALLOCATED(y_out%TBDrCon) .AND. ALLOCATED(y1%TBDrCon)) THEN - DO i1 = LBOUND(y_out%TBDrCon,1),UBOUND(y_out%TBDrCon,1) - b = -(y1%TBDrCon(i1) - y2%TBDrCon(i1)) - y_out%TBDrCon(i1) = y1%TBDrCon(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%BStC) .AND. ALLOCATED(y1%BStC)) THEN - DO i1 = LBOUND(y_out%BStC,1),UBOUND(y_out%BStC,1) - CALL StC_Output_ExtrapInterp1( y1%BStC(i1), y2%BStC(i1), tin, y_out%BStC(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%NStC) .AND. ALLOCATED(y1%NStC)) THEN - DO i1 = LBOUND(y_out%NStC,1),UBOUND(y_out%NStC,1) - CALL StC_Output_ExtrapInterp1( y1%NStC(i1), y2%NStC(i1), tin, y_out%NStC(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%TStC) .AND. ALLOCATED(y1%TStC)) THEN - DO i1 = LBOUND(y_out%TStC,1),UBOUND(y_out%TStC,1) - CALL StC_Output_ExtrapInterp1( y1%TStC(i1), y2%TStC(i1), tin, y_out%TStC(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%SStC) .AND. ALLOCATED(y1%SStC)) THEN - DO i1 = LBOUND(y_out%SStC,1),UBOUND(y_out%SStC,1) - CALL StC_Output_ExtrapInterp1( y1%SStC(i1), y2%SStC(i1), tin, y_out%SStC(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%toSC) .AND. ALLOCATED(y1%toSC)) THEN - DO i1 = LBOUND(y_out%toSC,1),UBOUND(y_out%toSC,1) - b = -(y1%toSC(i1) - y2%toSC(i1)) - y_out%toSC(i1) = y1%toSC(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Lidar) .AND. ALLOCATED(y1%Lidar)) THEN - DO i1 = LBOUND(y_out%Lidar,1),UBOUND(y_out%Lidar,1) - b = -(y1%Lidar(i1) - y2%Lidar(i1)) - y_out%Lidar(i1) = y1%Lidar(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SrvD_Output_ExtrapInterp1 - - - SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 -! -!.................................................................................................................................. - - TYPE(SrvD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(SrvD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(SrvD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(SrvD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN - DO i1 = LBOUND(y_out%BlPitchCom,1),UBOUND(y_out%BlPitchCom,1) - CALL Angles_ExtrapInterp( y1%BlPitchCom(i1), y2%BlPitchCom(i1), y3%BlPitchCom(i1), tin, y_out%BlPitchCom(i1), tin_out ) - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%BlAirfoilCom) .AND. ALLOCATED(y1%BlAirfoilCom)) THEN - DO i1 = LBOUND(y_out%BlAirfoilCom,1),UBOUND(y_out%BlAirfoilCom,1) - b = (t(3)**2*(y1%BlAirfoilCom(i1) - y2%BlAirfoilCom(i1)) + t(2)**2*(-y1%BlAirfoilCom(i1) + y3%BlAirfoilCom(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%BlAirfoilCom(i1) + t(3)*y2%BlAirfoilCom(i1) - t(2)*y3%BlAirfoilCom(i1) ) * scaleFactor - y_out%BlAirfoilCom(i1) = y1%BlAirfoilCom(i1) + b + c * t_out - END DO -END IF ! check if allocated - b = (t(3)**2*(y1%YawMom - y2%YawMom) + t(2)**2*(-y1%YawMom + y3%YawMom))* scaleFactor - c = ( (t(2)-t(3))*y1%YawMom + t(3)*y2%YawMom - t(2)*y3%YawMom ) * scaleFactor - y_out%YawMom = y1%YawMom + b + c * t_out - b = (t(3)**2*(y1%GenTrq - y2%GenTrq) + t(2)**2*(-y1%GenTrq + y3%GenTrq))* scaleFactor - c = ( (t(2)-t(3))*y1%GenTrq + t(3)*y2%GenTrq - t(2)*y3%GenTrq ) * scaleFactor - y_out%GenTrq = y1%GenTrq + b + c * t_out - b = (t(3)**2*(y1%HSSBrTrqC - y2%HSSBrTrqC) + t(2)**2*(-y1%HSSBrTrqC + y3%HSSBrTrqC))* scaleFactor - c = ( (t(2)-t(3))*y1%HSSBrTrqC + t(3)*y2%HSSBrTrqC - t(2)*y3%HSSBrTrqC ) * scaleFactor - y_out%HSSBrTrqC = y1%HSSBrTrqC + b + c * t_out - b = (t(3)**2*(y1%ElecPwr - y2%ElecPwr) + t(2)**2*(-y1%ElecPwr + y3%ElecPwr))* scaleFactor - c = ( (t(2)-t(3))*y1%ElecPwr + t(3)*y2%ElecPwr - t(2)*y3%ElecPwr ) * scaleFactor - y_out%ElecPwr = y1%ElecPwr + b + c * t_out -IF (ALLOCATED(y_out%TBDrCon) .AND. ALLOCATED(y1%TBDrCon)) THEN - DO i1 = LBOUND(y_out%TBDrCon,1),UBOUND(y_out%TBDrCon,1) - b = (t(3)**2*(y1%TBDrCon(i1) - y2%TBDrCon(i1)) + t(2)**2*(-y1%TBDrCon(i1) + y3%TBDrCon(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%TBDrCon(i1) + t(3)*y2%TBDrCon(i1) - t(2)*y3%TBDrCon(i1) ) * scaleFactor - y_out%TBDrCon(i1) = y1%TBDrCon(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%BStC) .AND. ALLOCATED(y1%BStC)) THEN - DO i1 = LBOUND(y_out%BStC,1),UBOUND(y_out%BStC,1) - CALL StC_Output_ExtrapInterp2( y1%BStC(i1), y2%BStC(i1), y3%BStC(i1), tin, y_out%BStC(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%NStC) .AND. ALLOCATED(y1%NStC)) THEN - DO i1 = LBOUND(y_out%NStC,1),UBOUND(y_out%NStC,1) - CALL StC_Output_ExtrapInterp2( y1%NStC(i1), y2%NStC(i1), y3%NStC(i1), tin, y_out%NStC(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%TStC) .AND. ALLOCATED(y1%TStC)) THEN - DO i1 = LBOUND(y_out%TStC,1),UBOUND(y_out%TStC,1) - CALL StC_Output_ExtrapInterp2( y1%TStC(i1), y2%TStC(i1), y3%TStC(i1), tin, y_out%TStC(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%SStC) .AND. ALLOCATED(y1%SStC)) THEN - DO i1 = LBOUND(y_out%SStC,1),UBOUND(y_out%SStC,1) - CALL StC_Output_ExtrapInterp2( y1%SStC(i1), y2%SStC(i1), y3%SStC(i1), tin, y_out%SStC(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%toSC) .AND. ALLOCATED(y1%toSC)) THEN - DO i1 = LBOUND(y_out%toSC,1),UBOUND(y_out%toSC,1) - b = (t(3)**2*(y1%toSC(i1) - y2%toSC(i1)) + t(2)**2*(-y1%toSC(i1) + y3%toSC(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%toSC(i1) + t(3)*y2%toSC(i1) - t(2)*y3%toSC(i1) ) * scaleFactor - y_out%toSC(i1) = y1%toSC(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Lidar) .AND. ALLOCATED(y1%Lidar)) THEN - DO i1 = LBOUND(y_out%Lidar,1),UBOUND(y_out%Lidar,1) - b = (t(3)**2*(y1%Lidar(i1) - y2%Lidar(i1)) + t(2)**2*(-y1%Lidar(i1) + y3%Lidar(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%Lidar(i1) + t(3)*y2%Lidar(i1) - t(2)*y3%Lidar(i1) ) * scaleFactor - y_out%Lidar(i1) = y1%Lidar(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SrvD_Output_ExtrapInterp2 - -END MODULE ServoDyn_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/OpenFAST/modules/servodyn/src/StrucCtrl.f90 b/OpenFAST/modules/servodyn/src/StrucCtrl.f90 deleted file mode 100644 index cbcc7d472..000000000 --- a/OpenFAST/modules/servodyn/src/StrucCtrl.f90 +++ /dev/null @@ -1,2208 +0,0 @@ -!********************************************************************************************************************************** -! WLaCava (WGL), Matt Lackner (MAL), Meghan Glade (MEG), and Semyung Park (SP) -! Tuned Mass Damper Module -!********************************************************************************************************************************** -MODULE StrucCtrl - - USE StrucCtrl_Types - USE NWTC_Library - - IMPLICIT NONE - - PRIVATE - - - TYPE(ProgDesc), PARAMETER :: StC_Ver = ProgDesc( 'StrucCtrl', '', '' ) - - - - - ! ..... Public Subroutines ................................................................................................... - - PUBLIC :: StC_Init ! Initialization routine - PUBLIC :: StC_End ! Ending routine (includes clean up) - - PUBLIC :: StC_UpdateStates ! Loose coupling routine for solving for constraint states, integrating - ! continuous states, and updating discrete states - PUBLIC :: StC_CalcOutput ! Routine for computing outputs - - ! PUBLIC :: StC_CalcConstrStateResidual ! Tight coupling routine for returning the constraint state residual - PUBLIC :: StC_CalcContStateDeriv ! Tight coupling routine for computing derivatives of continuous states - - !PUBLIC :: StC_UpdateDiscState ! Tight coupling routine for updating discrete states - - !PUBLIC :: StC_JacobianPInput ! Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- - ! ! (Xd), and constraint-state (Z) equations all with respect to the inputs (u) - !PUBLIC :: StC_JacobianPContState ! Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- - ! ! (Xd), and constraint-state (Z) equations all with respect to the continuous - ! ! states (x) - !PUBLIC :: StC_JacobianPDiscState ! Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- - ! ! (Xd), and constraint-state (Z) equations all with respect to the discrete - ! ! states (xd) - !PUBLIC :: StC_JacobianPConstrState ! Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- - ! (Xd), and constraint-state (Z) equations all with respect to the constraint - ! states (z) - - - INTEGER(IntKi), PRIVATE, PARAMETER :: ControlMode_NONE = 0 !< The (StC-universal) control code for not using a particular type of control - - INTEGER(IntKi), PRIVATE, PARAMETER :: DOFMode_Indept = 1 !< independent DOFs - INTEGER(IntKi), PRIVATE, PARAMETER :: DOFMode_Omni = 2 !< omni-directional - INTEGER(IntKi), PRIVATE, PARAMETER :: DOFMode_TLCD = 3 !< tuned liquid column dampers !MEG & SP - INTEGER(IntKi), PRIVATE, PARAMETER :: DOFMode_Prescribed = 4 !< prescribed force series - - INTEGER(IntKi), PRIVATE, PARAMETER :: CMODE_Semi = 1 !< semi-active control - INTEGER(IntKi), PRIVATE, PARAMETER :: CMODE_Active = 2 !< active control - - INTEGER(IntKi), PRIVATE, PARAMETER :: SA_CMODE_GH_vel = 1 !< 1: velocity-based ground hook control; - INTEGER(IntKi), PRIVATE, PARAMETER :: SA_CMODE_GH_invVel = 2 !< 2: Inverse velocity-based ground hook control - INTEGER(IntKi), PRIVATE, PARAMETER :: SA_CMODE_GH_disp = 3 !< 3: displacement-based ground hook control - INTEGER(IntKi), PRIVATE, PARAMETER :: SA_CMODE_Ph_FF = 4 !< 4: Phase difference Algorithm with Friction Force - INTEGER(IntKi), PRIVATE, PARAMETER :: SA_CMODE_Ph_DF = 5 !< 5: Phase difference Algorithm with Damping Force - - integer(IntKi), private, parameter :: PRESCRIBED_FORCE_GLOBAL = 1_IntKi !< Prescribed forces are in global coords - integer(IntKi), private, parameter :: PRESCRIBED_FORCE_LOCAL = 2_IntKi !< Prescribed forces are in local coords - -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 StC_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(StC_InitInputType), INTENT(INOUT) :: InitInp !< Input data for initialization routine. - TYPE(StC_InputType), INTENT( OUT) :: u !< An initial guess for the input; input mesh must be defined - TYPE(StC_ParameterType), INTENT( OUT) :: p !< Parameters - TYPE(StC_ContinuousStateType), INTENT( OUT) :: x !< Initial continuous states - TYPE(StC_DiscreteStateType), INTENT( OUT) :: xd !< Initial discrete states - TYPE(StC_ConstraintStateType), INTENT( OUT) :: z !< Initial guess of the constraint states - TYPE(StC_OtherStateType), INTENT( OUT) :: OtherState !< Initial other states - TYPE(StC_OutputType), INTENT(INOUT) :: y !< Initial system outputs (outputs are not calculated; - !! only the output mesh is initialized) - TYPE(StC_MiscVarType), INTENT( OUT) :: m !< Misc (optimization) variables - REAL(DbKi), INTENT(INOUT) :: Interval !< Coupling interval in seconds: the rate that - !! (1) StC_UpdateStates() is called in loose coupling & - !! (2) StC_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. - TYPE(StC_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 - INTEGER(IntKi) :: NumOuts - TYPE(StC_InputFile) :: InputFileData ! Data stored in the module's input file - INTEGER(IntKi) :: i_pt ! Generic counter for mesh point - REAL(ReKi), allocatable, dimension(:,:) :: PositionP - REAL(ReKi), allocatable, dimension(:,:) :: PositionGlobal - REAL(R8Ki), allocatable, dimension(:,:,:) :: OrientationP - - type(FileInfoType) :: FileInfo_In !< The derived type for holding the full input file for parsing -- we may pass this in the future - type(FileInfoType) :: FileInfo_In_PrescribeFrc !< The derived type for holding the prescribed forces input file for parsing -- we may pass this in the future - character(1024) :: PriPath !< Primary path - integer(IntKi) :: UnEcho - INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message - - CHARACTER(*), PARAMETER :: RoutineName = 'StC_Init' - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - NumOuts = 0 - UnEcho = -1 ! will be > 0 if echo file is opened - - InitOut%dummyInitOut = 0.0_SiKi ! initialize this so compiler doesn't warn about un-set intent(out) variables - - ! Initialize the NWTC Subroutine Library - CALL NWTC_Init( EchoLibVer=.FALSE. ) - - ! Display the module information - CALL DispNVD( StC_Ver ) - !............................................................................................ - ! Read the input file and validate the data - !............................................................................................ - - CALL GetPath( InitInp%InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - - if (InitInp%UseInputFile) then - ! Read the entire input file, minus any comment lines, into the FileInfo_In - ! data structure in memory for further processing. - call ProcessComFile( InitInp%InputFile, FileInfo_In, ErrStat2, ErrMsg2 ) - else - ! put passed string info into the FileInfo_In -- FileInfo structure - call NWTC_Library_CopyFileInfoType( InitInp%PassedPrimaryInputData, FileInfo_In, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - endif - if (Failed()) return; - - ! For diagnostic purposes, the following can be used to display the contents - ! of the FileInfo_In data structure. - !call Print_FileInfo_Struct( CU, FileInfo_In ) ! CU is the screen -- different number on different systems. - - ! Parse the FileInfo_In structure of data from the inputfile into the InitInp%InputFile structure - CALL StC_ParseInputFileInfo( PriPath, InitInp%InputFile, TRIM(InitInp%RootName), FileInfo_In, InputFileData, UnEcho, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - ! Using the InputFileData structure, check that it makes sense - CALL StC_ValidatePrimaryData( InputFileData, InitInp, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - ! read in the prescribed forces file - if ( InputFileData%StC_DOF_MODE == DOFMode_Prescribed ) then - if (InitInp%UseInputFile_PrescribeFrc) then - ! Read the entire input file, minus any comment lines, into the FileInfo_In - ! data structure in memory for further processing. - call ProcessComFile( InputFileData%PrescribedForcesFile, FileInfo_In_PrescribeFrc, ErrStat2, ErrMsg2 ) - else - ! put passed string info into the FileInfo_In -- FileInfo structure - call NWTC_Library_CopyFileInfoType( InitInp%PassedPrescribeFrcData, FileInfo_In_PrescribeFrc, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - endif - if (Failed()) return; - ! For diagnostic purposes, the following can be used to display the contents - ! of the FileInfo_In data structure. - !call Print_FileInfo_Struct( CU, FileInfo_In_PrescribeFrc ) ! CU is the screen -- different number on different systems. - ! Parse the FileInfo_In_PrescribeFrc structure of data from the inputfile into the InitInp%InputFile structure - CALL StC_ParseTimeSeriesFileInfo( InputFileData%PrescribedForcesFile, FileInfo_In_PrescribeFrc, InputFileData, UnEcho, ErrStat2, ErrMsg2 ) - if (Failed()) return; - endif - - !............................................................................................ - ! Define parameters here: - !............................................................................................ - CALL StC_SetParameters( InputFileData, InitInp, p, Interval, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - !............................................................................................ - ! Define initial system states here: - !............................................................................................ - - xd%DummyDiscState = 0 - z%DummyConstrState = 0 - - ! Initialize other states here: - OtherState%DummyOtherState = 0 - - call Init_Misc( p, m, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - - ! Allocate continuous states (x) - call AllocAry(x%StC_x, 6, p%NumMeshPts, 'x%StC_x', ErrStat2,ErrMsg2) - if (Failed()) return; - - ! Define initial guess for the system states here: - do i_pt=1,p%NumMeshPts - x%StC_x(1,i_pt) = InputFileData%StC_X_DSP - x%StC_x(2,i_pt) = 0 - x%StC_x(3,i_pt) = InputFileData%StC_Y_DSP - x%StC_x(4,i_pt) = 0 - x%StC_x(5,i_pt) = InputFileData%StC_Z_DSP - x%StC_x(6,i_pt) = 0 - enddo - - - ! set positions and orientations for tuned mass dampers's - call AllocAry(PositionP, 3, p%NumMeshPts, 'PositionP', ErrStat2,ErrMsg2); if (Failed()) return; - call AllocAry(PositionGlobal, 3, p%NumMeshPts, 'PositionGlobal', ErrStat2,ErrMsg2); if (Failed()) return; - call AllocAry(OrientationP, 3, 3, p%NumMeshPts, 'OrientationP', ErrStat2,ErrMsg2); if (Failed()) return; - - ! Set the initial positions and orietantions for each point - do i_pt = 1,p%NumMeshPts - PositionP(:,i_pt) = (/ InputFileData%StC_P_X, InputFileData%StC_P_Y, InputFileData%StC_P_Z /) - OrientationP(:,:,i_pt) = InitInp%InitOrientation(:,:,i_pt) - PositionGlobal(:,i_pt) = InitInp%InitPosition(:,i_pt) + real( matmul(PositionP(:,i_pt),OrientationP(:,:,i_pt)), ReKi) - enddo - - ! Define system output initializations (set up mesh) here: - ! Create the input and output meshes associated with lumped loads - - ALLOCATE (u%Mesh(p%NumMeshPts), STAT=ErrStat2) - IF (ErrStat2/=0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating u%Mesh.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - ALLOCATE (y%Mesh(p%NumMeshPts), STAT=ErrStat2) - IF (ErrStat2/=0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating y%Mesh.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ! Create Mesh(i_pt) - DO i_pt = 1,p%NumMeshPts - - CALL MeshCreate( BlankMesh = u%Mesh(i_pt) & - ,IOS = COMPONENT_INPUT & - ,Nnodes = 1 & - ,ErrStat = ErrStat2 & - ,ErrMess = ErrMsg2 & - ,TranslationDisp = .TRUE. & - ,Orientation = .TRUE. & - ,TranslationVel = .TRUE. & - ,RotationVel = .TRUE. & - ,TranslationAcc = .TRUE. & - ,RotationAcc = .TRUE.) - if (Failed()) return; - - - ! Create the node on the mesh - ! make position node at point P (rest position of tuned mass dampers, somewhere above the yaw bearing) - CALL MeshPositionNode ( u%Mesh(i_pt),1, PositionGlobal(:,i_pt), ErrStat2, ErrMsg2, OrientationP(:,:,i_pt) ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! Create the mesh element - CALL MeshConstructElement ( u%Mesh(i_pt) & - , ELEMENT_POINT & - , ErrStat2 & - , ErrMsg2 & - , 1 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshCommit ( u%Mesh(i_pt) & - , ErrStat2 & - , ErrMsg2 ) - if (Failed()) return; - - CALL MeshCopy ( SrcMesh = u%Mesh(i_pt) & - ,DestMesh = y%Mesh(i_pt) & - ,CtrlCode = MESH_SIBLING & - ,IOS = COMPONENT_OUTPUT & - ,ErrStat = ErrStat2 & - ,ErrMess = ErrMsg2 & - ,Force = .TRUE. & - ,Moment = .TRUE. ) - - if (Failed()) return; - - u%Mesh(i_pt)%RemapFlag = .TRUE. - y%Mesh(i_pt)%RemapFlag = .TRUE. - enddo - - - !bjj: removed for now; output handled in ServoDyn - !IF (NumOuts > 0) THEN - ! ALLOCATE( y%WriteOutput(NumOuts), STAT = ErrStat ) - ! IF ( ErrStat/= 0 ) THEN - ! CALL SetErrStat(ErrID_Fatal,'Error allocating output array.',ErrStat,ErrMsg,'StC_Init') - ! CALL Cleanup() - ! RETURN - ! END IF - ! y%WriteOutput = 0 - ! - ! ! Define initialization-routine output here: - ! ALLOCATE( InitOut%WriteOutputHdr(NumOuts), InitOut%WriteOutputUnt(NumOuts), STAT = ErrStat ) - ! IF ( ErrStat/= 0 ) THEN - ! CALL SetErrStat(ErrID_Fatal,'Error allocating output header and units arrays.',ErrStat,ErrMsg,'StC_Init') - ! CALL Cleanup() - ! RETURN - ! END IF - ! - ! DO i=1,NumOuts - ! InitOut%WriteOutputHdr(i) = "Heading"//trim(num2lstr(i)) - ! InitOut%WriteOutputUnt(i) = "(-)" - ! END DO - ! - !END IF - - !bjj: need to initialize headers/units - - ! Set the interval value to tell ServoDyn we are using (we don't actually change this in StC) - Interval = p%DT - - call cleanup() -!................................ -CONTAINS - subroutine Init_Misc( p, m, ErrStat, ErrMsg ) - type(StC_ParameterType),intent(in ) :: p !< Parameters - type(StC_MiscVarType), intent(inout) :: m !< Misc (optimization) variables - integer(IntKi), intent( out) :: ErrStat ! The error identifier (ErrStat) - character(ErrMsgLen), intent( out) :: ErrMsg ! The error message (ErrMsg) - - ! Accelerations, velocities, and resultant forces -- used in all tuned mass calcs (so we don't reallocate all the time) - ! Note: these variables had been allocated multiple places before and sometimes passed between routines. So - ! they have been moved into MiscVars so that we don so we don't reallocate all the time - call AllocAry(m%a_G , 3, p%NumMeshPts,'a_G' , ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; - call AllocAry(m%rdisp_P, 3, p%NumMeshPts,'rdisp_P' , ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; - call AllocAry(m%rdot_P , 3, p%NumMeshPts,'rdot_P' , ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; - call AllocAry(m%rddot_P, 3, p%NumMeshPts,'rddot_P' , ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; - call AllocAry(m%omega_P, 3, p%NumMeshPts,'omega_P' , ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; - call AllocAry(m%alpha_P, 3, p%NumMeshPts,'alpha_P' , ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; - call AllocAry(m%Acc , 3, p%NumMeshPts,'Acc' , ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; ! Summed accelerations - ! Note: the following two were added to misc so that we have the option of outputting the forces and moments - ! from each tuned mass system at some later point - call AllocAry(m%F_P , 3, p%NumMeshPts,'F_P' , ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; - call AllocAry(m%M_P , 3, p%NumMeshPts,'M_P' , ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; - - ! External and stop forces - ! Note: these variables had been allocated multiple places before and sometimes passed between routines. So - ! 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%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 - call AllocAry(m%F_table, 3, p%NumMeshPts, 'F_table', ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; m%F_table = 0.0_ReKi - call AllocAry(m%F_k , 3, p%NumMeshPts, 'F_k' , ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; m%F_k = 0.0_ReKi - - ! indexing - m%PrescribedInterpIdx = 0_IntKi ! index tracker for PrescribedForce option - - end subroutine Init_Misc - !......................................... - logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'StC_Init' ) - Failed = ErrStat >= AbortErrLev - if (Failed) call cleanup() - end function Failed - !......................................... - SUBROUTINE cleanup() - if (UnEcho > 0) close(UnEcho) ! Close echo file - if (allocated(PositionP )) deallocate(PositionP ) - if (allocated(PositionGlobal)) deallocate(PositionGlobal) - if (allocated(OrientationP )) deallocate(OrientationP ) - CALL StC_DestroyInputFile( InputFileData, ErrStat2, ErrMsg2) ! Ignore warnings here. - END SUBROUTINE cleanup -!......................................... -END SUBROUTINE StC_Init -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is called at the end of the simulation. -SUBROUTINE StC_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(StC_InputType), INTENT(INOUT) :: u !< System inputs - TYPE(StC_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(StC_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states - TYPE(StC_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states - TYPE(StC_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states - TYPE(StC_OtherStateType), INTENT(INOUT) :: OtherState !< Other states - TYPE(StC_OutputType), INTENT(INOUT) :: y !< System outputs - TYPE(StC_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 - - ErrStat = ErrID_None - ErrMsg = "" - - - ! Place any last minute operations or calculations here: - - - - ! Write the StrucCtrl-level output file data if the user requested module-level output - ! and the current time has advanced since the last stored time step. - - - - ! Close files here: - - - ! Destroy the input data: - - CALL StC_DestroyInput( u, ErrStat, ErrMsg ) - - - ! Destroy the parameter data: - - CALL StC_DestroyParam( p, ErrStat, ErrMsg ) - - - ! Destroy the state data: - - CALL StC_DestroyContState( x, ErrStat, ErrMsg ) - CALL StC_DestroyDiscState( xd, ErrStat, ErrMsg ) - CALL StC_DestroyConstrState( z, ErrStat, ErrMsg ) - CALL StC_DestroyOtherState( OtherState, ErrStat, ErrMsg ) - - CALL StC_DestroyMisc( m, ErrStat, ErrMsg ) - - ! Destroy the output data: - - CALL StC_DestroyOutput( y, ErrStat, ErrMsg ) - -END SUBROUTINE StC_End -!---------------------------------------------------------------------------------------------------------------------------------- -!> Loose coupling routine for solving constraint states, integrating continuous states, and updating discrete states. -!! Continuous, constraint, and discrete states are updated to values at t + Interval. -SUBROUTINE StC_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval - TYPE(StC_InputType), INTENT(INOUT) :: Inputs(:) !< Inputs at InputTimes - REAL(DbKi), INTENT(IN ) :: InputTimes(:) !< Times in seconds associated with Inputs - TYPE(StC_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(StC_ContinuousStateType), INTENT(INOUT) :: x !< Input: Continuous states at t; - !! Output: Continuous states at t + Interval - TYPE(StC_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t; - !! Output: Discrete states at t + Interval - TYPE(StC_ConstraintStateType), INTENT(INOUT) :: z !< Input: Constraint states at t; - !! Output: Constraint states at t + Interval - TYPE(StC_OtherStateType), INTENT(INOUT) :: OtherState !< Input: Other states at t; - !! Output: Other states at t + Interval - TYPE(StC_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 - - ! Local variables - !INTEGER :: I ! Generic loop counter - !TYPE(StC_ContinuousStateType) :: dxdt ! Continuous state derivatives at t - !TYPE(StC_DiscreteStateType) :: xd_t ! Discrete states at t (copy) - !TYPE(StC_ConstraintStateType) :: z_Residual ! Residual of the constraint state functions (Z) - !TYPE(StC_InputType) :: u ! Instantaneous inputs - !INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (secondary error) - !CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None - !INTEGER :: nTime ! number of inputs - - - IF ( p%StC_DOF_MODE /= DOFMode_Prescribed ) THEN - CALL StC_RK4( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) - ENDIF - -END SUBROUTINE StC_UpdateStates -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine implements the fourth-order Runge-Kutta Method (RK4) for numerically integrating ordinary differential equations: -!! -!! Let f(t, x) = xdot denote the time (t) derivative of the continuous states (x). -!! Define constants k1, k2, k3, and k4 as -!! k1 = dt * f(t , x_t ) -!! k2 = dt * f(t + dt/2 , x_t + k1/2 ) -!! k3 = dt * f(t + dt/2 , x_t + k2/2 ), and -!! k4 = dt * f(t + dt , x_t + k3 ). -!! Then the continuous states at t = t + dt are -!! x_(t+dt) = x_t + k1/6 + k2/3 + k3/3 + k4/6 + O(dt^5) -!! -!! For details, see: -!! Press, W. H.; Flannery, B. P.; Teukolsky, S. A.; and Vetterling, W. T. "Runge-Kutta Method" and "Adaptive Step Size Control for -!! Runge-Kutta." Sections 16.1 and 16.2 in Numerical Recipes in FORTRAN: The Art of Scientific Computing, 2nd ed. Cambridge, England: -!! Cambridge University Press, pp. 704-716, 1992. -SUBROUTINE StC_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - INTEGER(IntKi), INTENT(IN ) :: n !< time step number - TYPE(StC_InputType), INTENT(INOUT) :: u(:) !< Inputs at t (out only for mesh record-keeping in ExtrapInterp routine) - REAL(DbKi), INTENT(IN ) :: utimes(:) !< times of input - TYPE(StC_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(StC_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at t on input at t + dt on output - TYPE(StC_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(StC_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t (possibly a guess) - TYPE(StC_OtherStateType), INTENT(INOUT) :: OtherState !< Other states at t - TYPE(StC_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 - - ! local variables - - TYPE(StC_ContinuousStateType) :: xdot ! time derivatives of continuous states - TYPE(StC_ContinuousStateType) :: k1 ! RK4 constant; see above - TYPE(StC_ContinuousStateType) :: k2 ! RK4 constant; see above - TYPE(StC_ContinuousStateType) :: k3 ! RK4 constant; see above - TYPE(StC_ContinuousStateType) :: k4 ! RK4 constant; see above - - TYPE(StC_ContinuousStateType) :: x_tmp ! Holds temporary modification to x - TYPE(StC_InputType) :: u_interp ! interpolated value of inputs - integer(IntKi) :: i_pt ! Generic counter for mesh point - - INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message (ErrMsg) - - - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - - CALL StC_CopyContState( x, k1, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - CALL StC_CopyContState( x, k2, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - CALL StC_CopyContState( x, k3, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - CALL StC_CopyContState( x, k4, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - CALL StC_CopyContState( x, x_tmp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - - CALL StC_CopyInput( u(1), u_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! interpolate u to find u_interp = u(t) - CALL StC_Input_ExtrapInterp( u, utimes, u_interp, t, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! find xdot at t - CALL StC_CalcContStateDeriv( t, u_interp, p, x, xd, z, OtherState, m, xdot, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - - do i_pt=1,p%NumMeshPts - k1%StC_x(:,i_pt) = p%dt * xdot%StC_x(:,i_pt) - x_tmp%StC_x(:,i_pt) = x%StC_x(:,i_pt) + 0.5 * k1%StC_x(:,i_pt) - enddo - - - ! interpolate u to find u_interp = u(t + dt/2) - CALL StC_Input_ExtrapInterp(u, utimes, u_interp, t+0.5*p%dt, ErrStat2, ErrMsg2) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! find xdot at t + dt/2 - CALL StC_CalcContStateDeriv( t + 0.5*p%dt, u_interp, p, x_tmp, xd, z, OtherState, m, xdot, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - - do i_pt=1,p%NumMeshPts - k2%StC_x(:,i_pt) = p%dt * xdot%StC_x(:,i_pt) - x_tmp%StC_x(:,i_pt) = x%StC_x(:,i_pt) + 0.5 * k2%StC_x(:,i_pt) - enddo - - - ! find xdot at t + dt/2 - CALL StC_CalcContStateDeriv( t + 0.5*p%dt, u_interp, p, x_tmp, xd, z, OtherState, m, xdot, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - - do i_pt=1,p%NumMeshPts - k3%StC_x(:,i_pt) = p%dt * xdot%StC_x(:,i_pt) - x_tmp%StC_x(:,i_pt) = x%StC_x(:,i_pt) + k3%StC_x(:,i_pt) - enddo - - - ! interpolate u to find u_interp = u(t + dt) - CALL StC_Input_ExtrapInterp(u, utimes, u_interp, t + p%dt, ErrStat2, ErrMsg2) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! find xdot at t + dt - CALL StC_CalcContStateDeriv( t + p%dt, u_interp, p, x_tmp, xd, z, OtherState, m, xdot, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - - do i_pt=1,p%NumMeshPts - k4%StC_x(:,i_pt) = p%dt * xdot%StC_x(:,i_pt) - x%StC_x(:,i_pt) = x%StC_x(:,i_pt) + ( k1%StC_x(:,i_pt) + 2. * k2%StC_x(:,i_pt) + 2. * k3%StC_x(:,i_pt) + k4%StC_x(:,i_pt) ) / 6. - ! x%StC_dxdt = x%StC_dxdt + ( k1%StC_dxdt + 2. * k2%StC_dxdt + 2. * k3%StC_dxdt + k4%StC_dxdt ) / 6. - enddo - - ! clean up local variables: - CALL ExitThisRoutine( ) - -CONTAINS - !............................................................................................................................... - SUBROUTINE ExitThisRoutine() - ! This subroutine destroys all the local variables - !............................................................................................................................... - - ! local variables - INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) - CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) - - - CALL StC_DestroyContState( xdot, ErrStat3, ErrMsg3 ) - CALL StC_DestroyContState( k1, ErrStat3, ErrMsg3 ) - CALL StC_DestroyContState( k2, ErrStat3, ErrMsg3 ) - CALL StC_DestroyContState( k3, ErrStat3, ErrMsg3 ) - CALL StC_DestroyContState( k4, ErrStat3, ErrMsg3 ) - CALL StC_DestroyContState( x_tmp, ErrStat3, ErrMsg3 ) - - CALL StC_DestroyInput( u_interp, ErrStat3, ErrMsg3 ) - - END SUBROUTINE ExitThisRoutine - !............................................................................................................................... - SUBROUTINE CheckError(ErrID,Msg) - ! This subroutine sets the error message and level and cleans up if the error is >= AbortErrLev - !............................................................................................................................... - - ! Passed arguments - INTEGER(IntKi), INTENT(IN) :: ErrID ! The error identifier (ErrStat) - CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) - - ! local variables - INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) - CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) - - !............................................................................................................................ - ! Set error status/message; - !............................................................................................................................ - - IF ( ErrID /= ErrID_None ) THEN - - IF (ErrStat /= ErrID_None) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'StC_RK4:'//TRIM(Msg) - ErrStat = MAX(ErrStat,ErrID) - - !......................................................................................................................... - ! Clean up if we're going to return on error: close files, deallocate local arrays - !......................................................................................................................... - - IF ( ErrStat >= AbortErrLev ) CALL ExitThisRoutine( ) - - - END IF - - END SUBROUTINE CheckError - -END SUBROUTINE StC_RK4 -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine for computing outputs, used in both loose and tight coupling. -SUBROUTINE StC_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(StC_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(StC_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(StC_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(StC_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time - TYPE(StC_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time - TYPE(StC_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time - TYPE(StC_OutputType), INTENT(INOUT) :: y !< Outputs computed at Time (Input only so that mesh con- - !! nectivity information does not have to be recalculated) - TYPE(StC_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 - - ! local variables for force calcualtions in X-DOF, Y-DOF, and XY-DOF - real(ReKi), dimension(3) :: F_X_P - real(ReKi), dimension(3) :: F_Y_P - real(ReKi), dimension(3) :: F_Z_P - real(ReKi), dimension(3) :: F_XY_P - - ! NOTE: the following two sets of variables could likely be combined into arrays - ! that could be more easily used with array functions like MATMUL, cross_product, - ! dot_product etc. - ! Fore-aft TLCD reactionary forces !MEG & SP - Real(ReKi) :: F_x_tlcd_WR_N - Real(ReKi) :: F_y_tlcd_WR_N - Real(ReKi) :: F_x_tlcd_WL_N - Real(ReKi) :: F_y_tlcd_WL_N - Real(ReKi) :: F_y_tlcd_WH_N - Real(ReKi) :: F_z_tlcd_WH_N - - ! Side-side orthogonal TLCD reactionary forces !MEG & SP - Real(ReKi) :: F_x_otlcd_WB_N - Real(ReKi) :: F_y_otlcd_WB_N - Real(ReKi) :: F_x_otlcd_WF_N - Real(ReKi) :: F_y_otlcd_WF_N - Real(ReKi) :: F_x_otlcd_WH_N - Real(ReKi) :: F_z_otlcd_WH_N - - TYPE(StC_ContinuousStateType) :: dxdt ! first time derivative of continuous states - - integer(IntKi) :: i,j !< generic counter - integer(IntKi) :: i_pt ! Generic counter for mesh point - - ! Local error handling - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - - ErrStat = ErrID_None - ErrMsg = "" - - - ! Compute accelerations and velocities in local coordinates - do i_pt=1,p%NumMeshPts - m%a_G(:,i_pt) = matmul(u%Mesh(i_pt)%Orientation(:,:,1),p%Gravity) - m%rdisp_P(:,i_pt) = matmul(u%Mesh(i_pt)%Orientation(:,:,1),u%Mesh(i_pt)%TranslationDisp(:,1)) ! for ground StC_GroundHookDamp - m%rdot_P(:,i_pt) = matmul(u%Mesh(i_pt)%Orientation(:,:,1),u%Mesh(i_pt)%TranslationVel(:,1)) ! for ground StC_GroundHookDamp - m%rddot_P(:,i_pt) = matmul(u%Mesh(i_pt)%Orientation(:,:,1),u%Mesh(i_pt)%TranslationAcc(:,1)) - m%omega_P(:,i_pt) = matmul(u%Mesh(i_pt)%Orientation(:,:,1),u%Mesh(i_pt)%RotationVel(:,1)) - m%alpha_P(:,i_pt) = matmul(u%Mesh(i_pt)%Orientation(:,:,1),u%Mesh(i_pt)%RotationAcc(:,1)) - enddo - - - ! calculate the derivative, only to get updated values of m, which are used in the equations below - CALL StC_CalcContStateDeriv( Time, u, p, x, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2 ); if (Failed()) return; - - - IF (p%StC_DOF_MODE == ControlMode_None) THEN - do i_pt=1,p%NumMeshPts - y%Mesh(i_pt)%Force(:,1) = 0.0_ReKi - y%Mesh(i_pt)%Moment(:,1) = 0.0_ReKi - m%F_P(1:3,i_pt) = 0.0_ReKi - m%M_P(1:3,i_pt) = 0.0_ReKi - enddo - ELSEIF (p%StC_DOF_MODE == DOFMode_Indept) THEN - - ! StrucCtrl external forces of dependent degrees: - do i_pt=1,p%NumMeshPts - F_X_P(2) = - p%M_X * ( m%a_G(2,i_pt) - m%rddot_P(2,i_pt) - (m%alpha_P(3,i_pt) + m%omega_P(1,i_pt)*m%omega_P(2,i_pt))*x%StC_x(1,i_pt) - 2*m%omega_P(3,i_pt)*x%StC_x(2,i_pt) ) - F_X_P(3) = - p%M_X * ( m%a_G(3,i_pt) - m%rddot_P(3,i_pt) + (m%alpha_P(2,i_pt) - m%omega_P(1,i_pt)*m%omega_P(3,i_pt))*x%StC_x(1,i_pt) + 2*m%omega_P(2,i_pt)*x%StC_x(2,i_pt) ) - - F_Y_P(1) = - p%M_Y * ( m%a_G(1,i_pt) - m%rddot_P(1,i_pt) + (m%alpha_P(3,i_pt) - m%omega_P(1,i_pt)*m%omega_P(2,i_pt))*x%StC_x(3,i_pt) + 2*m%omega_P(3,i_pt)*x%StC_x(4,i_pt) ) - F_Y_P(3) = - p%M_Y * ( m%a_G(3,i_pt) - m%rddot_P(3,i_pt) - (m%alpha_P(1,i_pt) + m%omega_P(2,i_pt)*m%omega_P(3,i_pt))*x%StC_x(3,i_pt) - 2*m%omega_P(1,i_pt)*x%StC_x(4,i_pt) ) - - F_Z_P(1) = - p%M_Z * ( m%a_G(1,i_pt) - m%rddot_P(1,i_pt) - (m%alpha_P(2,i_pt) + m%omega_P(1,i_pt)*m%omega_P(3,i_pt))*x%StC_x(5,i_pt) - 2*m%omega_P(2,i_pt)*x%StC_x(6,i_pt) ) - F_Z_P(2) = - p%M_Z * ( m%a_G(2,i_pt) - m%rddot_P(2,i_pt) + (m%alpha_P(1,i_pt) - m%omega_P(2,i_pt)*m%omega_P(3,i_pt))*x%StC_x(5,i_pt) + 2*m%omega_P(1,i_pt)*x%StC_x(6,i_pt) ) - - ! inertial contributions from mass of tuned mass dampers and acceleration of point - ! forces and moments in local coordinates - m%F_P(1,i_pt) = p%K_X * x%StC_x(1,i_pt) + m%C_ctrl(1,i_pt) * x%StC_x(2,i_pt) + m%C_Brake(1,i_pt) * x%StC_x(2,i_pt) - m%F_stop(1,i_pt) - m%F_ext(1,i_pt) - m%F_fr(1,i_pt) - F_Y_P(1) - F_Z_P(1) + m%F_table(1,i_pt) - m%F_P(2,i_pt) = p%K_Y * x%StC_x(3,i_pt) + m%C_ctrl(2,i_pt) * x%StC_x(4,i_pt) + m%C_Brake(2,i_pt) * x%StC_x(4,i_pt) - m%F_stop(2,i_pt) - m%F_ext(2,i_pt) - m%F_fr(2,i_pt) - F_X_P(2) - F_Z_P(2) + m%F_table(2,i_pt) - m%F_P(3,i_pt) = p%K_Z * x%StC_x(5,i_pt) + m%C_ctrl(3,i_pt) * x%StC_x(6,i_pt) + m%C_Brake(3,i_pt) * x%StC_x(6,i_pt) - m%F_stop(3,i_pt) - m%F_ext(3,i_pt) - m%F_fr(3,i_pt) - F_X_P(3) - F_Y_P(3) + m%F_table(3,i_pt) - - m%M_P(1,i_pt) = - F_Y_P(3) * x%StC_x(3,i_pt) + F_Z_P(2) * x%StC_x(5,i_pt) - m%M_P(2,i_pt) = F_X_P(3) * x%StC_x(1,i_pt) - F_Z_P(1) * x%StC_x(5,i_pt) - m%M_P(3,i_pt) = - F_X_P(2) * x%StC_x(1,i_pt) + F_Y_P(1) * x%StC_x(3,i_pt) ! NOTE signs match document, but are changed from prior value - - ! forces and moments in global coordinates - y%Mesh(i_pt)%Force(:,1) = real(matmul(transpose(u%Mesh(i_pt)%Orientation(:,:,1)),m%F_P(1:3,i_pt)),ReKi) - y%Mesh(i_pt)%Moment(:,1) = real(matmul(transpose(u%Mesh(i_pt)%Orientation(:,:,1)),m%M_P(1:3,i_pt)),ReKi) - enddo - - ELSE IF (p%StC_DOF_MODE == DOFMode_Omni) THEN - - !note: m%F_k is computed earlier in StC_CalcContStateDeriv - - ! StrucCtrl external forces of dependent degrees: - do i_pt=1,p%NumMeshPts - F_XY_P(1) = 0 - F_XY_P(2) = 0 - F_XY_P(3) = - p%M_XY * ( m%a_G(3,i_pt) - m%rddot_P(3,i_pt) & - - (m%alpha_P(1,i_pt) + m%omega_P(2,i_pt)*m%omega_P(3,i_pt))*x%StC_x(3,i_pt) & - + (m%alpha_P(2,i_pt) - m%omega_P(1,i_pt)*m%omega_P(3,i_pt))*x%StC_x(1,i_pt) & - - 2*m%omega_P(1,i_pt)*x%StC_x(4,i_pt) & - + 2*m%omega_P(2,i_pt)*x%StC_x(2,i_pt) ) - - ! inertial contributions from mass of tuned mass dampers and acceleration of point - ! forces and moments in local coordinates - m%F_P(1,i_pt) = p%K_X * x%StC_x(1,i_pt) + m%C_ctrl(1,i_pt) * x%StC_x(2,i_pt) + m%C_Brake(1,i_pt) * x%StC_x(2,i_pt) - m%F_stop(1,i_pt) - m%F_ext(1,i_pt) - m%F_fr(1,i_pt) - F_XY_P(1) + m%F_table(1,i_pt)*(m%F_k(1,i_pt)) - m%F_P(2,i_pt) = p%K_Y * x%StC_x(3,i_pt) + m%C_ctrl(2,i_pt) * x%StC_x(4,i_pt) + m%C_Brake(2,i_pt) * x%StC_x(4,i_pt) - m%F_stop(2,i_pt) - m%F_ext(2,i_pt) - m%F_fr(2,i_pt) - F_XY_P(2) + m%F_table(2,i_pt)*(m%F_k(2,i_pt)) - m%F_P(3,i_pt) = - F_XY_P(3) - - m%M_P(1,i_pt) = - F_XY_P(3) * x%StC_x(3,i_pt) - m%M_P(2,i_pt) = F_XY_P(3) * x%StC_x(1,i_pt) - m%M_P(3,i_pt) = - F_XY_P(1) * x%StC_x(3,i_pt) + F_XY_P(2) * x%StC_x(1,i_pt) - - ! forces and moments in global coordinates - y%Mesh(i_pt)%Force(:,1) = real(matmul(transpose(u%Mesh(i_pt)%Orientation(:,:,1)),m%F_P(1:3,i_pt)),ReKi) - y%Mesh(i_pt)%Moment(:,1) = real(matmul(transpose(u%Mesh(i_pt)%Orientation(:,:,1)),m%M_P(1:3,i_pt)),ReKi) - enddo - - ELSE IF (p%StC_DOF_MODE == DOFMode_TLCD) THEN - - do i_pt=1,p%NumMeshPts - !fore-aft TLCD external forces of dependent degrees - F_x_tlcd_WR_N = p%rho_X*p%area_X*((p%L_X-p%B_X)/2+x%StC_x(1,i_pt))*( & - m%rddot_P(1,i_pt) & - +2*m%omega_P(2,i_pt)*x%StC_x(2,i_pt) & - +m%alpha_P(2,i_pt)*((p%L_X-p%B_X)/2+x%StC_x(1,i_pt)) & - -m%omega_P(2,i_pt)*m%omega_P(2,i_pt)*p%B_X*.5 & - -m%omega_P(3,i_pt)*m%omega_P(3,i_pt)*p%B_X*.5 & - +m%omega_P(3,i_pt)*m%omega_P(1,i_pt)*((p%L_X-p%B_X)/2+x%StC_x(1,i_pt)) & - -m%a_G(1,i_pt) ) - F_y_tlcd_WR_N = p%rho_X*p%area_X*((p%L_X-p%B_X)/2+x%StC_x(1,i_pt))*( & - m%rddot_P(2,i_pt) & - -2*m%omega_P(1,i_pt)*x%StC_x(2,i_pt) & - +m%alpha_P(3,i_pt)*p%B_X*.5 & - -m%alpha_P(1,i_pt)*((p%L_X-p%B_X)/2+x%StC_x(1,i_pt)) & - +m%omega_P(3,i_pt)*m%omega_P(2,i_pt)*((p%L_X-p%B_X)/2+x%StC_x(1,i_pt)) & - +m%omega_P(1,i_pt)*m%omega_P(2,i_pt)*p%B_X*.5 & - -m%a_G(2,i_pt) ) - F_x_tlcd_WL_N = p%rho_X*p%area_X*((p%L_X-p%B_X)/2-x%StC_x(1,i_pt))*( & - m%rddot_P(1,i_pt) & - -2*m%omega_P(2,i_pt)*x%StC_x(2,i_pt) & - +m%alpha_P(2,i_pt)*((p%L_X-p%B_X)/2-x%StC_x(1,i_pt)) & - +m%omega_P(2,i_pt)*m%omega_P(2,i_pt)*p%B_X*.5 & - +m%omega_P(3,i_pt)*m%omega_P(3,i_pt)*p%B_X*.5 & - +m%omega_P(3,i_pt)*m%omega_P(1,i_pt)*((p%L_X-p%B_X)/2-x%StC_x(1,i_pt)) & - -m%a_G(1,i_pt) ) - F_y_tlcd_WL_N = p%rho_X*p%area_X*((p%L_X-p%B_X)/2-x%StC_x(1,i_pt))*( & - m%rddot_P(2,i_pt) & - +2*m%omega_P(1,i_pt)*x%StC_x(2,i_pt) & - -m%alpha_P(3,i_pt)*p%B_X*.5 & - -m%alpha_P(1,i_pt)*((p%L_X-p%B_X)/2-x%StC_x(1,i_pt)) & - +m%omega_P(3,i_pt)*m%omega_P(2,i_pt)*((p%L_X-p%B_X)/2-x%StC_x(1,i_pt)) & - -m%omega_P(1,i_pt)*m%omega_P(2,i_pt)*p%B_X*.5 & - -m%a_G(2,i_pt) ) - F_y_tlcd_WH_N = p%rho_X*p%area_X/p%area_ratio_X*p%B_X*( & - m%rddot_P(2,i_pt) & - +2*m%omega_P(3,i_pt)*p%area_ratio_X*x%StC_x(2,i_pt) & - -m%a_G(2,i_pt) ) - F_z_tlcd_WH_N = p%rho_X*p%area_X/p%area_ratio_X*p%B_X*( & - m%rddot_P(3,i_pt) & - -2*m%omega_P(2,i_pt)*p%area_ratio_X*x%StC_x(2,i_pt) & - -m%a_G(3,i_pt) ) - - !side-to-side TLCD external forces of dependent degrees - F_x_otlcd_WB_N = p%rho_Y*p%area_Y*((p%L_Y-p%B_Y)/2+x%StC_x(3,i_pt))*( & - m%rddot_P(1,i_pt) & - +2*m%omega_P(2,i_pt)*x%StC_x(4,i_pt) & - +m%alpha_P(2,i_pt)*((p%L_Y-p%B_Y)/2+x%StC_x(3,i_pt)) & - +m%alpha_P(3,i_pt)*p%B_Y/2-m%omega_P(2,i_pt)*m%omega_P(1,i_pt)*p%B_Y/2 & - +m%omega_P(3,i_pt)*m%omega_P(1,i_pt)*((p%L_Y-p%B_Y)/2+x%StC_x(3,i_pt)) & - -m%a_G(1,i_pt) ) - F_y_otlcd_WB_N = p%rho_Y*p%area_Y*((p%L_Y-p%B_Y)/2+x%StC_x(3,i_pt))*( & - m%rddot_P(2,i_pt) & - -2*m%omega_P(1,i_pt)*x%StC_x(4,i_pt) & - -m%alpha_P(1,i_pt)*((p%L_Y-p%B_Y)/2+x%StC_x(3,i_pt)) & - +m%omega_P(3,i_pt)*m%omega_P(2,i_pt)*((p%L_Y-p%B_Y)/2+x%StC_x(3,i_pt)) & - +m%omega_P(3,i_pt)*m%omega_P(3,i_pt)*p%B_Y/2 & - +m%omega_P(1,i_pt)*m%omega_P(1,i_pt)*p%B_Y/2 & - -m%a_G(2,i_pt) ) - F_x_otlcd_WF_N = p%rho_Y*p%area_Y*((p%L_Y-p%B_Y)/2-x%StC_x(3,i_pt))*( & - m%rddot_P(1,i_pt) & - -2*m%omega_P(2,i_pt)*x%StC_x(4,i_pt) & - +m%alpha_P(2,i_pt)*((p%L_Y-p%B_Y)/2-x%StC_x(3,i_pt)) & - -m%alpha_P(2,i_pt)*p%B_Y/2 & - +m%omega_P(2,i_pt)*m%omega_P(1,i_pt)*p%B_Y/2 & - +m%omega_P(3,i_pt)*m%omega_P(1,i_pt)*((p%L_Y-p%B_Y)/2-x%StC_x(3,i_pt)) & - -m%a_G(1,i_pt) ) - F_y_otlcd_WF_N = p%rho_Y*p%area_Y*((p%L_Y-p%B_Y)/2-x%StC_x(3,i_pt))*( & - m%rddot_P(2,i_pt) & - +2*m%omega_P(1,i_pt)*x%StC_x(4,i_pt) & - -m%alpha_P(1,i_pt)*((p%L_Y-p%B_Y)/2-x%StC_x(3,i_pt)) & - +m%omega_P(3,i_pt)*m%omega_P(2,i_pt)*((p%L_Y-p%B_Y)/2-x%StC_x(3,i_pt)) & - -m%omega_P(3,i_pt)*m%omega_P(3,i_pt)*p%B_Y/2 & - -m%omega_P(1,i_pt)*m%omega_P(1,i_pt)*p%B_Y/2 & - -m%a_G(2,i_pt) ) - F_x_otlcd_WH_N = p%rho_Y*p%area_Y/p%area_ratio_Y*p%B_Y*( & - m%rddot_P(1,i_pt) & - -2*m%omega_P(3,i_pt)*p%area_ratio_Y*x%StC_x(4,i_pt) & - -m%a_G(1,i_pt) ) - F_z_otlcd_WH_N = p%rho_Y*p%area_Y/p%area_ratio_Y*p%B_Y*( & - m%rddot_P(3,i_pt) & - +2*m%omega_P(1,i_pt)*p%area_ratio_Y*x%StC_x(4,i_pt) & - -m%a_G(3,i_pt) ) - - ! forces and moments in local coordinates (from fore-aft and side-to-side TLCDs) - m%F_P(1,i_pt) = -F_x_tlcd_WR_N - F_x_tlcd_WL_N - p%rho_X*(p%area_X/p%area_ratio_X)*p%B_X*dxdt%StC_x(2,i_pt)*p%area_ratio_X + F_x_otlcd_WB_N + F_x_otlcd_WF_N + F_x_otlcd_WH_N - m%F_P(2,i_pt) = +F_y_tlcd_WR_N + F_y_tlcd_WL_N - p%rho_Y*(p%area_Y/p%area_ratio_Y)*p%B_Y*dxdt%StC_x(4,i_pt)*p%area_ratio_Y + F_y_tlcd_WH_N - F_y_otlcd_WB_N - F_y_otlcd_WF_N - m%F_P(3,i_pt) = -F_z_tlcd_WH_N - F_z_otlcd_WH_N - - m%M_P(1,i_pt) = F_y_tlcd_WR_N*((p%L_X-p%B_X)/2+x%StC_x(1,i_pt)) + F_y_tlcd_WL_N*((p%L_X-p%B_X)/2-x%StC_x(1,i_pt)) - F_y_otlcd_WB_N*((p%L_Y-p%B_Y)/2+x%StC_x(3,i_pt)) - F_y_otlcd_WF_N*((p%L_Y-p%B_Y)/2-x%StC_x(3,i_pt)) - m%M_P(2,i_pt) = -F_x_tlcd_WR_N*((p%L_X-p%B_X)/2+x%StC_x(1,i_pt)) - F_x_tlcd_WL_N*((p%L_X-p%B_X)/2-x%StC_x(1,i_pt)) + F_x_otlcd_WB_N*((p%L_Y-p%B_Y)/2+x%StC_x(3,i_pt)) + F_x_otlcd_WF_N*((p%L_Y-p%B_Y)/2-x%StC_x(3,i_pt)) - m%M_P(3,i_pt) = F_y_tlcd_WR_N*p%B_X*.5 - F_y_tlcd_WL_N*p%B_X*.5 + F_x_otlcd_WB_N*p%B_Y*.5 - F_x_otlcd_WF_N*p%B_Y*.5 - - ! forces and moments in global coordinates - y%Mesh(i_pt)%Force(:,1) = real(matmul(transpose(u%Mesh(i_pt)%Orientation(:,:,1)), m%F_P(1:3,i_pt)),ReKi) - y%Mesh(i_pt)%Moment(:,1) = real(matmul(transpose(u%Mesh(i_pt)%Orientation(:,:,1)), m%M_P(1:3,i_pt)),ReKi) - enddo - ELSEIF ( p%StC_DOF_MODE == DOFMode_Prescribed ) THEN - ! Note that the prescribed force is applied the same to all Mesh pts - ! that are passed into this instance of the StC - do i=1,3 - ! Get interpolated force -- this is not in any particular coordinate system yet - m%F_P(i,:) = InterpStp( real(Time,ReKi), p%StC_PrescribedForce(1,:),p%StC_PrescribedForce(i+1,:),m%PrescribedInterpIdx, size(p%StC_PrescribedForce,2)) - ! Get interpolated moment -- this is not in any particular coordinate system yet - m%M_P(i,:) = InterpStp( real(Time,ReKi), p%StC_PrescribedForce(1,:),p%StC_PrescribedForce(i+4,:),m%PrescribedInterpIdx, size(p%StC_PrescribedForce,2)) - enddo - 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_P(1:3,i_pt) - y%Mesh(i_pt)%Moment(1:3,1) = m%M_P(1:3,i_pt) - enddo - 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 - END IF - - call CleanUp() - -CONTAINS - subroutine CleanUp() - call StC_DestroyContState(dxdt,ErrStat2,ErrMsg2) !Ignore error status - end subroutine CleanUp - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'StC_CalcOutput') - Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() - end function Failed -END SUBROUTINE StC_CalcOutput - -!---------------------------------------------------------------------------------------------------------------------------------- -!> Tight coupling routine for computing derivatives of continuous states -SUBROUTINE StC_CalcContStateDeriv( Time, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(StC_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(StC_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(StC_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(StC_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time - TYPE(StC_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time - TYPE(StC_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time - TYPE(StC_ContinuousStateType), INTENT( OUT) :: dxdt !< Continuous state derivatives at Time - TYPE(StC_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 - - REAL(ReKi), dimension(3) :: K ! tuned mass damper stiffness - Real(ReKi) :: denom ! denominator for omni-direction factors - integer(IntKi) :: i_pt ! Generic counter for mesh point - - ! Local error handling - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - - - call AllocAry(dxdt%StC_x,6, p%NumMeshPts,'dxdt%StC_x', ErrStat2,ErrMsg2); if (Failed()) return; - - ! compute stop force (m%F_stop) - IF (p%Use_F_TBL) THEN - m%F_stop = 0.0_ReKi - ELSE - CALL StC_CalcStopForce(x,p,m%F_stop) - END IF - - ! Compute stiffness - IF (p%Use_F_TBL) THEN ! use stiffness table - CALL SpringForceExtrapInterp(x,p,m%F_table,ErrStat2,ErrMsg2); if (Failed()) return; - K = 0.0_ReKi - ELSE ! use preset values - K(1) = p%K_X - K(2) = p%K_Y - K(3) = p%K_Z - END IF - - - ! Compute accelerations and velocities in local coordinates - do i_pt=1,p%NumMeshPts - m%a_G(:,i_pt) = matmul(u%Mesh(i_pt)%Orientation(:,:,1),p%Gravity) - m%rdisp_P(:,i_pt) = matmul(u%Mesh(i_pt)%Orientation(:,:,1),u%Mesh(i_pt)%TranslationDisp(:,1)) ! for ground StC_GroundHookDamp - m%rdot_P(:,i_pt) = matmul(u%Mesh(i_pt)%Orientation(:,:,1),u%Mesh(i_pt)%TranslationVel(:,1)) ! for ground StC_GroundHookDamp - m%rddot_P(:,i_pt) = matmul(u%Mesh(i_pt)%Orientation(:,:,1),u%Mesh(i_pt)%TranslationAcc(:,1)) - m%omega_P(:,i_pt) = matmul(u%Mesh(i_pt)%Orientation(:,:,1),u%Mesh(i_pt)%RotationVel(:,1)) - m%alpha_P(:,i_pt) = matmul(u%Mesh(i_pt)%Orientation(:,:,1),u%Mesh(i_pt)%RotationAcc(:,1)) - enddo - - ! NOTE: m%F_stop and m%F_table are calculated earlier - IF (p%StC_DOF_MODE == ControlMode_None) THEN - do i_pt=1,p%NumMeshPts - ! Aggregate acceleration terms - m%Acc(1:3,i_pt) = 0.0_ReKi - enddo - - ELSEIF (p%StC_DOF_MODE == DOFMode_Indept) THEN - - do i_pt=1,p%NumMeshPts - ! Aggregate acceleration terms - m%Acc(1,i_pt) = - m%rddot_P(1,i_pt) + m%a_G(1,i_pt) + 1 / p%M_X * ( m%F_ext(1,i_pt) + m%F_stop(1,i_pt) - m%F_table(1,i_pt) ) - m%Acc(2,i_pt) = - m%rddot_P(2,i_pt) + m%a_G(2,i_pt) + 1 / p%M_Y * ( m%F_ext(2,i_pt) + m%F_stop(2,i_pt) - m%F_table(2,i_pt) ) - m%Acc(3,i_pt) = - m%rddot_P(3,i_pt) + m%a_G(3,i_pt) + 1 / p%M_Z * ( m%F_ext(3,i_pt) + m%F_stop(3,i_pt) - m%F_table(3,i_pt) ) - enddo - - ELSE IF (p%StC_DOF_MODE == DOFMode_Omni) THEN - - do i_pt=1,p%NumMeshPts - denom = SQRT(x%StC_x(1,i_pt)**2+x%StC_x(3,i_pt)**2) - IF ( EqualRealNos( denom, 0.0_ReKi) ) THEN - m%F_k(1,i_pt) = 0.0 - m%F_k(2,i_pt) = 0.0 - ELSE - m%F_k(1,i_pt) = x%StC_x(1,i_pt)/denom - m%F_k(2,i_pt) = x%StC_x(3,i_pt)/denom - END IF - m%F_k(3,i_pt) = 0.0 - - ! Aggregate acceleration terms - m%Acc(1,i_pt) = - m%rddot_P(1,i_pt) + m%a_G(1,i_pt) + 1 / p%M_XY * ( m%F_ext(1,i_pt) + m%F_stop(1,i_pt) - m%F_table(1,i_pt)*(m%F_k(1,i_pt)) ) - m%Acc(2,i_pt) = - m%rddot_P(2,i_pt) + m%a_G(2,i_pt) + 1 / p%M_XY * ( m%F_ext(2,i_pt) + m%F_stop(2,i_pt) - m%F_table(2,i_pt)*(m%F_k(2,i_pt)) ) - m%Acc(3,i_pt) = 0.0_ReKi - enddo - - ENDIF - - - ! Compute the first time derivatives, dxdt%StC_x(1) and dxdt%StC_x(3), of the continuous states,: - ! Compute elements 1 and 3 of dxdt%StC_x so that we can compute m%C_ctrl,m%C_Brake, and m%F_fr in StC_GroundHookDamp if necessary - IF (p%StC_DOF_MODE == ControlMode_None) THEN - - dxdt%StC_x = 0.0_ReKi ! Whole array - - ELSE - - IF (p%StC_DOF_MODE == DOFMode_Indept .AND. .NOT. p%StC_X_DOF) THEN - do i_pt=1,p%NumMeshPts - dxdt%StC_x(1,i_pt) = 0.0_ReKi - enddo - ELSE - do i_pt=1,p%NumMeshPts - dxdt%StC_x(1,i_pt) = x%StC_x(2,i_pt) - enddo - END IF - - IF (p%StC_DOF_MODE == DOFMode_Indept .AND. .NOT. p%StC_Y_DOF) THEN - do i_pt=1,p%NumMeshPts - dxdt%StC_x(3,i_pt) = 0.0_ReKi - enddo - ELSE - do i_pt=1,p%NumMeshPts - dxdt%StC_x(3,i_pt) = x%StC_x(4,i_pt) - enddo - END IF - - IF (p%StC_DOF_MODE == DOFMode_Indept .AND. .NOT. p%StC_Z_DOF) THEN - do i_pt=1,p%NumMeshPts - dxdt%StC_x(5,i_pt) = 0.0_ReKi - enddo - ELSE - do i_pt=1,p%NumMeshPts - dxdt%StC_x(5,i_pt) = x%StC_x(6,i_pt) - enddo - END IF - - ENDIF - - - ! compute damping for dxdt%StC_x(2), dxdt%StC_x(4), and dxdt%StC_x(6) - IF (p%StC_CMODE == ControlMode_None) THEN - m%C_ctrl(1,:) = p%C_X - m%C_ctrl(2,:) = p%C_Y - m%C_ctrl(3,:) = p%C_Z - - m%C_Brake = 0.0_ReKi - m%F_fr = 0.0_ReKi - 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) - END IF - - - ! Compute the first time derivatives, dxdt%StC_x(2), dxdt%StC_x(4), and dxdt%StC_x(6), of the continuous states,: - IF (p%StC_DOF_MODE == DOFMode_Indept) THEN - - IF (p%StC_X_DOF) THEN - do i_pt=1,p%NumMeshPts - dxdt%StC_x(2,i_pt) = ( m%omega_P(2,i_pt)**2 + m%omega_P(3,i_pt)**2 - K(1) / p%M_X) * x%StC_x(1,i_pt) & - - ( m%C_ctrl( 1,i_pt)/p%M_X ) * x%StC_x(2,i_pt) & - - ( m%C_Brake(1,i_pt)/p%M_X ) * x%StC_x(2,i_pt) & - + m%Acc(1,i_pt) + m%F_fr(1,i_pt) / p%M_X - enddo - ELSE - do i_pt=1,p%NumMeshPts - dxdt%StC_x(2,i_pt) = 0.0_ReKi - enddo - END IF - IF (p%StC_Y_DOF) THEN - do i_pt=1,p%NumMeshPts - dxdt%StC_x(4,i_pt) = ( m%omega_P(1,i_pt)**2 + m%omega_P(3,i_pt)**2 - K(2) / p%M_Y) * x%StC_x(3,i_pt) & - - ( m%C_ctrl( 2,i_pt)/p%M_Y ) * x%StC_x(4,i_pt) & - - ( m%C_Brake(2,i_pt)/p%M_Y ) * x%StC_x(4,i_pt) & - + m%Acc(2,i_pt) + m%F_fr(2,i_pt) / p%M_Y - enddo - ELSE - do i_pt=1,p%NumMeshPts - dxdt%StC_x(4,i_pt) = 0.0_ReKi - enddo - END IF - IF (p%StC_Z_DOF) THEN - do i_pt=1,p%NumMeshPts - dxdt%StC_x(6,i_pt) = ( m%omega_P(1,i_pt)**2 + m%omega_P(2,i_pt)**2 - K(3) / p%M_Z) * x%StC_x(5,i_pt) & - - ( m%C_ctrl( 3,i_pt)/p%M_Z ) * x%StC_x(6,i_pt) & - - ( m%C_Brake(3,i_pt)/p%M_Z ) * x%StC_x(6,i_pt) & - + m%Acc(3,i_pt) + m%F_fr(3,i_pt) / p%M_Z - enddo - ELSE - do i_pt=1,p%NumMeshPts - dxdt%StC_x(6,i_pt) = 0.0_ReKi - enddo - END IF - - ELSE IF (p%StC_DOF_MODE == DOFMode_Omni) THEN ! Only includes X and Y - ! Compute the first time derivatives of the continuous states of Omnidirectional tuned masse damper mode by sm 2015-0904 - do i_pt=1,p%NumMeshPts - dxdt%StC_x(2,i_pt) = ( m%omega_P(2,i_pt)**2 + m%omega_P(3,i_pt)**2 - K(1) / p%M_XY) * x%StC_x(1,i_pt) & - - ( m%C_ctrl( 1,i_pt)/p%M_XY ) * x%StC_x(2,i_pt) & - - ( m%C_Brake(1,i_pt)/p%M_XY ) * x%StC_x(2,i_pt) & - + m%Acc(1,i_pt) + 1/p%M_XY * ( m%F_fr(1,i_pt) ) & - - ( m%omega_P(1,i_pt)*m%omega_P(2,i_pt) - m%alpha_P(3,i_pt) ) * x%StC_x(3,i_pt) & - +2 * m%omega_P(3,i_pt) * x%StC_x(4,i_pt) - dxdt%StC_x(4,i_pt) = ( m%omega_P(1,i_pt)**2 + m%omega_P(3,i_pt)**2 - K(2) / p%M_XY) * x%StC_x(3,i_pt) & - - ( m%C_ctrl( 2,i_pt)/p%M_XY ) * x%StC_x(4,i_pt) & - - ( m%C_Brake(2,i_pt)/p%M_XY ) * x%StC_x(4,i_pt) & - + m%Acc(2,i_pt) + 1/p%M_XY * ( m%F_fr(2,i_pt) ) & - - ( m%omega_P(1,i_pt)*m%omega_P(2,i_pt) + m%alpha_P(3,i_pt) ) * x%StC_x(1,i_pt) & - -2 * m%omega_P(3,i_pt) * x%StC_x(2,i_pt) - dxdt%StC_x(6,i_pt) = 0.0_ReKi ! Z is off - enddo - - ELSE IF (p%StC_DOF_MODE == DOFMode_TLCD) THEN !MEG & SP - ! Compute the first time derivatives of the continuous states of TLCD mode - do i_pt=1,p%NumMeshPts - dxdt%StC_x(2,i_pt) = (2*p%rho_X*p%area_X*x%StC_x(1,i_pt)*m%rddot_P(3,i_pt) & - +p%rho_X*p%area_X*p%B_X*m%alpha_P(2,i_pt)*((p%L_X-p%B_X)/2) & - -p%rho_X*p%area_X*p%B_X*m%omega_P(1,i_pt)*m%omega_P(3,i_pt)*((p%L_X-p%B_X)/2) & - +2*p%rho_X*p%area_X*m%omega_P(1,i_pt)*m%omega_P(1,i_pt)*x%StC_x(1,i_pt)*(p%L_X-p%B_X) & - +2*p%rho_X*p%area_X*m%omega_P(2,i_pt)*m%omega_P(2,i_pt)*x%StC_x(1,i_pt)*(p%L_X-p%B_X) & - +2*p%rho_X*p%area_X*x%StC_x(1,i_pt)*m%a_G(3,i_pt) & - -p%rho_X*p%area_X*p%B_X*m%rddot_P(1,i_pt) & - +p%rho_X*p%area_X*p%B_X*m%a_G(1,i_pt) & - -.5*p%rho_X*p%area_X*p%headLossCoeff_X*p%area_ratio_X*p%area_ratio_X*x%StC_x(2,i_pt) & - *ABS(x%StC_x(2,i_pt)))/(p%rho_X*p%area_X*(p%L_X-p%B_X+p%area_ratio_X*p%B_X)) - dxdt%StC_x(4,i_pt) = (2*p%rho_Y*p%area_Y*x%StC_x(3,i_pt)*m%rddot_P(3,i_pt) & - +p%rho_Y*p%area_Y*p%B_Y*m%alpha_P(1,i_pt)*((p%L_Y-p%B_Y)/2) & - -p%rho_Y*p%area_Y*p%B_Y*m%omega_P(2,i_pt)*m%omega_P(3,i_pt)*((p%L_Y-p%B_Y)/2) & - +2*p%rho_Y*p%area_Y*x%StC_x(3,i_pt)*m%omega_P(1,i_pt)*m%omega_P(1,i_pt)*(p%L_Y-p%B_Y) & - +2*p%rho_Y*p%area_Y*x%StC_x(3,i_pt)*m%omega_P(2,i_pt)*m%omega_P(2,i_pt)*(p%L_Y-p%B_Y) & - +2*p%rho_Y*p%area_Y*x%StC_x(3,i_pt)*m%a_G(3,i_pt)-p%rho_Y*p%area_Y*p%B_Y*m%rddot_P(2,i_pt)& - +p%rho_Y*p%area_Y*p%B_Y*m%a_G(2,i_pt) & - -.5*p%rho_Y*p%area_Y*p%headLossCoeff_Y*p%area_ratio_Y*p%area_ratio_Y*x%StC_x(4,i_pt) & - *ABS(x%StC_x(4,i_pt)))/(p%rho_Y*p%area_Y*(p%L_Y-p%B_Y+p%area_ratio_Y*p%B_Y)) - dxdt%StC_x(6,i_pt) = 0.0_ReKi ! Z is off - enddo - - END IF - - call CleanUp() - return - -CONTAINS - subroutine CleanUp() - end subroutine CleanUp - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'StC_CalcContStateDeriv') - Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() - end function Failed -END SUBROUTINE StC_CalcContStateDeriv -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE StC_CalcStopForce(x,p,F_stop) - TYPE(StC_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(StC_ParameterType), INTENT(IN ) :: p !< Parameters - Real(ReKi), dimension(:,:), INTENT(INOUT) :: F_stop !< stop forces - ! local variables - Real(ReKi), dimension(3) :: F_SK !stop spring forces - Real(ReKi), dimension(3) :: F_SD !stop damping forces - INTEGER(IntKi) :: i ! counter - INTEGER(IntKi) :: i_pt ! counter for mesh points - INTEGER(IntKi) :: j ! counter for index into x%StC_x - do i_pt=1,p%NumMeshPts - DO i=1,3 ! X, Y, and Z - j=2*(i-1)+1 - IF ( x%StC_x(j,i_pt) > p%P_SP(i) ) THEN - F_SK(i) = p%K_S(i) *( p%P_SP(i) - x%StC_x(j,i_pt) ) - ELSEIF ( x%StC_x(j,i_pt) < p%N_SP(i) ) THEN - F_SK(i) = p%K_S(i) * ( p%N_SP(i) - x%StC_x(j,i_pt) ) - ELSE - F_SK(i) = 0.0_ReKi - ENDIF - IF ( (x%StC_x(j,i_pt) > p%P_SP(i)) .AND. (x%StC_x(j+1,i_pt) > 0) ) THEN - F_SD(i) = -p%C_S(i) *( x%StC_x(j+1,i_pt) ) - ELSEIF ( (x%StC_x(j,i_pt) < p%N_SP(i)) .AND. (x%StC_x(j+1,i_pt) < 0) ) THEN - F_SD(i) = -p%C_S(i) *( x%StC_x(j+1,i_pt) ) - ELSE - F_SD(i) = 0.0_ReKi - ENDIF - F_stop(i,i_pt) = F_SK(i) + F_SD(i) - END DO - enddo -END SUBROUTINE StC_CalcStopForce -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE StC_GroundHookDamp(dxdt,x,u,p,rdisp_P,rdot_P,C_ctrl,C_Brake,F_fr) - TYPE(StC_ContinuousStateType), INTENT(IN ) :: dxdt !< Derivative of continuous states at Time (needs elements 1 and 3 only) - TYPE(StC_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(StC_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(StC_ParameterType), INTENT(IN) :: p !< The module's parameter data - REAL(ReKi), dimension(:,:), INTENT(IN ) :: rdisp_P !< translational displacement in local coordinates - REAL(ReKi), dimension(:,:), INTENT(IN ) :: rdot_P !< translational velocity in local coordinates - REAL(ReKi), dimension(:,:), INTENT(INOUT) :: C_ctrl !< extrapolated/interpolated stiffness values - REAL(ReKi), dimension(:,:), INTENT(INOUT) :: C_Brake !< extrapolated/interpolated stiffness values - REAL(ReKi), dimension(:,:), INTENT(INOUT) :: F_fr !< Friction forces - INTEGER(IntKi) :: i_pt !< generic counter for mesh points - - - do i_pt=1,p%NumMeshPts - IF (p%StC_CMODE == CMODE_Semi .AND. p%StC_SA_MODE == SA_CMODE_GH_vel) THEN ! velocity-based ground hook control with high damping for braking - - !X - IF (dxdt%StC_x(1,i_pt) * rdot_P(1,i_pt) <= 0 ) THEN - C_ctrl(1,i_pt) = p%StC_X_C_HIGH - ELSE - C_ctrl(1,i_pt) = p%StC_X_C_LOW - END IF - - !Brake X - IF ( (x%StC_x(1,i_pt) > p%P_SP(1)-0.2) .AND. (x%StC_x(2,i_pt) > 0) ) THEN - C_Brake(1,i_pt) = p%StC_X_C_BRAKE - ELSE IF ( (x%StC_x(1,i_pt) < p%N_SP(1)+0.2) .AND. (x%StC_x(2,i_pt) < 0) ) THEN - C_Brake(1,i_pt) = p%StC_X_C_BRAKE - ELSE - C_Brake(1,i_pt) = 0 - END IF - - - ! Y - IF (dxdt%StC_x(3,i_pt) * rdot_P(2,i_pt) <= 0 ) THEN - C_ctrl(2,i_pt) = p%StC_Y_C_HIGH - ELSE - C_ctrl(2,i_pt) = p%StC_Y_C_LOW - END IF - - !Brake Y - IF ( (x%StC_x(3,i_pt) > p%P_SP(2)-0.2) .AND. (x%StC_x(4,i_pt) > 0) ) THEN - C_Brake(2,i_pt) = p%StC_Y_C_BRAKE - ELSE IF ( (x%StC_x(3,i_pt) < p%N_SP(2)+0.2) .AND. (x%StC_x(4,i_pt) < 0) ) THEN - C_Brake(2,i_pt) = p%StC_Y_C_BRAKE - ELSE - C_Brake(2,i_pt) = 0 - END IF - - - ! Z - IF (dxdt%StC_x(5,i_pt) * rdot_P(3,i_pt) <= 0 ) THEN - C_ctrl(3,i_pt) = p%StC_Z_C_HIGH - ELSE - C_ctrl(3,i_pt) = p%StC_Z_C_LOW - END IF - - !Brake Z - IF ( (x%StC_x(5,i_pt) > p%P_SP(3)-0.2) .AND. (x%StC_x(6,i_pt) > 0) ) THEN - C_Brake(3,i_pt) = p%StC_Z_C_BRAKE - ELSE IF ( (x%StC_x(5,i_pt) < p%N_SP(3)+0.2) .AND. (x%StC_x(6,i_pt) < 0) ) THEN - C_Brake(3,i_pt) = p%StC_Z_C_BRAKE - ELSE - C_Brake(3,i_pt) = 0 - END IF - - ELSE IF (p%StC_CMODE == CMODE_Semi .AND. p%StC_SA_MODE == SA_CMODE_GH_invVel) THEN ! Inverse velocity-based ground hook control with high damping for braking - - ! X - IF (dxdt%StC_x(1,i_pt) * rdot_P(1,i_pt) >= 0 ) THEN - C_ctrl(1,i_pt) = p%StC_X_C_HIGH - ELSE - C_ctrl(1,i_pt) = p%StC_X_C_LOW - END IF - - !Brake X - IF ( (x%StC_x(1,i_pt) > p%P_SP(1)-0.2) .AND. (x%StC_x(2,i_pt) > 0) ) THEN - C_Brake(1,i_pt) = p%StC_X_C_BRAKE - ELSE IF ( (x%StC_x(1,i_pt) < p%N_SP(1)+0.2) .AND. (x%StC_x(2,i_pt) < 0) ) THEN - C_Brake(1,i_pt) = p%StC_X_C_BRAKE - ELSE - C_Brake(1,i_pt) = 0 - END IF - - ! Y - IF (dxdt%StC_x(3,i_pt) * rdot_P(2,i_pt) >= 0 ) THEN - C_ctrl(2,i_pt) = p%StC_Y_C_HIGH - ELSE - C_ctrl(2,i_pt) = p%StC_Y_C_LOW - END IF - - !Brake Y - IF ( (x%StC_x(3,i_pt) > p%P_SP(2)-0.2) .AND. (x%StC_x(4,i_pt) > 0) ) THEN - C_Brake(2,i_pt) = p%StC_Y_C_BRAKE - ELSE IF ( (x%StC_x(3,i_pt) < p%N_SP(2)+0.2) .AND. (x%StC_x(4,i_pt) < 0) ) THEN - C_Brake(2,i_pt) = p%StC_Y_C_BRAKE - ELSE - C_Brake(2,i_pt) = 0 - END IF - - ! Z - IF (dxdt%StC_x(5,i_pt) * rdot_P(3,i_pt) >= 0 ) THEN - C_ctrl(3,i_pt) = p%StC_Z_C_HIGH - ELSE - C_ctrl(3,i_pt) = p%StC_Z_C_LOW - END IF - - !Brake Z - IF ( (x%StC_x(5,i_pt) > p%P_SP(3)-0.2) .AND. (x%StC_x(6,i_pt) > 0) ) THEN - C_Brake(3,i_pt) = p%StC_Z_C_BRAKE - ELSE IF ( (x%StC_x(5,i_pt) < p%N_SP(3)+0.2) .AND. (x%StC_x(6,i_pt) < 0) ) THEN - C_Brake(3,i_pt) = p%StC_Z_C_BRAKE - ELSE - C_Brake(3,i_pt) = 0 - END IF - - ELSE IF (p%StC_CMODE == CMODE_Semi .AND. p%StC_SA_MODE == SA_CMODE_GH_disp) THEN ! displacement-based ground hook control with high damping for braking - - ! X - IF (dxdt%StC_x(1,i_pt) * rdisp_P(1,i_pt) <= 0 ) THEN - C_ctrl(1,i_pt) = p%StC_X_C_HIGH - ELSE - C_ctrl(1,i_pt) = p%StC_X_C_LOW - END IF - - !Brake X - IF ( (x%StC_x(1,i_pt) > p%P_SP(1)-0.2) .AND. (x%StC_x(2,i_pt) > 0) ) THEN - C_Brake(1,i_pt) = p%StC_X_C_BRAKE - ELSE IF ( (x%StC_x(1,i_pt) < p%N_SP(1)+0.2) .AND. (x%StC_x(2,i_pt) < 0) ) THEN - C_Brake(1,i_pt) = p%StC_X_C_BRAKE - ELSE - C_Brake(1,i_pt) = 0 - END IF - - ! Y - IF (dxdt%StC_x(3,i_pt) * rdisp_P(2,i_pt) <= 0 ) THEN - C_ctrl(2,i_pt) = p%StC_Y_C_HIGH - ELSE - C_ctrl(2,i_pt) = p%StC_Y_C_LOW - END IF - - !Brake Y - IF ( (x%StC_x(3,i_pt) > p%P_SP(2)-0.2) .AND. (x%StC_x(4,i_pt) > 0) ) THEN - C_Brake(2,i_pt) = p%StC_Y_C_BRAKE - ELSE IF ( (x%StC_x(3,i_pt) < p%N_SP(2)+0.2) .AND. (x%StC_x(4,i_pt) < 0) ) THEN - C_Brake(2,i_pt) = p%StC_Y_C_BRAKE - ELSE - C_Brake(2,i_pt) = 0 - END IF - - ! Z - IF (dxdt%StC_x(5,i_pt) * rdisp_P(3,i_pt) <= 0 ) THEN - C_ctrl(3,i_pt) = p%StC_Z_C_HIGH - ELSE - C_ctrl(3,i_pt) = p%StC_Z_C_LOW - END IF - - !Brake Z - IF ( (x%StC_x(5,i_pt) > p%P_SP(3)-0.2) .AND. (x%StC_x(6,i_pt) > 0) ) THEN - C_Brake(3,i_pt) = p%StC_Z_C_BRAKE - ELSE IF ( (x%StC_x(3,i_pt) < p%N_SP(3)+0.2) .AND. (x%StC_x(6,i_pt) < 0) ) THEN - C_Brake(3,i_pt) = p%StC_Z_C_BRAKE - ELSE - C_Brake(3,i_pt) = 0 - END IF - - ELSE IF (p%StC_CMODE == CMODE_Semi .AND. p%StC_SA_MODE == SA_CMODE_Ph_FF) THEN ! Phase Difference Algorithm with Friction Force - ! X - ! (a) - IF (rdisp_P(1,i_pt) > 0 .AND. rdot_P(1,i_pt) < 0 .AND. x%StC_x(1,i_pt) > 0 .AND. dxdt%StC_x(1,i_pt) < 0) THEN - F_fr(1,i_pt) = p%StC_X_C_HIGH - ! (b) - ELSE IF (rdisp_P(1,i_pt) < 0 .AND. rdot_P(1,i_pt) > 0 .AND. x%StC_x(1,i_pt) < 0 .AND. dxdt%StC_x(1,i_pt) > 0) THEN - F_fr(1,i_pt) = -p%StC_X_C_HIGH - ! (c) - ELSE IF (rdisp_P(1,i_pt) < 0 .AND. rdot_P(1,i_pt) < 0 .AND. x%StC_x(1,i_pt) > 0 .AND. dxdt%StC_x(1,i_pt) > 0) THEN - F_fr(1,i_pt) = -p%StC_X_C_HIGH - ELSE IF (rdisp_P(1,i_pt) > 0 .AND. rdot_P(1,i_pt) > 0 .AND. x%StC_x(1,i_pt) < 0 .AND. dxdt%StC_x(1,i_pt) < 0) THEN - F_fr(1,i_pt) = p%StC_X_C_HIGH - ELSE - F_fr(1,i_pt) = p%StC_X_C_LOW - END IF - - !Brake X - IF ( (x%StC_x(1,i_pt) > p%P_SP(1)-0.2) .AND. (x%StC_x(2,i_pt) > 0) ) THEN - C_Brake(1,i_pt) = p%StC_X_C_BRAKE - ELSE IF ( (x%StC_x(1,i_pt) < p%N_SP(1)+0.2) .AND. (x%StC_x(2,i_pt) < 0) ) THEN - C_Brake(1,i_pt) = p%StC_X_C_BRAKE - ELSE - C_Brake(1,i_pt) = 0 - END IF - - ! Y - ! (a) - IF (rdisp_P(2,i_pt) > 0 .AND. rdot_P(2,i_pt) < 0 .AND. x%StC_x(3,i_pt) > 0 .AND. dxdt%StC_x(3,i_pt) < 0) THEN - F_fr(2,i_pt) = p%StC_Y_C_HIGH - ! (b) - ELSE IF (rdisp_P(2,i_pt) < 0 .AND. rdot_P(2,i_pt) > 0 .AND. x%StC_x(3,i_pt) < 0 .AND. dxdt%StC_x(3,i_pt) > 0) THEN - F_fr(2,i_pt) = -p%StC_Y_C_HIGH - ! (c) - ELSE IF (rdisp_P(2,i_pt) < 0 .AND. rdot_P(2,i_pt) < 0 .AND. x%StC_x(3,i_pt) > 0 .AND. dxdt%StC_x(3,i_pt) > 0) THEN - F_fr(2,i_pt) = -p%StC_Y_C_HIGH - ELSE IF (rdisp_P(2,i_pt) > 0 .AND. rdot_P(2,i_pt) > 0 .AND. x%StC_x(3,i_pt) < 0 .AND. dxdt%StC_x(3,i_pt) < 0) THEN - F_fr(2,i_pt) = p%StC_Y_C_HIGH - ELSE - F_fr(2,i_pt) = p%StC_Y_C_LOW - END IF - - !Brake Y - IF ( (x%StC_x(3,i_pt) > p%P_SP(2)-0.2) .AND. (x%StC_x(4,i_pt) > 0) ) THEN - C_Brake(2,i_pt) = p%StC_Y_C_BRAKE - ELSE IF ( (x%StC_x(3,i_pt) < p%N_SP(2)+0.2) .AND. (x%StC_x(4,i_pt) < 0) ) THEN - C_Brake(2,i_pt) = p%StC_Y_C_BRAKE - ELSE - C_Brake(2,i_pt) = 0 - END IF - - ! Z - ! (a) - IF (rdisp_P(3,i_pt) > 0 .AND. rdot_P(3,i_pt) < 0 .AND. x%StC_x(5,i_pt) > 0 .AND. dxdt%StC_x(5,i_pt) < 0) THEN - F_fr(3,i_pt) = p%StC_Z_C_HIGH - ! (b) - ELSE IF (rdisp_P(3,i_pt) < 0 .AND. rdot_P(3,i_pt) > 0 .AND. x%StC_x(5,i_pt) < 0 .AND. dxdt%StC_x(5,i_pt) > 0) THEN - F_fr(3,i_pt) = -p%StC_Z_C_HIGH - ! (c) - ELSE IF (rdisp_P(3,i_pt) < 0 .AND. rdot_P(3,i_pt) < 0 .AND. x%StC_x(5,i_pt) > 0 .AND. dxdt%StC_x(5,i_pt) > 0) THEN - F_fr(3,i_pt) = -p%StC_Z_C_HIGH - ELSE IF (rdisp_P(3,i_pt) > 0 .AND. rdot_P(3,i_pt) > 0 .AND. x%StC_x(5,i_pt) < 0 .AND. dxdt%StC_x(5,i_pt) < 0) THEN - F_fr(3,i_pt) = p%StC_Z_C_HIGH - ELSE - F_fr(3,i_pt) = p%StC_Z_C_LOW - END IF - - !Brake Z - IF ( (x%StC_x(5,i_pt) > p%P_SP(3)-0.2) .AND. (x%StC_x(6,i_pt) > 0) ) THEN - C_Brake(3,i_pt) = p%StC_Z_C_BRAKE - ELSE IF ( (x%StC_x(5,i_pt) < p%N_SP(3)+0.2) .AND. (x%StC_x(6,i_pt) < 0) ) THEN - C_Brake(3,i_pt) = p%StC_Z_C_BRAKE - ELSE - C_Brake(3,i_pt) = 0 - END IF - - ELSE IF (p%StC_CMODE == CMODE_Semi .AND. p%StC_SA_MODE == SA_CMODE_Ph_DF) THEN ! Phase Difference Algorithm with Damping On/Off - ! X - ! (a) - IF (rdisp_P(1,i_pt) > 0 .AND. rdot_P(1,i_pt) < 0 .AND. x%StC_x(1,i_pt) > 0 .AND. dxdt%StC_x(1,i_pt) < 0) THEN - C_ctrl(1,i_pt) = p%StC_X_C_HIGH - ! (b) - ELSE IF (rdisp_P(1,i_pt) < 0 .AND. rdot_P(1,i_pt) > 0 .AND. x%StC_x(1,i_pt) < 0 .AND. dxdt%StC_x(1,i_pt) > 0) THEN - C_ctrl(1,i_pt) = p%StC_X_C_HIGH - ! (c) - ELSE IF (rdisp_P(1,i_pt) < 0 .AND. rdot_P(1,i_pt) < 0 .AND. x%StC_x(1,i_pt) > 0 .AND. dxdt%StC_x(1,i_pt) > 0) THEN - C_ctrl(1,i_pt) = p%StC_X_C_HIGH - ELSE IF (rdisp_P(1,i_pt) > 0 .AND. rdot_P(1,i_pt) > 0 .AND. x%StC_x(1,i_pt) < 0 .AND. dxdt%StC_x(1,i_pt) < 0) THEN - C_ctrl(1,i_pt) = p%StC_X_C_HIGH - ELSE - C_ctrl(1,i_pt) = p%StC_X_C_LOW - END IF - - !Brake X - IF ( (x%StC_x(1,i_pt) > p%P_SP(1)-0.2) .AND. (x%StC_x(2,i_pt) > 0) ) THEN - C_Brake(1,i_pt) = p%StC_X_C_BRAKE - ELSE IF ( (x%StC_x(1,i_pt) < p%N_SP(1)+0.2) .AND. (x%StC_x(2,i_pt) < 0) ) THEN - C_Brake(1,i_pt) = p%StC_X_C_BRAKE - ELSE - C_Brake(1,i_pt) = 0 - END IF - - ! Y - ! (a) - IF (rdisp_P(2,i_pt) > 0 .AND. rdot_P(2,i_pt) < 0 .AND. x%StC_x(3,i_pt) > 0 .AND. dxdt%StC_x(3,i_pt) < 0) THEN - C_ctrl(2,i_pt) = p%StC_Y_C_HIGH - ! (b) - ELSE IF (rdisp_P(2,i_pt) < 0 .AND. rdot_P(2,i_pt) > 0 .AND. x%StC_x(3,i_pt) < 0 .AND. dxdt%StC_x(3,i_pt) > 0) THEN - C_ctrl(2,i_pt) = p%StC_Y_C_HIGH - ! (c) - ELSE IF (rdisp_P(2,i_pt) < 0 .AND. rdot_P(2,i_pt) < 0 .AND. x%StC_x(3,i_pt) > 0 .AND. dxdt%StC_x(3,i_pt) > 0) THEN - C_ctrl(2,i_pt) = p%StC_Y_C_HIGH - ELSE IF (rdisp_P(2,i_pt) > 0 .AND. rdot_P(2,i_pt) > 0 .AND. x%StC_x(3,i_pt) < 0 .AND. dxdt%StC_x(3,i_pt) < 0) THEN - C_ctrl(2,i_pt) = p%StC_Y_C_HIGH - ELSE - C_ctrl(2,i_pt) = p%StC_Y_C_LOW - END IF - - !Brake Y - IF ( (x%StC_x(3,i_pt) > p%P_SP(2)-0.2) .AND. (x%StC_x(4,i_pt) > 0) ) THEN - C_Brake(2,i_pt) = p%StC_Y_C_BRAKE - ELSE IF ( (x%StC_x(3,i_pt) < p%N_SP(2)+0.2) .AND. (x%StC_x(4,i_pt) < 0) ) THEN - C_Brake(2,i_pt) = p%StC_Y_C_BRAKE - ELSE - C_Brake(2,i_pt) = 0 - END IF - - ! Z - ! (a) - IF (rdisp_P(3,i_pt) > 0 .AND. rdot_P(3,i_pt) < 0 .AND. x%StC_x(5,i_pt) > 0 .AND. dxdt%StC_x(5,i_pt) < 0) THEN - C_ctrl(3,i_pt) = p%StC_Z_C_HIGH - ! (b) - ELSE IF (rdisp_P(3,i_pt) < 0 .AND. rdot_P(3,i_pt) > 0 .AND. x%StC_x(5,i_pt) < 0 .AND. dxdt%StC_x(5,i_pt) > 0) THEN - C_ctrl(3,i_pt) = p%StC_Z_C_HIGH - ! (c) - ELSE IF (rdisp_P(3,i_pt) < 0 .AND. rdot_P(3,i_pt) < 0 .AND. x%StC_x(5,i_pt) > 0 .AND. dxdt%StC_x(5,i_pt) > 0) THEN - C_ctrl(3,i_pt) = p%StC_Z_C_HIGH - ELSE IF (rdisp_P(3,i_pt) > 0 .AND. rdot_P(3,i_pt) > 0 .AND. x%StC_x(5,i_pt) < 0 .AND. dxdt%StC_x(5,i_pt) < 0) THEN - C_ctrl(3,i_pt) = p%StC_Z_C_HIGH - ELSE - C_ctrl(3,i_pt) = p%StC_Z_C_LOW - END IF - - !Brake Z - IF ( (x%StC_x(5,i_pt) > p%P_SP(3)-0.2) .AND. (x%StC_x(6,i_pt) > 0) ) THEN - C_Brake(3,i_pt) = p%StC_Z_C_BRAKE - ELSE IF ( (x%StC_x(5,i_pt) < p%N_SP(3)+0.2) .AND. (x%StC_x(6,i_pt) < 0) ) THEN - C_Brake(3,i_pt) = p%StC_Z_C_BRAKE - ELSE - C_Brake(3,i_pt) = 0 - END IF - - END IF - enddo - - -END SUBROUTINE StC_GroundHookDamp -!---------------------------------------------------------------------------------------------------------------------------------- -!> Extrapolate or interpolate stiffness value based on stiffness table. -SUBROUTINE SpringForceExtrapInterp(x, p, F_table,ErrStat,ErrMsg) - TYPE(StC_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(StC_ParameterType), INTENT(IN) :: p !< The module's parameter data - REAL(ReKi), dimension(:,:), INTENT(INOUT) :: F_table !< extrapolated/interpolated stiffness values - - INTEGER(IntKi), INTENT(OUT) :: ErrStat ! The error status code - CHARACTER(*), INTENT(OUT) :: ErrMsg ! The error message, if an error occurred - - ! local variables - INTEGER(IntKi) :: ErrStat2 ! error status - INTEGER(IntKi) :: I ! Loop counter - INTEGER(IntKi), DIMENSION(3) :: J = (/1, 3, 5/) ! Index to StC_x for TMD displacement in each dimension - INTEGER(IntKi) :: M ! location of closest table position - INTEGER(IntKi) :: Nrows ! Number of rows in F_TBL - REAL(ReKi) :: Slope ! - REAL(ReKi) :: DX ! - REAL(ReKi) :: Disp(3) ! Current displacement - REAL(ReKi), ALLOCATABLE :: TmpRAry(:) - INTEGER(IntKi) :: i_pt !< generic counter for mesh point - - ErrStat = ErrID_None - ErrMsg = '' - - Nrows = SIZE(p%F_TBL,1) - ALLOCATE(TmpRAry(Nrows),STAT=ErrStat2) - - do i_pt=1,p%NumMeshPts - - IF (p%StC_DOF_MODE == DOFMode_Indept .OR. p%StC_DOF_MODE == DOFMode_Omni) THEN - IF (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal,'Error allocating temp array.',ErrStat,ErrMsg,'SpringForceExtrapInterp') - RETURN - END IF - - IF (p%StC_DOF_MODE == DOFMode_Indept) THEN - DO I = 1,3 - Disp(I) = x%StC_x(J(I),i_pt) - END DO - ELSE !IF (p%StC_DOF_MODE == DOFMode_Omni) THEN ! Only X and Y - Disp = SQRT(x%StC_x(1,i_pt)**2+x%StC_x(3,i_pt)**2) ! constant assignment to vector - END IF - - - DO I = 1,3 - TmpRAry = p%F_TBL(:,J(I))-Disp(I) - TmpRAry = ABS(TmpRAry) - M = MINLOC(TmpRAry,1) - - !interpolate - IF ( (Disp(I) > p%F_TBL(M,J(I)) .AND. M /= Nrows) .OR. (Disp(I) < p%F_TBL(M,J(I)) .AND. M == 1) ) THEN - ! for displacements higher than the closest table value or lower than the lower bound - Slope = ( p%F_TBL(M+1,J(I)+1) - p%F_TBL(M,J(I)+1) ) / ( p%F_TBL(M+1,J(I)) - p%F_TBL(M,J(I)) ) - - ELSE IF ( (Disp(I) < p%F_TBL(M,J(I)) .AND. M /= 1 ) .OR. (Disp(I) > p%F_TBL(M,J(I)) .AND. M == Nrows) ) THEN ! lower - ! for displacements lower than the closest table value or higher than the upper bound - Slope = ( p%F_TBL(M,J(I)+1) - p%F_TBL(M-1,J(I)+1) ) / ( p%F_TBL(M,J(I)) - p%F_TBL(M-1,J(I)) ) - - ELSE ! equal - Slope = 0 - END IF - - F_table(I,i_pt) = p%F_TBL(M,J(I)+1) + Slope * ( Disp(I) - p%F_TBL(M,J(I)) ) - - END DO - - END IF - enddo ! Loop over p%NumMeshPts - - DEALLOCATE(TmpRAry) - -END SUBROUTINE SpringForceExtrapInterp -!---------------------------------------------------------------------------------------------------------------------------------- -!> Parse the inputfile info stored in FileInfo_In. -SUBROUTINE StC_ParseInputFileInfo( PriPath, InputFile, RootName, FileInfo_In, InputFileData, UnEcho, ErrStat, ErrMsg ) - - implicit none - - ! Passed variables - character(*), intent(in ) :: PriPath !< primary path - CHARACTER(*), intent(in ) :: InputFile !< Name of the file containing the primary input data - CHARACTER(*), intent(in ) :: RootName !< The rootname of the echo file, possibly opened in this routine - type(StC_InputFile), intent(inout) :: InputFileData !< All the data in the StrucCtrl input file - type(FileInfoType), intent(in ) :: FileInfo_In !< The derived type for holding the file information. - integer(IntKi), intent( out) :: UnEcho !< The local unit number for this module's echo file - integer(IntKi), intent( out) :: ErrStat !< Error status - CHARACTER(ErrMsgLen), intent( out) :: ErrMsg !< Error message - - ! Local variables: - integer(IntKi) :: i !< generic counter - integer(IntKi) :: ErrStat2 !< Temporary Error status - character(ErrMsgLen) :: ErrMsg2 !< Temporary Error message - integer(IntKi) :: CurLine !< current entry in FileInfo_In%Lines array - real(ReKi) :: TmpRe6(6) !< temporary 6 number array for reading values in - - - ! Initialization - ErrStat = 0 - ErrMsg = "" - UnEcho = -1 ! Echo file unit. >0 when used - - - !------------------------------------------------------------------------------------------------- - ! General settings - !------------------------------------------------------------------------------------------------- - - CurLine = 4 ! Skip the first three lines as they are known to be header lines and separators - call ParseVar( FileInfo_In, CurLine, 'Echo', InputFileData%Echo, ErrStat2, ErrMsg2 ) - if (Failed()) return; - - if ( InputFileData%Echo ) then - CALL OpenEcho ( UnEcho, TRIM(RootName)//'.ech', ErrStat2, ErrMsg2 ) - if (Failed()) return; - WRITE(UnEcho, '(A)') 'Echo file for StructCtrl input file: '//trim(InputFile) - ! Write the first three lines into the echo file - WRITE(UnEcho, '(A)') FileInfo_In%Lines(1) - WRITE(UnEcho, '(A)') FileInfo_In%Lines(2) - WRITE(UnEcho, '(A)') FileInfo_In%Lines(3) - - CurLine = 4 - call ParseVar( FileInfo_In, CurLine, 'Echo', InputFileData%Echo, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return - endif - - !------------------------------------------------------------------------------------------------- - ! StC DEGREES OF FREEDOM - !------------------------------------------------------------------------------------------------- - - ! Section break - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - - ! DOF mode (switch) { 0: No StC or TLCD DOF; - ! 1: StC_X_DOF, StC_Y_DOF, and/or StC_Z_DOF (three independent StC DOFs); - ! 2: StC_XY_DOF (Omni-Directional StC); - ! 3: TLCD; - ! 4: Prescribed force/moment time series} - call ParseVar( FileInfo_In, Curline, 'StC_DOF_MODE', InputFileData%StC_DOF_MODE, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! DOF on or off for StC X (flag) [Used only when StC_DOF_MODE=1] - call ParseVar( FileInfo_In, Curline, 'StC_X_DOF', InputFileData%StC_X_DOF, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! DOF on or off for StC Y (flag) [Used only when StC_DOF_MODE=1] - call ParseVar( FileInfo_In, Curline, 'StC_Y_DOF', InputFileData%StC_Y_DOF, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! DOF on or off for StC Z (flag) [Used only when StC_DOF_MODE=1] - call ParseVar( FileInfo_In, Curline, 'StC_Z_DOF', InputFileData%StC_Z_DOF, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - - - !------------------------------------------------------------------------------------------------- - ! StC LOCATION [relative to the reference origin of component attached to] - !------------------------------------------------------------------------------------------------- - - ! Section break - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - - ! At rest X position of StC(s) (m) [relative to reference origin of the component] - call ParseVar( FileInfo_In, Curline, 'StC_P_X', InputFileData%StC_P_X, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! At rest Y position of StC(s) (m) [relative to reference origin of the component] - call ParseVar( FileInfo_In, Curline, 'StC_P_Y', InputFileData%StC_P_Y, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! At rest Z position of StC(s) (m) [relative to reference origin of the component] - call ParseVar( FileInfo_In, Curline, 'StC_P_Z', InputFileData%StC_P_Z, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - - !------------------------------------------------------------------------------------------------- - ! StC INITIAL CONDITIONS [used only when StC_DOF_MODE=1 or 2] - !------------------------------------------------------------------------------------------------- - - ! Section break - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - - ! StC X initial displacement (m) [relative to at rest position] - call ParseVar( FileInfo_In, Curline, 'StC_X_DSP', InputFileData%StC_X_DSP, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! StC Y initial displacement (m) [relative to at rest position] - call ParseVar( FileInfo_In, Curline, 'StC_Y_DSP', InputFileData%StC_Y_DSP, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! StC Z initial displacement (m) [relative to at rest position; used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] - call ParseVar( FileInfo_In, Curline, 'StC_Z_DSP', InputFileData%StC_Z_DSP, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - - !------------------------------------------------------------------------------------------------- - ! StC CONFIGURATION [used only when StC_DOF_MODE=1 or 2] - !------------------------------------------------------------------------------------------------- - - ! Section break - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - - ! Positive stop position (maximum X mass displacement) (m) - call ParseVar( FileInfo_In, Curline, 'StC_X_PSP', InputFileData%StC_X_PSP, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! Negative stop position (minimum X mass displacement) (m) - call ParseVar( FileInfo_In, Curline, 'StC_X_NSP', InputFileData%StC_X_NSP, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! Positive stop position (maximum Y mass displacement) (m) - call ParseVar( FileInfo_In, Curline, 'StC_Y_PSP', InputFileData%StC_Y_PSP, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! Negative stop position (minimum Y mass displacement) (m) - call ParseVar( FileInfo_In, Curline, 'StC_Y_NSP', InputFileData%StC_Y_NSP, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! Positive stop position (maximum Z mass displacement) (m) [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] - call ParseVar( FileInfo_In, Curline, 'StC_Z_PSP', InputFileData%StC_Z_PSP, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! Negative stop position (minimum Z mass displacement) (m) [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] - call ParseVar( FileInfo_In, Curline, 'StC_Z_NSP', InputFileData%StC_Z_NSP, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - - !------------------------------------------------------------------------------------------------- - ! StC MASS, STIFFNESS, & DAMPING [used only when StC_DOF_MODE=1 or 2] - !------------------------------------------------------------------------------------------------- - - ! Section break - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - - ! StC X mass (kg) [must equal StC_Y_M for StC_DOF_MODE = 2] - call ParseVar( FileInfo_In, Curline, 'StC_X_M', InputFileData%StC_X_M, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! StC Y mass (kg) [must equal StC_X_M for StC_DOF_MODE = 2] - call ParseVar( FileInfo_In, Curline, 'StC_Y_M', InputFileData%StC_Y_M, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! StC Z mass (kg) [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] - call ParseVar( FileInfo_In, Curline, 'StC_Z_M', InputFileData%StC_Z_M, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! StC Z mass (kg) [used only when StC_DOF_MODE=2] - call ParseVar( FileInfo_In, Curline, 'StC_XY_M', InputFileData%StC_XY_M, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! StC X stiffness (N/m) - call ParseVar( FileInfo_In, Curline, 'StC_X_K', InputFileData%StC_X_K, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! StC Y stiffness (N/m) - call ParseVar( FileInfo_In, Curline, 'StC_Y_K', InputFileData%StC_Y_K, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! StC Z stiffness (N/m) [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] - call ParseVar( FileInfo_In, Curline, 'StC_Z_K', InputFileData%StC_Z_K, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! StC X damping (N/(m/s)) - call ParseVar( FileInfo_In, Curline, 'StC_X_C', InputFileData%StC_X_C, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! StC Y damping (N/(m/s)) - call ParseVar( FileInfo_In, Curline, 'StC_Y_C', InputFileData%StC_Y_C, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! StC Z damping (N/(m/s)) [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] - call ParseVar( FileInfo_In, Curline, 'StC_Z_C', InputFileData%StC_Z_C, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! Stop spring X stiffness (N/m) - call ParseVar( FileInfo_In, Curline, 'StC_X_KS', InputFileData%StC_X_KS, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! Stop spring Y stiffness (N/m) - call ParseVar( FileInfo_In, Curline, 'StC_Y_KS', InputFileData%StC_Y_KS, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! Stop spring Z stiffness (N/m) [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] - call ParseVar( FileInfo_In, Curline, 'StC_Z_KS', InputFileData%StC_Z_KS, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! Stop spring X damping (N/(m/s)) - call ParseVar( FileInfo_In, Curline, 'StC_X_CS', InputFileData%StC_X_CS, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! Stop spring Y damping (N/(m/s)) - call ParseVar( FileInfo_In, Curline, 'StC_Y_CS', InputFileData%StC_Y_CS, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - ! Stop spring Z damping (N/(m/s)) [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] - call ParseVar( FileInfo_In, Curline, 'StC_Z_CS', InputFileData%StC_Z_CS, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - - !------------------------------------------------------------------------------------------------- - ! StC USER-DEFINED SPRING FORCES [used only when StC_DOF_MODE=1 or 2] - !------------------------------------------------------------------------------------------------- - - ! Section break - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - - ! Use spring force from user-defined table (flag) - call ParseVar( FileInfo_In, Curline, 'Use_F_TBL', InputFileData%Use_F_TBL, ErrStat2, ErrMsg2, UnEcho ) - If (Failed()) return; - - ! NKInpSt - Number of spring force input stations - call ParseVar( FileInfo_In, CurLine, 'NKInpSt', InputFileData%NKInpSt, ErrStat2, ErrMsg2, UnEcho) - if (Failed()) return - - ! Section break -- X K_X Y K_Y Z K_Z - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') '#TABLE: '//FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') ' Table Header: '//FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') ' Table Units: '//FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - - if (InputFileData%NKInpSt > 0) then - CALL AllocAry( InputFileData%F_TBL, InputFileData%NKInpSt, 6, 'F_TBL', ErrStat2, ErrMsg2 ) - if (Failed()) return; - ! TABLE read - do i=1,InputFileData%NKInpSt - call ParseAry ( FileInfo_In, CurLine, 'Coordinates', TmpRe6, 6, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%F_TBL(i,1) = TmpRe6(1) ! X - InputFileData%F_TBL(i,2) = TmpRe6(2) ! K_X - InputFileData%F_TBL(i,3) = TmpRe6(3) ! Y - InputFileData%F_TBL(i,4) = TmpRe6(4) ! K_Y - InputFileData%F_TBL(i,5) = TmpRe6(5) ! Z - InputFileData%F_TBL(i,6) = TmpRe6(6) ! K_Z - enddo - endif - - - !------------------------------------------------------------------------------------------------- - ! StructCtrl CONTROL [used only when StC_DOF_MODE=1 or 2] - !------------------------------------------------------------------------------------------------- - - ! Section break - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - - ! Control mode (switch) {0:none; 1: Semi-Active Control Mode; 2: Active Control Mode} - call ParseVar( FileInfo_In, Curline, 'StC_CMODE', InputFileData%StC_CMODE, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! Semi-Active control mode { - ! 1: velocity-based ground hook control; - ! 2: Inverse velocity-based ground hook control; - ! 3: displacement-based ground hook control; - ! 4: Phase difference Algorithm with Friction Force; - ! 5: Phase difference Algorithm with Damping Force} (-) - call ParseVar( FileInfo_In, Curline, 'StC_SA_MODE', InputFileData%StC_SA_MODE, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! StC X high damping for ground hook control - call ParseVar( FileInfo_In, Curline, 'StC_X_C_HIGH', InputFileData%StC_X_C_HIGH, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! StC X low damping for ground hook control - call ParseVar( FileInfo_In, Curline, 'StC_X_C_LOW', InputFileData%StC_X_C_LOW, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! StC Y high damping for ground hook control - call ParseVar( FileInfo_In, Curline, 'StC_Y_C_HIGH', InputFileData%StC_Y_C_HIGH, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! StC Y low damping for ground hook control - call ParseVar( FileInfo_In, Curline, 'StC_Y_C_LOW', InputFileData%StC_Y_C_LOW, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! StC Z high damping for ground hook control [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] - call ParseVar( FileInfo_In, Curline, 'StC_Z_C_HIGH', InputFileData%StC_Z_C_HIGH, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! StC Z low damping for ground hook control [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] - call ParseVar( FileInfo_In, Curline, 'StC_Z_C_LOW', InputFileData%StC_Z_C_LOW, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! StC X high damping for braking the StC (Don't use it now. should be zero) - call ParseVar( FileInfo_In, Curline, 'StC_X_C_BRAKE', InputFileData%StC_X_C_BRAKE, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! StC Y high damping for braking the StC (Don't use it now. should be zero) - call ParseVar( FileInfo_In, Curline, 'StC_Y_C_BRAKE', InputFileData%StC_Y_C_BRAKE, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! StC Z high damping for braking the StC (Don't use it now. should be zero) [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] - call ParseVar( FileInfo_In, Curline, 'StC_Z_C_BRAKE', InputFileData%StC_Z_C_BRAKE, ErrStat2, ErrMsg2 ) - If (Failed()) return; - - !------------------------------------------------------------------------------------------------- - ! TLCD [used only when StC_DOF_MODE=3] - !------------------------------------------------------------------------------------------------- - - ! Section break - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - - ! X TLCD total length (m) - call ParseVar( FileInfo_In, Curline, 'L_X', InputFileData%L_X, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! X TLCD horizontal length (m) - call ParseVar( FileInfo_In, Curline, 'B_X', InputFileData%B_X, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! X TLCD cross-sectional area of vertical column (m^2) - call ParseVar( FileInfo_In, Curline, 'area_X', InputFileData%area_X, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! X TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) (-) - call ParseVar( FileInfo_In, Curline, 'area_ratio_X', InputFileData%area_ratio_X, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! X TLCD head loss coeff (-) - call ParseVar( FileInfo_In, Curline, 'headLossCoeff_X', InputFileData%headLossCoeff_X, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! X TLCD liquid density (kg/m^3) - call ParseVar( FileInfo_In, Curline, 'rho_X', InputFileData%rho_X, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! Y TLCD total length (m) - call ParseVar( FileInfo_In, Curline, 'L_Y', InputFileData%L_Y, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! Y TLCD horizontal length (m) - call ParseVar( FileInfo_In, Curline, 'B_Y', InputFileData%B_Y, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! Y TLCD cross-sectional area of vertical column (m^2) - call ParseVar( FileInfo_In, Curline, 'area_Y', InputFileData%area_Y, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! Y TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) (-) - call ParseVar( FileInfo_In, Curline, 'area_ratio_Y', InputFileData%area_ratio_Y, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! Y TLCD head loss coeff (-) - call ParseVar( FileInfo_In, Curline, 'headLossCoeff_Y', InputFileData%headLossCoeff_Y, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! Y TLCD liquid density (kg/m^3) - call ParseVar( FileInfo_In, Curline, 'rho_Y', InputFileData%rho_Y, ErrStat2, ErrMsg2 ) - If (Failed()) return; - - !------------------------------------------------------------------------------------------------- - ! PRESCRIBED TIME SERIES [used only when StC_DOF_MODE=4] - !------------------------------------------------------------------------------------------------- - - ! Section break - if ( InputFileData%Echo ) WRITE(UnEcho, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - - ! Prescribed forces coordinate system - call ParseVar( FileInfo_In, Curline, 'PrescribedForcesCoordSys', InputFileData%PrescribedForcesCoordSys, ErrStat2, ErrMsg2 ) - If (Failed()) return; - ! Prescribed input time series - call ParseVar( FileInfo_In, Curline, 'PrescribedForcesFile', InputFileData%PrescribedForcesFile, ErrStat2, ErrMsg2 ) - if (Failed()) return; - if ( PathIsRelative( InputFileData%PrescribedForcesFile ) ) InputFileData%PrescribedForcesFile = TRIM(PriPath)//TRIM(InputFileData%PrescribedForcesFile) - - -CONTAINS - !------------------------------------------------------------------------------------------------- - logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'StC_ParseInputFileInfo' ) - Failed = ErrStat >= AbortErrLev - if (Failed) call Cleanup() - end function Failed - !------------------------------------------------------------------------------------------------- - SUBROUTINE Cleanup() - if (UnEcho > -1_IntKi) CLOSE( UnEcho ) - END SUBROUTINE Cleanup - !------------------------------------------------------------------------------------------------- -END SUBROUTINE StC_ParseInputFileInfo - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine checks the data handed in. If all is good, no errors reported. -subroutine StC_ValidatePrimaryData( InputFileData, InitInp, ErrStat, ErrMsg ) - TYPE(StC_InputFile), INTENT(IN) :: InputFileData !< Data stored in the module's input file - TYPE(StC_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine. - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< The error status code - CHARACTER(ErrMsgLen), INTENT( OUT) :: ErrMsg !< The error message, if an error occurred - - CHARACTER(*), PARAMETER :: RoutineName = 'StC_ValidatePrimaryData' - - ! Initialize variables - ErrStat = ErrID_None - ErrMsg = '' - - ! Check DOF modes - IF ( InputFileData%StC_DOF_MODE /= ControlMode_None .and. & - InputFileData%StC_DOF_MODE /= DOFMode_Indept .and. & - InputFileData%StC_DOF_MODE /= DOFMode_Omni .and. & - InputFileData%StC_DOF_MODE /= DOFMode_TLCD .and. & - InputFileData%StC_DOF_MODE /= DOFMode_Prescribed) & - CALL SetErrStat( ErrID_Fatal, 'DOF mode (StC_DOF_MODE) must be 0 (no DOF), 1 (two independent DOFs), or 2 (omni-directional), or 3 (TLCD), or 4 (prescribed force time-series).', ErrStat, ErrMsg, RoutineName ) - - ! Check control modes - IF ( InputFileData%StC_CMODE /= ControlMode_None .and. InputFileData%StC_CMODE /= CMODE_Semi ) & - CALL SetErrStat( ErrID_Fatal, 'Control mode (StC_CMode) must be 0 (none) or 1 (semi-active) in this version of StrucCtrl.', ErrStat, ErrMsg, RoutineName ) -! IF ( InputFileData%StC_CMODE /= ControlMode_None .and. InputFileData%StC_CMODE /= CMODE_Semi .and. InputFileData%StC_CMODE /= CMODE_Active) & -! CALL SetErrStat( ErrID_Fatal, 'Control mode (StC_CMode) must be 0 (none), 1 (semi-active), or 2 (active).', ErrStat, ErrMsg, RoutineName ) - - IF ( InputFileData%StC_SA_MODE /= SA_CMODE_GH_vel .and. & - InputFileData%StC_SA_MODE /= SA_CMODE_GH_invVel .and. & - InputFileData%StC_SA_MODE /= SA_CMODE_GH_disp .and. & - InputFileData%StC_SA_MODE /= SA_CMODE_Ph_FF .and. & - InputFileData%StC_SA_MODE /= SA_CMODE_Ph_DF ) then - CALL SetErrStat( ErrID_Fatal, 'Semi-active control mode (StC_SA_MODE) must be 1 (velocity-based ground hook control), '// & - '2 (inverse velocity-based ground hook control), 3 (displacement-based ground hook control), '// & - '4 (phase difference algorithm with friction force), or 5 (phase difference algorithm with damping force).', ErrStat, ErrMsg, RoutineName ) - END IF - - ! Prescribed forces - if (InputFileData%StC_DOF_MODE == DOFMode_Prescribed) then - if (InputFileData%PrescribedForcesCoordSys /= PRESCRIBED_FORCE_GLOBAL .and. InputFileData%PrescribedForcesCoordSys /= PRESCRIBED_FORCE_LOCAL) then - call SetErrStat( ErrID_Fatal, 'PrescribedForcesCoordSys must be '//trim(Num2LStr(PRESCRIBED_FORCE_GLOBAL))// & - ' (Global) or '//trim(Num2LStr(PRESCRIBED_FORCE_LOCAL))//' (local)', ErrStat, ErrMsg, RoutineName ) - endif - endif - - - ! Check masses make some kind of sense - if (InputFileData%StC_DOF_MODE == DOFMode_Indept .and. InputFileData%StC_X_DOF .and. (InputFileData%StC_X_M <= 0.0_ReKi) ) & - call SetErrStat(ErrID_Fatal,'StC_X_M must be > 0 when StC_X_DOF is enabled', ErrStat,ErrMsg,RoutineName) - if (InputFileData%StC_DOF_MODE == DOFMode_Indept .and. InputFileData%StC_X_DOF .and. (InputFileData%StC_X_K <= 0.0_ReKi) ) & - call SetErrStat(ErrID_Fatal,'StC_X_K must be > 0 when StC_X_DOF is enabled', ErrStat,ErrMsg,RoutineName) - - if (InputFileData%StC_DOF_MODE == DOFMode_Indept .and. InputFileData%StC_Y_DOF .and. (InputFileData%StC_Y_M <= 0.0_ReKi) ) & - call SetErrStat(ErrID_Fatal,'StC_Y_M must be > 0 when StC_Y_DOF is enabled', ErrStat,ErrMsg,RoutineName) - if (InputFileData%StC_DOF_MODE == DOFMode_Indept .and. InputFileData%StC_Y_DOF .and. (InputFileData%StC_Y_K <= 0.0_ReKi) ) & - call SetErrStat(ErrID_Fatal,'StC_Y_K must be > 0 when StC_Y_DOF is enabled', ErrStat,ErrMsg,RoutineName) - - if (InputFileData%StC_DOF_MODE == DOFMode_Omni .and. (InputFileData%StC_XY_M <= 0.0_ReKi) ) & - call SetErrStat(ErrID_Fatal,'StC_XY_M must be > 0 when DOF mode 2 (omni-directional) is used', ErrStat,ErrMsg,RoutineName) - if (InputFileData%StC_DOF_MODE == DOFMode_Omni .and. (InputFileData%StC_X_K <= 0.0_ReKi) ) & - call SetErrStat(ErrID_Fatal,'StC_X_K must be > 0 when DOF mode 2 (omni-directional) is used', ErrStat,ErrMsg,RoutineName) - if (InputFileData%StC_DOF_MODE == DOFMode_Omni .and. (InputFileData%StC_Y_K <= 0.0_ReKi) ) & - call SetErrStat(ErrID_Fatal,'StC_Y_K must be > 0 when DOF mode 2 (omni-directional) is used', ErrStat,ErrMsg,RoutineName) - - ! Sanity checks for the TLCD option -!FIXME: add some sanity checks here - -end subroutine StC_ValidatePrimaryData -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine sets the parameters, based on the data stored in InputFileData. -SUBROUTINE StC_SetParameters( InputFileData, InitInp, p, Interval, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(StC_InputFile), INTENT(IN ) :: InputFileData !< Data stored in the module's input file - TYPE(StC_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine. - TYPE(StC_ParameterType), INTENT(INOUT) :: p !< The module's parameter data - REAL(DbKi), INTENT(IN ) :: Interval !< Coupling interval in seconds: the rate that - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< The error status code - CHARACTER(ErrMsgLen), INTENT( OUT) :: ErrMsg !< The error message, if an error occurred - - ! Local variables - INTEGER(IntKi) :: ErrStat2 ! Temporary error ID - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary message describing error - CHARACTER(*), PARAMETER :: RoutineName = 'StC_SetParameters' - - - ! Initialize variables - ErrStat = ErrID_None - ErrMsg = '' - - ! Filenames - p%RootName = TRIM(InitInp%RootName) ! Already includes NStC, TStC, or BStC - - ! Constants - p%DT = Interval - p%Gravity = InitInp%Gravity ! Gravity vector pointed in negative global Z-axis (/0,0,-g/) - p%NumMeshPts = InitInp%NumMeshPts - - ! DOF controls - p%StC_DOF_MODE = InputFileData%StC_DOF_MODE - - !p%DT = InputFileData%DT - !p%RootName = 'StC' - ! DOFs - - p%StC_X_DOF = InputFileData%StC_X_DOF - p%StC_Y_DOF = InputFileData%StC_Y_DOF - p%StC_Z_DOF = InputFileData%StC_Z_DOF - - ! StC X parameters - p%M_X = InputFileData%StC_X_M - p%K_X = InputFileData%StC_X_K - p%C_X = InputFileData%StC_X_C - - ! StC Y parameters - p%M_Y = InputFileData%StC_Y_M - p%K_Y = InputFileData%StC_Y_K - p%C_Y = InputFileData%StC_Y_C - - ! StC Z parameters - p%M_Z = InputFileData%StC_Z_M - p%K_Z = InputFileData%StC_Z_K - p%C_Z = InputFileData%StC_Z_C - - ! StC Omni parameters - p%M_XY = InputFileData%StC_XY_M - - ! Fore-Aft TLCD Parameters ! MEG & SP - p%L_X = InputFileData%L_X - p%B_X = InputFileData%B_X - p%area_X = InputFileData%area_X - p%area_ratio_X = InputFileData%area_ratio_X - p%headLossCoeff_X = InputFileData%headLossCoeff_X - p%rho_X = InputFileData%rho_X - - !Side-Side TLCD Parameters - p%L_Y = InputFileData%L_Y - p%B_Y = InputFileData%B_Y - p%area_Y = InputFileData%area_Y - p%area_ratio_Y = InputFileData%area_ratio_Y - p%headLossCoeff_Y = InputFileData%headLossCoeff_Y - p%rho_Y = InputFileData%rho_Y ! MEG & SP - - ! vector parameters - ! stop positions - p%P_SP(1) = InputFileData%StC_X_PSP - p%P_SP(2) = InputFileData%StC_Y_PSP - p%P_SP(3) = InputFileData%StC_Z_PSP - p%N_SP(1) = InputFileData%StC_X_NSP - p%N_SP(2) = InputFileData%StC_Y_NSP - p%N_SP(3) = InputFileData%StC_Z_NSP - ! stop force stiffness - p%K_S(1) = InputFileData%StC_X_KS - p%K_S(2) = InputFileData%StC_Y_KS - p%K_S(3) = InputFileData%StC_Z_KS - ! stop force damping - p%C_S(1) = InputFileData%StC_X_CS - p%C_S(2) = InputFileData%StC_Y_CS - p%C_S(3) = InputFileData%StC_Z_CS - - ! ground hook control damping files - p%StC_CMODE = InputFileData%StC_CMODE - p%StC_SA_MODE = InputFileData%StC_SA_MODE - p%StC_X_C_HIGH = InputFileData%StC_X_C_HIGH - p%StC_X_C_LOW = InputFileData%StC_X_C_LOW - p%StC_Y_C_HIGH = InputFileData%StC_Y_C_HIGH - p%StC_Y_C_LOW = InputFileData%StC_Y_C_LOW - p%StC_Z_C_HIGH = InputFileData%StC_Z_C_HIGH - p%StC_Z_C_LOW = InputFileData%StC_Z_C_LOW - p%StC_X_C_BRAKE = InputFileData%StC_X_C_BRAKE - p%StC_Y_C_BRAKE = InputFileData%StC_Y_C_BRAKE - p%StC_Z_C_BRAKE = InputFileData%StC_Z_C_BRAKE - - ! User Defined Stiffness Table - p%Use_F_TBL = InputFileData%Use_F_TBL - call AllocAry(p%F_TBL,SIZE(InputFiledata%F_TBL,1),SIZE(InputFiledata%F_TBL,2),'F_TBL', ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName); if (ErrStat >= ErrID_Fatal) return - - p%F_TBL = InputFileData%F_TBL; - - ! Prescribed forces - p%PrescribedForcesCoordSys = InputFileData%PrescribedForcesCoordSys - if (allocated(InputFileData%StC_PrescribedForce)) then - call AllocAry( p%StC_PrescribedForce, size(InputFileData%StC_PrescribedForce,1), size(InputFileData%StC_PrescribedForce,2),"Array of force data", ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName); if (ErrStat >= ErrID_Fatal) return - p%StC_PrescribedForce = InputFileData%StC_PrescribedForce - endif - -END SUBROUTINE StC_SetParameters - - -subroutine StC_ParseTimeSeriesFileInfo( InputFile, FileInfo_In, InputFileData, UnEcho, ErrStat, ErrMsg ) - - implicit none - - ! Passed variables - CHARACTER(*), intent(in ) :: InputFile !< Name of the file containing the primary input data - type(StC_InputFile), intent(inout) :: InputFileData !< All the data in the StrucCtrl input file - type(FileInfoType), intent(in ) :: FileInfo_In !< The derived type for holding the file information. - integer(IntKi), intent(inout) :: UnEcho !< The local unit number for this module's echo file - integer(IntKi), intent( out) :: ErrStat !< Error status - CHARACTER(ErrMsgLen), intent( out) :: ErrMsg !< Error message - - ! Local variables: - integer(IntKi) :: i !< generic counter - integer(IntKi) :: ErrStat2 !< Temporary Error status - character(ErrMsgLen) :: ErrMsg2 !< Temporary Error message - integer(IntKi) :: CurLine !< current entry in FileInfo_In%Lines array - real(ReKi) :: TmpRe7(7) !< temporary 7 number array for reading values in - character(*), parameter :: RoutineName='StC_ParseTimeSeriesFileInfo' - - ! Initialization of subroutine - ErrMsg = '' - ErrMsg2 = '' - ErrStat = ErrID_None - ErrStat2 = ErrID_None - - ! This file should only contain a table. Header lines etc should be commented out. Any blank lines at the - ! end get removed by the ProcessCom - call AllocAry( InputFileData%StC_PrescribedForce, 7, FileInfo_In%NumLines, "Array of force data", ErrStat2, ErrMsg2 ) - if (Failed()) return; - - ! Loop over all table lines. Expecting 7 colunns - CurLine=1 - do i=1,FileInfo_In%NumLines - call ParseAry ( FileInfo_In, CurLine, 'Coordinates', TmpRe7, 7, ErrStat2, ErrMsg2, UnEcho ) - if (Failed()) return; - InputFileData%StC_PrescribedForce(1:7,i) = TmpRe7 - enddo - -contains - !------------------------------------------------------------------------------------------------- - logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - end function Failed -end subroutine StC_ParseTimeSeriesFileInfo - -!---------------------------------------------------------------------------------------------------------------------------------- -END MODULE StrucCtrl -!********************************************************************************************************************************** diff --git a/OpenFAST/modules/servodyn/src/StrucCtrl_Driver.f90 b/OpenFAST/modules/servodyn/src/StrucCtrl_Driver.f90 deleted file mode 100644 index 885491d1b..000000000 --- a/OpenFAST/modules/servodyn/src/StrucCtrl_Driver.f90 +++ /dev/null @@ -1,922 +0,0 @@ -!********************************************************************************************************************************* -! StrucCtrl_Driver: This code tests the template modules -!.................................................................................................................................. -! LICENSING -! Copyright (C) 2014 William La Cava & Matt Lackner, UMass Amherst -! Copyright (C) 2012 National Renewable Energy Laboratory -! -! This file is part of StrucCtrl. -! -! 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. -! -!********************************************************************************************************************************** -module read_file_module -! this module reads in external nacelle data for testing the module. - USE NWTC_Library - USE StrucCtrl_Types - implicit none -contains - - SUBROUTINE U_ReadInput(APvec,AVvec,AAvec,LAvec, NumSteps, ErrStat, ErrMsg ) -! This subroutine reads the input file and stores all the data in the input vectors. -! It does not perform data validation. -!.................................................................................................................................. - - ! Passed variables - INTEGER(IntKi), INTENT(IN) :: NumSteps ! Number of steps - - Real(ReKi), dimension(9, NumSteps), intent(inout) :: APvec - Real(ReKi), dimension(3,NumSteps), intent(inout):: AVvec - Real(ReKi), dimension(3,NumSteps), intent(inout):: AAvec - Real(ReKi), dimension(3,NumSteps), intent(inout):: LAvec - - 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(LEN(ErrMsg)) :: ErrMsg2 ! The error message, if an error occurred - CHARACTER(1024) :: AV_file = 'AngVel_NO_Input_Data.inp' - CHARACTER(1024) :: AA_file = 'AngAccel_NO_Input_Data.inp' - CHARACTER(1024) :: AP_file = 'AngPos_NO_Input_Data.inp' - CHARACTER(1024) :: RA_file = 'rddot_NO_Input_Data.inp' - - ! initialize values: - - ErrStat = ErrID_None - ErrMsg = "" - - - ! get the primary/platform input-file data - !DO i = 1,NumSteps - CALL ReadAngPosFile(AP_file, APvec, NumSteps,UnEcho, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - CALL ReadAngVelFile( AV_file, AVvec,NumSteps,UnEcho, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - CALL ReadAngAccelFile( AA_file, AAvec,NumSteps, UnEcho, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - CALL ReadAccelFile( RA_file, LAvec,NumSteps, UnEcho, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - ! END DO - ! we may need to read additional files here (e.g., Bladed Interface) - - - ! close any echo file that was opened - - IF ( UnEcho > 0 ) CLOSE( UnEcho ) - -CONTAINS - !............................................................................................................................... - SUBROUTINE CheckError(ErrID,Msg) - ! This subroutine sets the error message and level and cleans up if the error is >= AbortErrLev - !............................................................................................................................... - - ! Passed arguments - INTEGER(IntKi), INTENT(IN) :: ErrID ! The error identifier (ErrStat) - CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) - - - !............................................................................................................................ - ! Set error status/message; - !............................................................................................................................ - - IF ( ErrID /= ErrID_None ) THEN - - IF (ErrStat /= ErrID_None) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'StC_ReadInput:'//TRIM(Msg) - ErrStat = MAX(ErrStat, ErrID) - - !......................................................................................................................... - ! Clean up if we're going to return on error: close files, deallocate local arrays - !......................................................................................................................... - IF ( ErrStat >= AbortErrLev ) THEN - IF ( UnEcho > 0 ) CLOSE( UnEcho ) - END IF - - END IF - - - END SUBROUTINE CheckError - -END SUBROUTINE U_ReadInput -!---------------------------------------------------------------------------------------------------------------------------------- - SUBROUTINE ReadAngPosFile( InputFile, APvec, NumSteps, UnEc, ErrStat, ErrMsg ) -! This routine reads in the nacelle angular position. -! It opens and prints to an echo file if requested. -!.................................................................................................................................. - - - IMPLICIT NONE - - ! Passed variables - INTEGER(IntKi), INTENT(IN) :: NumSteps ! The default DT (from glue code) - INTEGER(IntKi), INTENT(OUT) :: UnEc ! I/O unit for echo file. If > 0, file is open for writing. - INTEGER(IntKi), INTENT(OUT) :: ErrStat ! Error status - - CHARACTER(*), INTENT(IN) :: InputFile ! Name of the file containing the primary input data - CHARACTER(*), INTENT(OUT) :: ErrMsg ! Error message - - !TYPE(StC_InputFile), INTENT(INOUT) :: InputFileData ! All the data in the StC input file - Real(ReKi), dimension(9, NumSteps), intent(inout) :: APvec - ! Local variables: - REAL(ReKi) :: TmpRAry9(9) ! Temporary variable to read table from file - INTEGER :: I ! loop counter - INTEGER :: J ! loop counter - INTEGER(IntKi) :: UnIn ! Unit number for reading file - - INTEGER(IntKi) :: ErrStat2 ! Temporary Error status - LOGICAL :: Echo ! Determines if an echo file should be written - CHARACTER(LEN(ErrMsg)) :: ErrMsg2 ! Temporary Error message - CHARACTER(1024) :: PriPath ! Path name of the primary file - - - ! Initialize some variables: - ErrStat = ErrID_None - ErrMsg = "" - - UnEc = -1 - Echo = .FALSE. - CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - - - !CALL AllocAry( InputFileData%OutList, MaxOutPts, "ServoDyn Input File's Outlist", ErrStat2, ErrMsg2 ) - ! CALL CheckError( ErrStat2, ErrMsg2 ) - ! IF ( ErrStat >= AbortErrLev ) RETURN - - - ! Get an available unit number for the file. - - CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF ( ErrStat >= AbortErrLev ) RETURN - - - ! Open the Primary input file. - - CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF ( ErrStat >= AbortErrLev ) 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. - ! If Echo is TRUE, rewind and write on the second try. - - I = 1 !set the number of times we've read the file - ! - DO I=1,NumSteps - CALL ReadAry( UnIn, InputFile, TmpRAry9, 9, 'AngPos_NO', 'Nacelle Rotation Matrix', ErrStat2, ErrMsg2, UnEc ) - - DO J = 1,9 - APvec(J,I) = TmpRAry9(J) - END DO - END DO - - CLOSE ( UnIn ) - RETURN - - -CONTAINS - !............................................................................................................................... - SUBROUTINE CheckError(ErrID,Msg) - ! This subroutine sets the error message and level - !............................................................................................................................... - - ! Passed arguments - INTEGER(IntKi), INTENT(IN) :: ErrID ! The error identifier (ErrStat) - CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) - - - !............................................................................................................................ - ! Set error status/message; - !............................................................................................................................ - - IF ( ErrID /= ErrID_None ) THEN - - IF (ErrStat /= ErrID_None) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'ReadPrimaryFile:'//TRIM(Msg) - ErrStat = MAX(ErrStat, ErrID) - - !......................................................................................................................... - ! Clean up if we're going to return on error: close file, deallocate local arrays - !......................................................................................................................... - IF ( ErrStat >= AbortErrLev ) THEN - CLOSE( UnIn ) -! IF ( UnEc > 0 ) CLOSE ( UnEc ) - END IF - - END IF - - - END SUBROUTINE CheckError - !............................................................................................................................... - END SUBROUTINE ReadAngPosFile - SUBROUTINE ReadAngVelFile( InputFile, AVvec, NumSteps, UnEc, ErrStat, ErrMsg ) -! This routine reads in the nacelle angular velocity. -! It opens and prints to an echo file if requested. -!.................................................................................................................................. - - - IMPLICIT NONE - - ! Passed variables - INTEGER(IntKi), INTENT(IN) :: NumSteps ! The default DT (from glue code) - INTEGER(IntKi), INTENT(OUT) :: UnEc ! I/O unit for echo file. If > 0, file is open for writing. - INTEGER(IntKi), INTENT(OUT) :: ErrStat ! Error status - - CHARACTER(*), INTENT(IN) :: InputFile ! Name of the file containing the primary input data - CHARACTER(*), INTENT(OUT) :: ErrMsg ! Error message - - !TYPE(StC_InputFile), INTENT(INOUT) :: InputFileData ! All the data in the StC input file - Real(ReKi), dimension(3,NumSteps), intent(inout) :: AVvec - ! Local variables: - REAL(ReKi) :: TmpRAry3(3) ! Temporary variable to read table from file - INTEGER(IntKi) :: I ! loop counter - INTEGER(IntKi) :: J ! loop counter - INTEGER(IntKi) :: UnIn ! Unit number for reading file - - INTEGER(IntKi) :: ErrStat2 ! Temporary Error status - LOGICAL :: Echo ! Determines if an echo file should be written - CHARACTER(LEN(ErrMsg)) :: ErrMsg2 ! Temporary Error message - CHARACTER(1024) :: PriPath ! Path name of the primary file - - - ! Initialize some variables: - ErrStat = ErrID_None - ErrMsg = "" - - UnEc = -1 - Echo = .FALSE. - CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - - - !CALL AllocAry( InputFileData%OutList, MaxOutPts, "ServoDyn Input File's Outlist", ErrStat2, ErrMsg2 ) - ! CALL CheckError( ErrStat2, ErrMsg2 ) - ! IF ( ErrStat >= AbortErrLev ) RETURN - - - ! Get an available unit number for the file. - - CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF ( ErrStat >= AbortErrLev ) RETURN - - - ! Open the Primary input file. - - CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF ( ErrStat >= AbortErrLev ) 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. - ! If Echo is TRUE, rewind and write on the second try. - - I = 1 !set the number of times we've read the file - ! - DO I=1,NumSteps - CALL ReadAry( UnIn, InputFile, TmpRAry3, 3, 'AngVel_NO', 'Nacelle Angular Velocity', ErrStat2, ErrMsg2, UnEc ) - DO J = 1,3 - AVvec(J,I) = TmpRAry3(J) - END DO - END DO - - CLOSE ( UnIn ) - RETURN - - -CONTAINS - !............................................................................................................................... - SUBROUTINE CheckError(ErrID,Msg) - ! This subroutine sets the error message and level - !............................................................................................................................... - - ! Passed arguments - INTEGER(IntKi), INTENT(IN) :: ErrID ! The error identifier (ErrStat) - CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) - - - !............................................................................................................................ - ! Set error status/message; - !............................................................................................................................ - - IF ( ErrID /= ErrID_None ) THEN - - IF (ErrStat /= ErrID_None) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'ReadPrimaryFile:'//TRIM(Msg) - ErrStat = MAX(ErrStat, ErrID) - - !......................................................................................................................... - ! Clean up if we're going to return on error: close file, deallocate local arrays - !......................................................................................................................... - IF ( ErrStat >= AbortErrLev ) THEN - CLOSE( UnIn ) -! IF ( UnEc > 0 ) CLOSE ( UnEc ) - END IF - - END IF - - - END SUBROUTINE CheckError - !............................................................................................................................... - END SUBROUTINE ReadAngVelFile - SUBROUTINE ReadAngAccelFile( InputFile, AAvec, NumSteps, UnEc, ErrStat, ErrMsg ) -! This routine reads in the nacelle angular acceleration. -! It opens and prints to an echo file if requested. -!.................................................................................................................................. - - - IMPLICIT NONE - - ! Passed variables - INTEGER(IntKi), INTENT(IN) :: NumSteps ! The default DT (from glue code) - INTEGER(IntKi), INTENT(OUT) :: UnEc ! I/O unit for echo file. If > 0, file is open for writing. - INTEGER(IntKi), INTENT(OUT) :: ErrStat ! Error status - - CHARACTER(*), INTENT(IN) :: InputFile ! Name of the file containing the primary input data - CHARACTER(*), INTENT(OUT) :: ErrMsg ! Error message - - !TYPE(StC_InputFile), INTENT(INOUT) :: InputFileData ! All the data in the StC input file - Real(ReKi), dimension(3,NumSteps), intent(inout) :: AAvec - ! Local variables: - REAL(ReKi) :: TmpRAry3(3) ! Temporary variable to read table from file - INTEGER(IntKi) :: I ! loop counter - INTEGER(IntKi) :: J ! loop counter - INTEGER(IntKi) :: UnIn ! Unit number for reading file - - INTEGER(IntKi) :: ErrStat2 ! Temporary Error status - LOGICAL :: Echo ! Determines if an echo file should be written - CHARACTER(LEN(ErrMsg)) :: ErrMsg2 ! Temporary Error message - CHARACTER(1024) :: PriPath ! Path name of the primary file - - - ! Initialize some variables: - ErrStat = ErrID_None - ErrMsg = "" - - UnEc = -1 - Echo = .FALSE. - CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - - - !CALL AllocAry( InputFileData%OutList, MaxOutPts, "ServoDyn Input File's Outlist", ErrStat2, ErrMsg2 ) - ! CALL CheckError( ErrStat2, ErrMsg2 ) - ! IF ( ErrStat >= AbortErrLev ) RETURN - - - ! Get an available unit number for the file. - - CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF ( ErrStat >= AbortErrLev ) RETURN - - - ! Open the Primary input file. - - CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF ( ErrStat >= AbortErrLev ) 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. - ! If Echo is TRUE, rewind and write on the second try. - - I = 1 !set the number of times we've read the file - ! - DO I = 1,NumSteps - CALL ReadAry( UnIn, InputFile, TmpRAry3, 3, 'AngAccel_NO', 'Nacelle Angular Acceleration', ErrStat2, ErrMsg2, UnEc ) - DO J = 1,3 - AAvec(J,I) = TmpRAry3(J) - END DO - END DO - CLOSE ( UnIn ) - RETURN - - -CONTAINS - !............................................................................................................................... - SUBROUTINE CheckError(ErrID,Msg) - ! This subroutine sets the error message and level - !............................................................................................................................... - - ! Passed arguments - INTEGER(IntKi), INTENT(IN) :: ErrID ! The error identifier (ErrStat) - CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) - - - !............................................................................................................................ - ! Set error status/message; - !............................................................................................................................ - - IF ( ErrID /= ErrID_None ) THEN - - IF (ErrStat /= ErrID_None) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'ReadPrimaryFile:'//TRIM(Msg) - ErrStat = MAX(ErrStat, ErrID) - - !......................................................................................................................... - ! Clean up if we're going to return on error: close file, deallocate local arrays - !......................................................................................................................... - IF ( ErrStat >= AbortErrLev ) THEN - CLOSE( UnIn ) -! IF ( UnEc > 0 ) CLOSE ( UnEc ) - END IF - - END IF - - - END SUBROUTINE CheckError - !............................................................................................................................... -END SUBROUTINE ReadAngAccelFile - SUBROUTINE ReadAccelFile( InputFile, LAvec, NumSteps, UnEc, ErrStat, ErrMsg ) -! This routine reads in the nacelle translational acceleration. -! It opens and prints to an echo file if requested. -!.................................................................................................................................. - - - IMPLICIT NONE - - ! Passed variables - INTEGER(IntKi), INTENT(IN) :: NumSteps ! The default DT (from glue code) - INTEGER(IntKi), INTENT(OUT) :: UnEc ! I/O unit for echo file. If > 0, file is open for writing. - INTEGER(IntKi), INTENT(OUT) :: ErrStat ! Error status - - CHARACTER(*), INTENT(IN) :: InputFile ! Name of the file containing the primary input data - CHARACTER(*), INTENT(OUT) :: ErrMsg ! Error message - - !TYPE(StC_InputFile), INTENT(INOUT) :: InputFileData ! All the data in the StC input file - Real(ReKi), dimension(3,NumSteps), intent(inout) :: LAvec - ! Local variables: - REAL(ReKi) :: TmpRAry3(3) ! Temporary variable to read table from file - INTEGER(IntKi) :: I ! loop counter - INTEGER(IntKi) :: J ! loop counter - INTEGER(IntKi) :: UnIn ! Unit number for reading file - - INTEGER(IntKi) :: ErrStat2 ! Temporary Error status - LOGICAL :: Echo ! Determines if an echo file should be written - CHARACTER(LEN(ErrMsg)) :: ErrMsg2 ! Temporary Error message - CHARACTER(1024) :: PriPath ! Path name of the primary file - - - ! Initialize some variables: - ErrStat = ErrID_None - ErrMsg = "" - - UnEc = -1 - Echo = .FALSE. - CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - - - !CALL AllocAry( InputFileData%OutList, MaxOutPts, "ServoDyn Input File's Outlist", ErrStat2, ErrMsg2 ) - ! CALL CheckError( ErrStat2, ErrMsg2 ) - ! IF ( ErrStat >= AbortErrLev ) RETURN - - - ! Get an available unit number for the file. - - CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF ( ErrStat >= AbortErrLev ) RETURN - - - ! Open the Primary input file. - - CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF ( ErrStat >= AbortErrLev ) 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. - ! If Echo is TRUE, rewind and write on the second try. - - ! I = 1 !set the number of times we've read the file - ! - DO I=1,NumSteps - CALL ReadAry( UnIn, InputFile, TmpRAry3, 3, 'rddot_NO', 'Nacelle Linear Acceleration', ErrStat2, ErrMsg2, UnEc ) - - DO J = 1,3 - LAvec(J,I) = TmpRAry3(J) - END DO - END DO - - CLOSE ( UnIn ) - RETURN - - -CONTAINS - !............................................................................................................................... - SUBROUTINE CheckError(ErrID,Msg) - ! This subroutine sets the error message and level - !............................................................................................................................... - - ! Passed arguments - INTEGER(IntKi), INTENT(IN) :: ErrID ! The error identifier (ErrStat) - CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) - - - !............................................................................................................................ - ! Set error status/message; - !............................................................................................................................ - - IF ( ErrID /= ErrID_None ) THEN - - IF (ErrStat /= ErrID_None) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'ReadPrimaryFile:'//TRIM(Msg) - ErrStat = MAX(ErrStat, ErrID) - - !......................................................................................................................... - ! Clean up if we're going to return on error: close file, deallocate local arrays - !......................................................................................................................... - IF ( ErrStat >= AbortErrLev ) THEN - CLOSE( UnIn ) -! IF ( UnEc > 0 ) CLOSE ( UnEc ) - END IF - - END IF - - - END SUBROUTINE CheckError - !............................................................................................................................... -END SUBROUTINE ReadAccelFile - - -!----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE StC_OpenOutputFile(OutputFile,UnIn,ErrStat,ErrMsg) -! This routine is called by the driver, not this module. - CHARACTER(1024), Intent(IN) :: OutputFile ! Name of the file containing the primary input data - INTEGER(IntKi), INTENT(OUT) :: UnIn ! Unit number for writing file - INTEGER(IntKi), INTENT(OUT) :: ErrStat ! Temporary error ID - CHARACTER(*), INTENT(OUT) :: ErrMsg ! Temporary message describing error - CHARACTER(1024) :: Header1 - CHARACTER(1024) :: Header2 - - ErrStat = ErrID_None - ErrMsg = '' - !OutputFile = 'StC_Output_Data.txt' - !Fmt = "F10.2))/" - - CALL GetNewUnit( UnIn, ErrStat, ErrMsg ) - !CALL CheckError( ErrStat, ErrMsg) - !IF ( ErrStat >= AbortErrLev ) RETURN - - - ! Open the output file. - - CALL OpenFOutFile ( UnIn, OutputFile, ErrStat, ErrMsg ) - Header1 = "-------------- StrucCtrl Output ------------------------------" - Header2 = "x dxdt y dydt fx fy fz mx my mz" - - WRITE( UnIn, *, IOSTAT=ErrStat ) TRIM(Header1) - WRITE( UnIn, *, IOSTAT=ErrStat ) TRIM(Header2) - -END SUBROUTINE StC_OpenOutputFile -!----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE StC_CloseOutputFile(Un) -! This routine is called by the driver, not this module. - - INTEGER(IntKi), INTENT(IN) :: Un ! Unit number for writing file - CLOSE ( Un ) -END SUBROUTINE StC_CloseOutputFile -!----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE StC_WriteOutputFile( x, y, UnIn, ErrStat, ErrMsg ) -! This routine is called by the driver, not this module. -! write output file with StC states and forces. - - TYPE(StC_ContinuousStateType), INTENT(IN ) :: x ! Continuous states at Time - TYPE(StC_OutputType), INTENT(IN ) :: y ! state outputs - INTEGER(IntKi), INTENT(IN) :: UnIn ! Unit number for writing file - INTEGER(IntKi), INTENT(OUT) :: ErrStat ! Temporary error ID - CHARACTER(*), INTENT(OUT) :: ErrMsg ! Temporary message describing error - !REAL(DbKi), INTENT(IN ) :: Time ! Current simulation time in seconds - - CHARACTER(1024) :: Fmt !text format - REAL(ReKi), dimension(10) :: OutAry - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i_pt ! index into mesh point - ErrStat = ErrID_None - ErrMsg = '' - -!FIXME: allow different sizes for StC_x second dimension -- loop over i_pt -!FIXME: allow for different size meshes -- loop over i_pt - i_pt=1 - - ! create output array - DO i=1,4 - OutAry(i) = x%StC_x(i,i_pt) - END DO - DO i=5,7 - OutAry(i) = y%Mesh(i_pt)%Force(i-4,1) - END DO - DO i=8,10 - OutAry(i) = y%Mesh(i_pt)%Moment(i-7,1) - END DO - !Write output - Fmt = '(10(1x,F10.2))' - WRITE( UnIn, Fmt, IOSTAT=ErrStat ) OutAry(:) - IF (ErrStat /= 0) THEN - CALL WrScr('Error '//TRIM(Num2LStr(ErrStat))//' writing matrix in WrMatrix1R4().') - RETURN - END IF - !CALL WrMatrix( x%StC_x, UnIn, Fmt ) - -END SUBROUTINE StC_WriteOutputFile -!----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- - - -end module read_file_module - -PROGRAM StrucCtrl_Driver - - USE NWTC_Library - USE StrucCtrl - USE StrucCtrl_Types - USE read_file_module - - IMPLICIT NONE - - INTEGER(IntKi), PARAMETER :: NumInp = 2 ! Number of inputs sent to StC_UpdateStates - INTEGER(IntKi), PARAMETER :: NumSteps = 100 ! Number of time steps - ! Program variables - REAL(DbKi) :: Time ! Variable for storing time, in seconds - REAL(DbKi) :: TimeInterval ! Interval between time steps, in seconds - REAL(DbKi) :: InputTime(NumInp) ! Variable for storing time associated with inputs, in seconds - - TYPE(StC_InitInputType) :: InitInData ! Input data for initialization - TYPE(StC_InitOutputType) :: InitOutData ! Output data from initialization - - TYPE(StC_ContinuousStateType) :: x ! Continuous states - TYPE(StC_DiscreteStateType) :: xd ! Discrete states - TYPE(StC_ConstraintStateType) :: z ! Constraint states - TYPE(StC_ConstraintStateType) :: Z_residual ! Residual of the constraint state functions (Z) - TYPE(StC_OtherStateType) :: OtherState ! Other states - TYPE(StC_MiscVarType) :: m ! misc variables - - TYPE(StC_ParameterType) :: p ! Parameters - TYPE(StC_InputType) :: u(NumInp) ! System inputs - TYPE(StC_OutputType) :: y ! System outputs - - TYPE(StC_ContinuousStateType) :: dxdt ! First time derivatives of the continuous states - integer(IntKi) :: UnOut !output data file number - - - INTEGER(IntKi) :: n ! Loop counter (for time step) - INTEGER(IntKi) :: i ! Loop counter (for time step) - INTEGER(IntKi) :: j ! Loop counter (for time step) - INTEGER(IntKi) :: count ! Loop counter (for time step) - INTEGER(IntKi) :: ErrStat ! Status of error message - CHARACTER(1024) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - REAL(ReKi), ALLOCATABLE :: Re_SaveAry (:) ! Array to store reals in packed data structure - REAL(DbKi), ALLOCATABLE :: Db_SaveAry (:) ! Array to store doubles in packed data structure - INTEGER(IntKi), ALLOCATABLE :: Int_SaveAry (:) ! Array to store integers in packed data structure - Real(ReKi), dimension(9,NumSteps) :: APvec - Real(ReKi), dimension(3,NumSteps) :: AVvec - Real(ReKi), dimension(3,NumSteps) :: AAvec - Real(ReKi), dimension(3,NumSteps) :: LAvec - CHARACTER(1024) :: OutputName !text file output - - integer(IntKi) :: i_pt ! index counter to points -!............................................................................................................................... -! Routines called in initialization -!............................................................................................................................... - ! Populate the InitInData data structure here: - ! input file with StC settings - InitInData%InputFile = 'StC_Input_test.dat' - ! gravity - InitInData%Gravity = 9.80665 - ! StC origin and orientation - call AllocAry(InitInData%InitPosition, 3, 1, 'InitPosition', ErrStat,ErrMsg) - call AllocAry(InitInData%InitOrientation, 3, 3, 1, 'InitOrientation', ErrStat,ErrMsg) - InitInData%InitPosition(1:3,1) = (/ 0.0_ReKi, 0.0_ReKi, 0.0_ReKi /) - InitInData%InitOrientation = 0.0_R8Ki - do i=1,3 - InitInData%InitOrientation(i,i,1) = 1.0_R8Ki - enddo - - ! Set the driver's request for time interval here: - - TimeInterval = 0.25 ! Glue code's request for delta time (likely based on information from other modules) - - ! Initialize the module - - CALL StC_Init( InitInData, u(1), p, x, xd, z, OtherState, y, m, TimeInterval, InitOutData, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - IF (ErrStat >= AbortErrLev) CALL ProgAbort( ErrMsg ) - CALL WrScr( ErrMsg ) - END IF - CALL StC_CopyInput( u(1), u(2), MESH_NEWCOPY, ErrStat, ErrMsg ) - - ! read in nacelle data from file - CALL U_ReadInput(APvec,AVvec,AAvec,LAvec, NumSteps, ErrStat, ErrMsg ) - - ! Destroy initialization data - CALL StC_DestroyInitInput( InitInData, ErrStat, ErrMsg ) - CALL StC_DestroyInitOutput( InitOutData, ErrStat, ErrMsg ) - !............................................................................................................................... - ! Routines called in loose coupling -- the glue code may implement this in various ways - !.................................................................................................... - ! setup the output file: - OutputName = 'StC_Output_Data.txt' - CALL StC_OpenOutputFile(OutputName,UnOut,ErrStat,ErrMsg) - - ! run simulation - - !FIXME: allow for more than one point? - i_pt = 1 ! index counter of number of points we are simulating - -DO n = 0,NumSteps-1 - count=1 - ! Modify u (likely from the outputs of another module or a set of test conditions) here: - IF (n>0) THEN - CALL StC_CopyInput( u(2), u(1), MESH_UPDATECOPY, ErrStat, ErrMsg ) - ! u(1) = u(2) ! save past input as first element in input vector - END IF - i=1 - j=1 - ! setup input mesh with data from nacelle positions: - do i = 1,3 - do j=1,3 - u(2)%Mesh(i_pt)%Orientation(i,j,1) = APvec(count,n+1) - count = count+1 - end do - u(2)%Mesh(i_pt)%RotationVel(i,1) = AVvec(i,n+1) - u(2)%Mesh(i_pt)%RotationAcc(i,1) = AAvec(i,n+1) - u(2)%Mesh(i_pt)%TranslationAcc(i,1) = LAvec(i,n+1) - end do - if (n==0) then - InputTime(1) = 0 - InputTime(2) = TimeInterval - else - InputTime(1) = Time - Time = n*TimeInterval - InputTime(2) = Time - end if - - - ! Calculate outputs at n - CALL StC_CalcOutput( Time, u(1), p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - ! Get state variables at next step: INPUT at step n, OUTPUT at step n + 1 - CALL StC_UpdateStates( Time, n, u, InputTime, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - ! write outputs to file - CALL StC_WriteOutputFile(x, y, UnOut,ErrStat,ErrMsg) -END DO -! close the output file -CALL StC_CloseOutputFile(UnOut) - !............................................................................................................................... - ! Routines called in tight coupling -- time marching only - !............................................................................................................................... - !DO n = 0,10 - ! Time = n * TimeInterval ! Note that the discrete states must be updated only at the TimeInterval defined in initialization - ! ! set inputs (u) here: - ! ! u = - ! ! Update constraint states at Time - ! ! DO - ! !CALL StC_CalcConstrStateResidual( Time, u(1), p, x, xd, z, OtherState, Z_residual, ErrStat, ErrMsg ) - ! ! - ! !IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - ! ! CALL WrScr( ErrMsg ) - ! !END IF - ! ! z = - ! ! END DO - ! ! Calculate the outputs at Time - ! CALL StC_CalcOutput( Time, u(1), p, x, xd, z, OtherState, y, ErrStat, ErrMsg ) - ! - ! IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - ! CALL WrScr( ErrMsg ) - ! END IF - ! ! Calculate the continuous state derivatives at Time - ! CALL StC_CalcContStateDeriv( Time, u(1), p, x, xd, z, OtherState, dxdt, ErrStat, ErrMsg ) - ! - ! IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - ! CALL WrScr( ErrMsg ) - ! END IF - ! ! Update the discrete state from step n to step n+1 - ! ! Note that the discrete states must be updated only at the TimeInterval defined in initialization - ! !CALL StC_UpdateDiscState( Time, n, u(1), p, x, xd, z, OtherState, ErrStat, ErrMsg ) - ! ! - ! !IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - ! ! CALL WrScr( ErrMsg ) - ! !END IF - ! ! Driver should integrate (update) continuous states here: - ! !x = function of dxdt, x - ! ! Jacobians required: - ! !CALL StC_JacobianPInput( Time, u(1), p, x, xd, z, OtherState, dYdu=dYdu, dZdu=dZdu, ErrStat=ErrStat, ErrMsg=ErrMsg ) - ! ! - ! !IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - ! ! CALL WrScr( ErrMsg ) - ! !END IF - ! ! - ! !CALL StC_JacobianPConstrState( Time, u(1), p, x, xd, z, OtherState, dYdz=dYdz, dZdz=dZdz, & - ! !ErrStat=ErrStat, ErrMsg=ErrMsg ) - ! ! - ! !IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - ! ! CALL WrScr( ErrMsg ) - ! !END IF - !END DO - ! Destroy Z_residual and dxdt because they are not necessary anymore - CALL StC_DestroyConstrState( Z_residual, ErrStat, ErrMsg ) - - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - CALL StC_DestroyContState( dxdt, ErrStat, ErrMsg ) - - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - !............................................................................................................................... - ! Jacobian routines called in tight coupling - !............................................................................................................................... - !CALL StC_JacobianPInput( Time, u(1), p, x, xd, z, OtherState, dYdu, dXdu, dXddu, dZdu, ErrStat, ErrMsg ) - ! - !IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - !END IF - ! - !CALL StC_JacobianPContState( Time, u(1), p, x, xd, z, OtherState, dYdx, dXdx, dXddx, dZdx, ErrStat, ErrMsg ) - ! - !IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - ! CALL WrScr( ErrMsg ) - !END IF - ! - !CALL StC_JacobianPDiscState( Time, u(1), p, x, xd, z, OtherState, dYdxd, dXdxd, dXddxd, dZdxd, ErrStat, ErrMsg ) - ! - !IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - ! CALL WrScr( ErrMsg ) - !END IF - ! - !CALL StC_JacobianPConstrState( Time, u(1), p, x, xd, z, OtherState, dYdz, dXdz, dXddz, dZdz, ErrStat, ErrMsg ) - ! - !IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - ! CALL WrScr( ErrMsg ) - !END IF - !............................................................................................................................... - ! Routines to pack data (to restart later) - !............................................................................................................................... - !CALL StC_Pack(Re_SaveAry, Db_SaveAry, Int_SaveAry, u(1), p, x, xd, z, OtherState, y, ErrStat, ErrMsg) - - IF ( ErrStat /= ErrID_None ) THEN - CALL WrScr( ErrMsg ) - END IF - !............................................................................................................................... - ! Routine to terminate program execution - !............................................................................................................................... - CALL StC_End( u(1), p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) - - IF ( ErrStat /= ErrID_None ) THEN - CALL WrScr( ErrMsg ) - END IF - !............................................................................................................................... - ! Routines to retreive packed data (unpack for restart) - !............................................................................................................................... - !CALL StC_Unpack( Re_SaveAry, Db_SaveAry, Int_SaveAry, u(1), p, x, xd, z, OtherState, y, ErrStat, ErrMsg ) - - IF ( ErrStat /= ErrID_None ) THEN - CALL WrScr( ErrMsg ) - END IF - !............................................................................................................................... - ! Routines to copy data (not already tested) - !............................................................................................................................... - !............................................................................................................................... - ! Routines to destroy data (not already tested) - !............................................................................................................................... - IF ( ALLOCATED( Re_SaveAry ) ) DEALLOCATE( Re_SaveAry ) - IF ( ALLOCATED( Db_SaveAry ) ) DEALLOCATE( Db_SaveAry ) - IF ( ALLOCATED( Int_SaveAry ) ) DEALLOCATE( Int_SaveAry ) - ! CALL StC_DestroyPartialOutputPInput ( ) ! Jacobian Routine not yet implemented - !............................................................................................................................... - ! Routine to terminate program execution (again) - !............................................................................................................................... - CALL StC_End( u(1), p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN - CALL WrScr( ErrMsg ) - END IF - -END PROGRAM StrucCtrl_Driver diff --git a/OpenFAST/modules/servodyn/src/StrucCtrl_Registry.txt b/OpenFAST/modules/servodyn/src/StrucCtrl_Registry.txt deleted file mode 100644 index d28e73612..000000000 --- a/OpenFAST/modules/servodyn/src/StrucCtrl_Registry.txt +++ /dev/null @@ -1,189 +0,0 @@ -################################################################################################################################### -# Registry for StrucCtrl in the FAST Modularization Framework -# This Registry file is used to create MODULE StrucCtrl_Types, which contains all of the user-defined types needed in StrucCtrl. -# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. -# Entries are of the form -# keyword -# -# Use ^ as a shortcut for the value from the previous line. -################################################################################################################################### -include Registry_NWTC_Library.txt - -# ..... Input File data ....................................................................................................... -typedef StrucCtrl/StC StC_InputFile CHARACTER(1024) StCFileName - - - "Name of the input file; remove if there is no file" - -typedef ^ ^ LOGICAL Echo - - - "Echo input file to echo file" - -typedef ^ ^ INTEGER StC_CMODE - - - "control mode {0:none; 1: Semi-Active Control Mode; 2: Active Control Mode;} " - -typedef ^ ^ INTEGER StC_SA_MODE - - - "Semi-Active control mode {1: velocity-based ground hook control; 2: Inverse velocity-based ground hook control; 3: displacement-based ground hook control 4: Phase difference Algorithm with Friction Force 5: Phase difference Algorithm with Damping Force} " - -typedef ^ ^ INTEGER StC_DOF_MODE - - - "DOF mode {0: NO StC_DOF; 1: StC_X_DOF and StC_Y_DOF; 2: StC_XY_DOF; 3: TLCD; 4: Prescribed force/moment time series}" - -typedef ^ ^ LOGICAL StC_X_DOF - - - "DOF on or off" - -typedef ^ ^ LOGICAL StC_Y_DOF - - - "DOF on or off" - -typedef ^ ^ LOGICAL StC_Z_DOF - - - "DOF on or off" - -typedef ^ ^ ReKi StC_X_DSP - - - "StC_X initial displacement" m -typedef ^ ^ ReKi StC_Y_DSP - - - "StC_Y initial displacement" m -typedef ^ ^ ReKi StC_Z_DSP - - - "StC_Z initial displacement" m -typedef ^ ^ ReKi StC_X_M - - - "StC X mass" kg -typedef ^ ^ ReKi StC_Y_M - - - "StC Y mass" kg -typedef ^ ^ ReKi StC_Z_M - - - "StC Z mass" kg -typedef ^ ^ ReKi StC_XY_M - - - "StC XY mass" kg -typedef ^ ^ ReKi StC_X_K - - - "StC X stiffness" "N/m" -typedef ^ ^ ReKi StC_Y_K - - - "StC Y stiffness" "N/m" -typedef ^ ^ ReKi StC_Z_K - - - "StC Y stiffness" "N/m" -typedef ^ ^ ReKi StC_X_C - - - "StC X damping" "N/(m/s)" -typedef ^ ^ ReKi StC_Y_C - - - "StC Y damping" "N/(m/s)" -typedef ^ ^ ReKi StC_Z_C - - - "StC Z damping" "N/(m/s)" -typedef ^ ^ ReKi StC_X_PSP - - - "Positive stop position (maximum X mass displacement)" m -typedef ^ ^ ReKi StC_X_NSP - - - "Negative stop position (minimum X mass displacement)" m -typedef ^ ^ ReKi StC_Y_PSP - - - "Positive stop position (maximum Y mass displacement)" m -typedef ^ ^ ReKi StC_Y_NSP - - - "Negative stop position (minimum Y mass displacement)" m -typedef ^ ^ ReKi StC_Z_PSP - - - "Positive stop position (maximum Z mass displacement)" m -typedef ^ ^ ReKi StC_Z_NSP - - - "Negative stop position (minimum Z mass displacement)" m -typedef ^ ^ ReKi StC_X_KS - - - "Stop spring X stiffness" "N/m" -typedef ^ ^ ReKi StC_X_CS - - - "Stop spring X damping" "N/(m/s)" -typedef ^ ^ ReKi StC_Y_KS - - - "Stop spring Y stiffness" "N/m" -typedef ^ ^ ReKi StC_Y_CS - - - "Stop spring Y damping" "N/(m/s)" -typedef ^ ^ ReKi StC_Z_KS - - - "Stop spring Z stiffness [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE]" "N/m" -typedef ^ ^ ReKi StC_Z_CS - - - "Stop spring Z damping [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE]" "N/(m/s)" -typedef ^ ^ ReKi StC_P_X - - - "StC X initial displacement (m) [relative to at rest position]" m -typedef ^ ^ ReKi StC_P_Y - - - "StC Y initial displacement (m) [relative to at rest position]" m -typedef ^ ^ ReKi StC_P_Z - - - "StC Z initial displacement (m) [relative to at rest position; used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE]" m -typedef ^ ^ ReKi StC_X_C_HIGH - - - "StC X high damping for ground hook control" "N/(m/s)" -typedef ^ ^ ReKi StC_X_C_LOW - - - "StC X low damping for ground hook control" "N/(m/s)" -typedef ^ ^ ReKi StC_Y_C_HIGH - - - "StC Y high damping for ground hook control" "N/(m/s)" -typedef ^ ^ ReKi StC_Y_C_LOW - - - "StC Y low damping for ground hook control" "N/(m/s)" -typedef ^ ^ ReKi StC_Z_C_HIGH - - - "StC Z high damping for ground hook control" "N/(m/s)" -typedef ^ ^ ReKi StC_Z_C_LOW - - - "StC Z low damping for ground hook control" "N/(m/s)" -typedef ^ ^ ReKi StC_X_C_BRAKE - - - "StC X high damping for braking the StC" "N/(m/s)" -typedef ^ ^ ReKi StC_Y_C_BRAKE - - - "StC Y high damping for braking the StC" "N/(m/s)" -typedef ^ ^ ReKi StC_Z_C_BRAKE - - - "StC Z high damping for braking the StC" "N/(m/s)" -typedef ^ ^ ReKi L_X - - - "X TLCD total length" m -typedef ^ ^ ReKi B_X - - - "X TLCD horizontal length" m -typedef ^ ^ ReKi area_X - - - "X TLCD cross-sectional area of vertical column" "m^2" -typedef ^ ^ ReKi area_ratio_X - - - "X TLCD cross-sectional area ratio (vertical column area divided by horizontal column area)" - -typedef ^ ^ ReKi headLossCoeff_X - - - "X TLCD head loss coeff" - -typedef ^ ^ ReKi rho_X - - - "X TLCD liquid density" "kg/m^3" -typedef ^ ^ ReKi L_Y - - - "Y TLCD total length" m -typedef ^ ^ ReKi B_Y - - - "Y TLCD horizontal length" m -typedef ^ ^ ReKi area_Y - - - "Side-Side TLCD cross-sectional area of vertical column" m -typedef ^ ^ ReKi area_ratio_Y - - - "Side-Side TLCD cross-sectional area ratio (vertical column area divided by horizontal column area)" - -typedef ^ ^ ReKi headLossCoeff_Y - - - "Side-Side TLCD head loss coeff" - -typedef ^ ^ ReKi rho_Y - - - "Side-Side TLCD liquid density" "kg/m^3" -typedef ^ ^ LOGICAL USE_F_TBL - - - "use spring force from user-defined table (flag)" - -typedef ^ ^ IntKi NKInpSt - - - "Number of input spring force rows in table" - -typedef ^ ^ CHARACTER(1024) StC_F_TBL_FILE - - - "user-defined spring table filename" - -typedef ^ ^ ReKi F_TBL {:}{:} - - "user-defined spring force" "N" -typedef ^ ^ IntKi PrescribedForcesCoordSys - - - "Prescribed forces coordinate system {0: global; 1: local}" - -typedef ^ ^ CHARACTER(1024) PrescribedForcesFile - - - "Prescribed force time-series filename" - -typedef ^ ^ ReKi StC_PrescribedForce {:}{:} - - "StC prescribed force time-series info" "(s,N,N-m)" -# ..... Initialization data ....................................................................................................... -# Define inputs that the initialization routine may need here: -# e.g., the name of the input file, the file root name, etc. -typedef StrucCtrl/StC InitInputType CHARACTER(1024) InputFile - - - "Name of the input file; remove if there is no file" - -typedef ^ InitInputType CHARACTER(1024) RootName - - - "RootName for writing output files" - -typedef ^ ^ ReKi Gravity {3} - - "Gravitational acceleration vector" "m/s^2" -typedef ^ InitInputType IntKi NumMeshPts - - - "Number of mesh points" - -typedef ^ InitInputType ReKi InitPosition {:}{:} - - "X-Y-Z reference position of point: i.e. each blade root (3 x NumBlades)" m -typedef ^ InitInputType R8Ki InitOrientation {:}{:}{:} - - "DCM reference orientation of point: i.e. each blade root (3x3 x NumBlades)" - -typedef ^ InitInputType LOGICAL UseInputFile - .TRUE. - "Read from the input file. If false, must parse the string info passed" - -typedef ^ InitInputType FileInfoType PassedPrimaryInputData - - - "Primary input file as FileInfoType (set by driver/glue code)" - -typedef ^ InitInputType LOGICAL UseInputFile_PrescribeFrc - .TRUE. - "Read from the input file. If false, must parse the string info passed" - -typedef ^ InitInputType FileInfoType PassedPrescribeFrcData - - - "Prescribed forces input file as FileInfoType (set by driver/glue code)" - - - -# Define outputs from the initialization routine here: -typedef ^ InitOutputType SiKi DummyInitOut - - - "dummy init output" - -#typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - -#typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:}- - "Units of the output-to-file channels" - - -# ..... States .................................................................................................................... -# Define continuous (differentiable) states here: -typedef ^ ContinuousStateType ReKi DummyContState - - - "Remove this variable if you have continuous states" - -typedef ^ ContinuousStateType ReKi StC_x {:}{:} - - "Continuous States -- StrucCtrl x" - -typedef ^ ContinuousStateType ReKi StC_xdot {:}{:} - - "Continuous States -- StrucCtrl xdot" - -# Define discrete (nondifferentiable) states here: -typedef ^ DiscreteStateType ReKi DummyDiscState - - - "Remove this variable if you have discrete states" - -# Define constraint states here: -typedef ^ ConstraintStateType ReKi DummyConstrState - - - "Remove this variable if you have constraint states" - -# Define any other states (e.g. logical states): -typedef ^ OtherStateType Reki DummyOtherState - - - "Remove this variable if you have other/logical states" - - -# Define any misc data used only for efficiency purposes (indices for searching in an array, copies of previous calculations of output -# 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)" - -typedef ^ MiscVarType ReKi F_fr {:}{:} - - "Friction forces" - -typedef ^ MiscVarType ReKi C_ctrl {:}{:} - - "Controlled Damping (On/Off)" - -typedef ^ MiscVarType ReKi C_Brake {:}{:} - - "Braking Damping" - -typedef ^ MiscVarType ReKi F_table {:}{:} - - "Tabled Stiffness" - -typedef ^ MiscVarType ReKi F_k {:}{:} - - "Factor for x and y-component stiffness force" - -typedef ^ MiscVarType ReKi a_G {:}{:} - - "Gravitational acceleration vector, local coordinates for point" m/s^2 -typedef ^ MiscVarType ReKi rdisp_P {:}{:} - - "Translational displacement vector, local coordinates for point" m -typedef ^ MiscVarType ReKi rdot_P {:}{:} - - "Translational velocity vector, local coordinates for point" m/s -typedef ^ MiscVarType ReKi rddot_P {:}{:} - - "Translational acceleration vector, local coordinates for point" m/s^2 -typedef ^ MiscVarType ReKi omega_P {:}{:} - - "Rotational velocity vector, local coordinates for point" rad/s -typedef ^ MiscVarType ReKi alpha_P {:}{:} - - "Rotational aceeleration vector, local coordinates for point" rad/s^2 -typedef ^ MiscVarType ReKi F_P {:}{:} - - "StC force vector, local coordinates for point" N -typedef ^ MiscVarType ReKi M_P {:}{:} - - "StC moment vector, local coordinates for point" N-m -typedef ^ MiscVarType ReKi Acc {:}{:} - - "StC aggregated acceleration in X,Y local coordinates for point" m/s^2 -typedef ^ MiscVarType IntKi PrescribedInterpIdx - - - "Index for interpolation of Prescribed force array" - - - -# ..... Parameters ................................................................................................................ -# Define parameters here: -# Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: -typedef ^ ParameterType DbKi DT - - - "Time step for cont. state integration & disc. state update" seconds -typedef ^ ^ CHARACTER(1024) RootName - - - "RootName for writing output files" - -typedef ^ ^ INTEGER StC_DOF_MODE - - - "DOF mode {0: NO StC_DOF; 1: StC_X_DOF and StC_Y_DOF; 2: StC_XY_DOF; 3: TLCD; 4: Prescribed force/moment time series}" - -typedef ^ ^ LOGICAL StC_X_DOF - - - "DOF on or off" - -typedef ^ ^ LOGICAL StC_Y_DOF - - - "DOF on or off" - -typedef ^ ^ LOGICAL StC_Z_DOF - - - "DOF on or off" - -typedef ^ ^ ReKi M_X - - - "StC mass" kg -typedef ^ ^ ReKi M_Y - - - "StC mass" kg -typedef ^ ^ ReKi M_Z - - - "StC mass" kg -typedef ^ ^ ReKi M_XY - - - "StCXY mass" kg -typedef ^ ^ ReKi K_X - - - "StC stiffness" "N/m" -typedef ^ ^ ReKi K_Y - - - "StC stiffness" "N/m" -typedef ^ ^ ReKi K_Z - - - "StC stiffness" "N/m" -typedef ^ ^ ReKi C_X - - - "StC damping" "N/(m/s)" -typedef ^ ^ ReKi C_Y - - - "StC damping" "N/(m/s)" -typedef ^ ^ ReKi C_Z - - - "StC damping" "N/(m/s)" -typedef ^ ^ ReKi K_S {3} - - "StC stop stiffness" "N/m" -typedef ^ ^ ReKi C_S {3} - - "StC stop damping" "N/(m/s)" -typedef ^ ^ ReKi P_SP {3} - - "Positive stop position (maximum mass displacement)" m -typedef ^ ^ ReKi N_SP {3} - - "Negative stop position (minimum X mass displacement)" m -typedef ^ ^ ReKi Gravity {3} - - "Gravitational acceleration vector" "m/s^2" -typedef ^ ^ INTEGER StC_CMODE - - - "control mode {0:none; 1: Semi-Active Control Mode; 2: Active Control Mode;} " - -typedef ^ ^ INTEGER StC_SA_MODE - - - "Semi-Active control mode {1: velocity-based ground hook control; 2: Inverse velocity-based ground hook control; 3: displacement-based ground hook control 4: Phase difference Algorithm with Friction Force 5: Phase difference Algorithm with Damping Force} " - -typedef ^ ^ ReKi StC_X_C_HIGH - - - "StC X high damping for ground hook control" "N/(m/s)" -typedef ^ ^ ReKi StC_X_C_LOW - - - "StC X low damping for ground hook control" "N/(m/s)" -typedef ^ ^ ReKi StC_Y_C_HIGH - - - "StC Y high damping for ground hook control" "N/(m/s)" -typedef ^ ^ ReKi StC_Y_C_LOW - - - "StC Y low damping for ground hook control" "N/(m/s)" -typedef ^ ^ ReKi StC_Z_C_HIGH - - - "StC Z high damping for ground hook control" "N/(m/s)" -typedef ^ ^ ReKi StC_Z_C_LOW - - - "StC Z low damping for ground hook control" "N/(m/s)" -typedef ^ ^ ReKi StC_X_C_BRAKE - - - "StC X high damping for braking the StC" "N/(m/s)" -typedef ^ ^ ReKi StC_Y_C_BRAKE - - - "StC Y high damping for braking the StC" "N/(m/s)" -typedef ^ ^ ReKi StC_Z_C_BRAKE - - - "StC Y high damping for braking the StC" "N/(m/s)" -typedef ^ ^ ReKi L_X - - - "X TLCD total length" m -typedef ^ ^ ReKi B_X - - - "X TLCD horizontal length" m -typedef ^ ^ ReKi area_X - - - "X TLCD cross-sectional area of vertical column" "m^2" -typedef ^ ^ ReKi area_ratio_X - - - "X TLCD cross-sectional area ratio (vertical column area divided by horizontal column area)" - -typedef ^ ^ ReKi headLossCoeff_X - - - "X TLCD head loss coeff" - -typedef ^ ^ ReKi rho_X - - - "X TLCD liquid density" "kg/m^3" -typedef ^ ^ ReKi L_Y - - - "Y TLCD total length" m -typedef ^ ^ ReKi B_Y - - - "Y TLCD horizontal length" m -typedef ^ ^ ReKi area_Y - - - "Side-Side TLCD cross-sectional area of vertical column" m -typedef ^ ^ ReKi area_ratio_Y - - - "Side-Side TLCD cross-sectional area ratio (vertical column area divided by horizontal column area)" - -typedef ^ ^ ReKi headLossCoeff_Y - - - "Side-Side TLCD head loss coeff" - -typedef ^ ^ ReKi rho_Y - - - "Side-Side TLCD liquid density" "kg/m^3" -typedef ^ ^ LOGICAL Use_F_TBL - - - "use spring force from user-defined table (flag)" - -typedef ^ ^ ReKi F_TBL {:}{:} - - "user-defined spring force" "N" -typedef ^ ParameterType IntKi NumMeshPts - - - "Number of mesh points" - -typedef ^ ^ IntKi PrescribedForcesCoordSys - - - "Prescribed forces coordinate system {0: global; 1: local}" - -typedef ^ ^ ReKi StC_PrescribedForce {:}{:} - - "StC prescribed force time-series info" "(s,N,N-m)" -# ..... Inputs .................................................................................................................... -# Define inputs that are contained on the mesh here: -typedef ^ InputType MeshType Mesh {:} - - "Displacements at the StC reference point(s) P in the inertial frame" - -# ..... Outputs ................................................................................................................... -# Define outputs that are contained on the mesh here: -typedef ^ OutputType MeshType Mesh {:} - - "Loads at the StC reference points in the inertial frame" - -# Define outputs that are not on this mesh here: -#typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" diff --git a/OpenFAST/modules/servodyn/src/StrucCtrl_Types.f90 b/OpenFAST/modules/servodyn/src/StrucCtrl_Types.f90 deleted file mode 100644 index 6e56561ef..000000000 --- a/OpenFAST/modules/servodyn/src/StrucCtrl_Types.f90 +++ /dev/null @@ -1,4723 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'StrucCtrl_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 -!********************************************************************************************************************************* -! StrucCtrl_Types -!................................................................................................................................. -! This file is part of StrucCtrl. -! -! 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 StrucCtrl. 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 StrucCtrl_Types -!--------------------------------------------------------------------------------------------------------------------------------- -USE NWTC_Library -IMPLICIT NONE -! ========= StC_InputFile ======= - TYPE, PUBLIC :: StC_InputFile - CHARACTER(1024) :: StCFileName !< Name of the input file; remove if there is no file [-] - LOGICAL :: Echo !< Echo input file to echo file [-] - INTEGER(IntKi) :: StC_CMODE !< control mode {0:none; 1: Semi-Active Control Mode; 2: Active Control Mode;} [-] - INTEGER(IntKi) :: StC_SA_MODE !< Semi-Active control mode {1: velocity-based ground hook control; 2: Inverse velocity-based ground hook control; 3: displacement-based ground hook control 4: Phase difference Algorithm with Friction Force 5: Phase difference Algorithm with Damping Force} [-] - INTEGER(IntKi) :: StC_DOF_MODE !< DOF mode {0: NO StC_DOF; 1: StC_X_DOF and StC_Y_DOF; 2: StC_XY_DOF; 3: TLCD; 4: Prescribed force/moment time series} [-] - LOGICAL :: StC_X_DOF !< DOF on or off [-] - LOGICAL :: StC_Y_DOF !< DOF on or off [-] - LOGICAL :: StC_Z_DOF !< DOF on or off [-] - REAL(ReKi) :: StC_X_DSP !< StC_X initial displacement [m] - REAL(ReKi) :: StC_Y_DSP !< StC_Y initial displacement [m] - REAL(ReKi) :: StC_Z_DSP !< StC_Z initial displacement [m] - REAL(ReKi) :: StC_X_M !< StC X mass [kg] - REAL(ReKi) :: StC_Y_M !< StC Y mass [kg] - REAL(ReKi) :: StC_Z_M !< StC Z mass [kg] - REAL(ReKi) :: StC_XY_M !< StC XY mass [kg] - REAL(ReKi) :: StC_X_K !< StC X stiffness [N/m] - REAL(ReKi) :: StC_Y_K !< StC Y stiffness [N/m] - REAL(ReKi) :: StC_Z_K !< StC Y stiffness [N/m] - REAL(ReKi) :: StC_X_C !< StC X damping [N/(m/s)] - REAL(ReKi) :: StC_Y_C !< StC Y damping [N/(m/s)] - REAL(ReKi) :: StC_Z_C !< StC Z damping [N/(m/s)] - REAL(ReKi) :: StC_X_PSP !< Positive stop position (maximum X mass displacement) [m] - REAL(ReKi) :: StC_X_NSP !< Negative stop position (minimum X mass displacement) [m] - REAL(ReKi) :: StC_Y_PSP !< Positive stop position (maximum Y mass displacement) [m] - REAL(ReKi) :: StC_Y_NSP !< Negative stop position (minimum Y mass displacement) [m] - REAL(ReKi) :: StC_Z_PSP !< Positive stop position (maximum Z mass displacement) [m] - REAL(ReKi) :: StC_Z_NSP !< Negative stop position (minimum Z mass displacement) [m] - REAL(ReKi) :: StC_X_KS !< Stop spring X stiffness [N/m] - REAL(ReKi) :: StC_X_CS !< Stop spring X damping [N/(m/s)] - REAL(ReKi) :: StC_Y_KS !< Stop spring Y stiffness [N/m] - REAL(ReKi) :: StC_Y_CS !< Stop spring Y damping [N/(m/s)] - REAL(ReKi) :: StC_Z_KS !< Stop spring Z stiffness [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] [N/m] - REAL(ReKi) :: StC_Z_CS !< Stop spring Z damping [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] [N/(m/s)] - REAL(ReKi) :: StC_P_X !< StC X initial displacement (m) [relative to at rest position] [m] - REAL(ReKi) :: StC_P_Y !< StC Y initial displacement (m) [relative to at rest position] [m] - REAL(ReKi) :: StC_P_Z !< StC Z initial displacement (m) [relative to at rest position; used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] [m] - REAL(ReKi) :: StC_X_C_HIGH !< StC X high damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_X_C_LOW !< StC X low damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Y_C_HIGH !< StC Y high damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Y_C_LOW !< StC Y low damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Z_C_HIGH !< StC Z high damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Z_C_LOW !< StC Z low damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_X_C_BRAKE !< StC X high damping for braking the StC [N/(m/s)] - REAL(ReKi) :: StC_Y_C_BRAKE !< StC Y high damping for braking the StC [N/(m/s)] - REAL(ReKi) :: StC_Z_C_BRAKE !< StC Z high damping for braking the StC [N/(m/s)] - REAL(ReKi) :: L_X !< X TLCD total length [m] - REAL(ReKi) :: B_X !< X TLCD horizontal length [m] - REAL(ReKi) :: area_X !< X TLCD cross-sectional area of vertical column [m^2] - REAL(ReKi) :: area_ratio_X !< X TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] - REAL(ReKi) :: headLossCoeff_X !< X TLCD head loss coeff [-] - REAL(ReKi) :: rho_X !< X TLCD liquid density [kg/m^3] - REAL(ReKi) :: L_Y !< Y TLCD total length [m] - REAL(ReKi) :: B_Y !< Y TLCD horizontal length [m] - REAL(ReKi) :: area_Y !< Side-Side TLCD cross-sectional area of vertical column [m] - REAL(ReKi) :: area_ratio_Y !< Side-Side TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] - REAL(ReKi) :: headLossCoeff_Y !< Side-Side TLCD head loss coeff [-] - REAL(ReKi) :: rho_Y !< Side-Side TLCD liquid density [kg/m^3] - LOGICAL :: USE_F_TBL !< use spring force from user-defined table (flag) [-] - INTEGER(IntKi) :: NKInpSt !< Number of input spring force rows in table [-] - CHARACTER(1024) :: StC_F_TBL_FILE !< user-defined spring table filename [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_TBL !< user-defined spring force [N] - INTEGER(IntKi) :: PrescribedForcesCoordSys !< Prescribed forces coordinate system {0: global; 1: local} [-] - CHARACTER(1024) :: PrescribedForcesFile !< Prescribed force time-series filename [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: StC_PrescribedForce !< StC prescribed force time-series info [(s,N,N-m)] - END TYPE StC_InputFile -! ======================= -! ========= StC_InitInputType ======= - TYPE, PUBLIC :: StC_InitInputType - CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] - REAL(ReKi) , DIMENSION(1:3) :: Gravity !< Gravitational acceleration vector [m/s^2] - INTEGER(IntKi) :: NumMeshPts !< Number of mesh points [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: InitPosition !< X-Y-Z reference position of point: i.e. each blade root (3 x NumBlades) [m] - REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: InitOrientation !< DCM reference orientation of point: i.e. each blade root (3x3 x NumBlades) [-] - LOGICAL :: UseInputFile = .TRUE. !< Read from the input file. If false, must parse the string info passed [-] - TYPE(FileInfoType) :: PassedPrimaryInputData !< Primary input file as FileInfoType (set by driver/glue code) [-] - LOGICAL :: UseInputFile_PrescribeFrc = .TRUE. !< Read from the input file. If false, must parse the string info passed [-] - TYPE(FileInfoType) :: PassedPrescribeFrcData !< Prescribed forces input file as FileInfoType (set by driver/glue code) [-] - END TYPE StC_InitInputType -! ======================= -! ========= StC_InitOutputType ======= - TYPE, PUBLIC :: StC_InitOutputType - REAL(SiKi) :: DummyInitOut !< dummy init output [-] - END TYPE StC_InitOutputType -! ======================= -! ========= StC_ContinuousStateType ======= - TYPE, PUBLIC :: StC_ContinuousStateType - REAL(ReKi) :: DummyContState !< Remove this variable if you have continuous states [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: StC_x !< Continuous States -- StrucCtrl x [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: StC_xdot !< Continuous States -- StrucCtrl xdot [-] - END TYPE StC_ContinuousStateType -! ======================= -! ========= StC_DiscreteStateType ======= - TYPE, PUBLIC :: StC_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] - END TYPE StC_DiscreteStateType -! ======================= -! ========= StC_ConstraintStateType ======= - TYPE, PUBLIC :: StC_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] - END TYPE StC_ConstraintStateType -! ======================= -! ========= StC_OtherStateType ======= - TYPE, PUBLIC :: StC_OtherStateType - REAL(ReKi) :: DummyOtherState !< Remove this variable if you have other/logical states [-] - END TYPE StC_OtherStateType -! ======================= -! ========= StC_MiscVarType ======= - TYPE, PUBLIC :: StC_MiscVarType - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_stop !< Stop forces [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_ext !< External forces (user defined) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_fr !< Friction forces [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C_ctrl !< Controlled Damping (On/Off) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C_Brake !< Braking Damping [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_table !< Tabled Stiffness [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_k !< Factor for x and y-component stiffness force [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: a_G !< Gravitational acceleration vector, local coordinates for point [m/s^2] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: rdisp_P !< Translational displacement vector, local coordinates for point [m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: rdot_P !< Translational velocity vector, local coordinates for point [m/s] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: rddot_P !< Translational acceleration vector, local coordinates for point [m/s^2] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: omega_P !< Rotational velocity vector, local coordinates for point [rad/s] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: alpha_P !< Rotational aceeleration vector, local coordinates for point [rad/s^2] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_P !< StC force vector, local coordinates for point [N] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: M_P !< StC moment vector, local coordinates for point [N-m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Acc !< StC aggregated acceleration in X,Y local coordinates for point [m/s^2] - INTEGER(IntKi) :: PrescribedInterpIdx !< Index for interpolation of Prescribed force array [-] - END TYPE StC_MiscVarType -! ======================= -! ========= StC_ParameterType ======= - TYPE, PUBLIC :: StC_ParameterType - REAL(DbKi) :: DT !< Time step for cont. state integration & disc. state update [seconds] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] - INTEGER(IntKi) :: StC_DOF_MODE !< DOF mode {0: NO StC_DOF; 1: StC_X_DOF and StC_Y_DOF; 2: StC_XY_DOF; 3: TLCD; 4: Prescribed force/moment time series} [-] - LOGICAL :: StC_X_DOF !< DOF on or off [-] - LOGICAL :: StC_Y_DOF !< DOF on or off [-] - LOGICAL :: StC_Z_DOF !< DOF on or off [-] - REAL(ReKi) :: M_X !< StC mass [kg] - REAL(ReKi) :: M_Y !< StC mass [kg] - REAL(ReKi) :: M_Z !< StC mass [kg] - REAL(ReKi) :: M_XY !< StCXY mass [kg] - REAL(ReKi) :: K_X !< StC stiffness [N/m] - REAL(ReKi) :: K_Y !< StC stiffness [N/m] - REAL(ReKi) :: K_Z !< StC stiffness [N/m] - REAL(ReKi) :: C_X !< StC damping [N/(m/s)] - REAL(ReKi) :: C_Y !< StC damping [N/(m/s)] - REAL(ReKi) :: C_Z !< StC damping [N/(m/s)] - REAL(ReKi) , DIMENSION(1:3) :: K_S !< StC stop stiffness [N/m] - REAL(ReKi) , DIMENSION(1:3) :: C_S !< StC stop damping [N/(m/s)] - REAL(ReKi) , DIMENSION(1:3) :: P_SP !< Positive stop position (maximum mass displacement) [m] - REAL(ReKi) , DIMENSION(1:3) :: N_SP !< Negative stop position (minimum X mass displacement) [m] - REAL(ReKi) , DIMENSION(1:3) :: Gravity !< Gravitational acceleration vector [m/s^2] - INTEGER(IntKi) :: StC_CMODE !< control mode {0:none; 1: Semi-Active Control Mode; 2: Active Control Mode;} [-] - INTEGER(IntKi) :: StC_SA_MODE !< Semi-Active control mode {1: velocity-based ground hook control; 2: Inverse velocity-based ground hook control; 3: displacement-based ground hook control 4: Phase difference Algorithm with Friction Force 5: Phase difference Algorithm with Damping Force} [-] - REAL(ReKi) :: StC_X_C_HIGH !< StC X high damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_X_C_LOW !< StC X low damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Y_C_HIGH !< StC Y high damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Y_C_LOW !< StC Y low damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Z_C_HIGH !< StC Z high damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Z_C_LOW !< StC Z low damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_X_C_BRAKE !< StC X high damping for braking the StC [N/(m/s)] - REAL(ReKi) :: StC_Y_C_BRAKE !< StC Y high damping for braking the StC [N/(m/s)] - REAL(ReKi) :: StC_Z_C_BRAKE !< StC Y high damping for braking the StC [N/(m/s)] - REAL(ReKi) :: L_X !< X TLCD total length [m] - REAL(ReKi) :: B_X !< X TLCD horizontal length [m] - REAL(ReKi) :: area_X !< X TLCD cross-sectional area of vertical column [m^2] - REAL(ReKi) :: area_ratio_X !< X TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] - REAL(ReKi) :: headLossCoeff_X !< X TLCD head loss coeff [-] - REAL(ReKi) :: rho_X !< X TLCD liquid density [kg/m^3] - REAL(ReKi) :: L_Y !< Y TLCD total length [m] - REAL(ReKi) :: B_Y !< Y TLCD horizontal length [m] - REAL(ReKi) :: area_Y !< Side-Side TLCD cross-sectional area of vertical column [m] - REAL(ReKi) :: area_ratio_Y !< Side-Side TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] - REAL(ReKi) :: headLossCoeff_Y !< Side-Side TLCD head loss coeff [-] - REAL(ReKi) :: rho_Y !< Side-Side TLCD liquid density [kg/m^3] - LOGICAL :: Use_F_TBL !< use spring force from user-defined table (flag) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_TBL !< user-defined spring force [N] - INTEGER(IntKi) :: NumMeshPts !< Number of mesh points [-] - INTEGER(IntKi) :: PrescribedForcesCoordSys !< Prescribed forces coordinate system {0: global; 1: local} [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: StC_PrescribedForce !< StC prescribed force time-series info [(s,N,N-m)] - END TYPE StC_ParameterType -! ======================= -! ========= StC_InputType ======= - TYPE, PUBLIC :: StC_InputType - TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: Mesh !< Displacements at the StC reference point(s) P in the inertial frame [-] - END TYPE StC_InputType -! ======================= -! ========= StC_OutputType ======= - TYPE, PUBLIC :: StC_OutputType - TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: Mesh !< Loads at the StC reference points in the inertial frame [-] - END TYPE StC_OutputType -! ======================= -CONTAINS - SUBROUTINE StC_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(StC_InputFile), INTENT(INOUT) :: DstInputFileData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%StCFileName = SrcInputFileData%StCFileName - DstInputFileData%Echo = SrcInputFileData%Echo - DstInputFileData%StC_CMODE = SrcInputFileData%StC_CMODE - DstInputFileData%StC_SA_MODE = SrcInputFileData%StC_SA_MODE - DstInputFileData%StC_DOF_MODE = SrcInputFileData%StC_DOF_MODE - DstInputFileData%StC_X_DOF = SrcInputFileData%StC_X_DOF - DstInputFileData%StC_Y_DOF = SrcInputFileData%StC_Y_DOF - DstInputFileData%StC_Z_DOF = SrcInputFileData%StC_Z_DOF - DstInputFileData%StC_X_DSP = SrcInputFileData%StC_X_DSP - DstInputFileData%StC_Y_DSP = SrcInputFileData%StC_Y_DSP - DstInputFileData%StC_Z_DSP = SrcInputFileData%StC_Z_DSP - DstInputFileData%StC_X_M = SrcInputFileData%StC_X_M - DstInputFileData%StC_Y_M = SrcInputFileData%StC_Y_M - DstInputFileData%StC_Z_M = SrcInputFileData%StC_Z_M - DstInputFileData%StC_XY_M = SrcInputFileData%StC_XY_M - DstInputFileData%StC_X_K = SrcInputFileData%StC_X_K - DstInputFileData%StC_Y_K = SrcInputFileData%StC_Y_K - DstInputFileData%StC_Z_K = SrcInputFileData%StC_Z_K - DstInputFileData%StC_X_C = SrcInputFileData%StC_X_C - DstInputFileData%StC_Y_C = SrcInputFileData%StC_Y_C - DstInputFileData%StC_Z_C = SrcInputFileData%StC_Z_C - DstInputFileData%StC_X_PSP = SrcInputFileData%StC_X_PSP - DstInputFileData%StC_X_NSP = SrcInputFileData%StC_X_NSP - DstInputFileData%StC_Y_PSP = SrcInputFileData%StC_Y_PSP - DstInputFileData%StC_Y_NSP = SrcInputFileData%StC_Y_NSP - DstInputFileData%StC_Z_PSP = SrcInputFileData%StC_Z_PSP - DstInputFileData%StC_Z_NSP = SrcInputFileData%StC_Z_NSP - DstInputFileData%StC_X_KS = SrcInputFileData%StC_X_KS - DstInputFileData%StC_X_CS = SrcInputFileData%StC_X_CS - DstInputFileData%StC_Y_KS = SrcInputFileData%StC_Y_KS - DstInputFileData%StC_Y_CS = SrcInputFileData%StC_Y_CS - DstInputFileData%StC_Z_KS = SrcInputFileData%StC_Z_KS - DstInputFileData%StC_Z_CS = SrcInputFileData%StC_Z_CS - DstInputFileData%StC_P_X = SrcInputFileData%StC_P_X - DstInputFileData%StC_P_Y = SrcInputFileData%StC_P_Y - DstInputFileData%StC_P_Z = SrcInputFileData%StC_P_Z - DstInputFileData%StC_X_C_HIGH = SrcInputFileData%StC_X_C_HIGH - DstInputFileData%StC_X_C_LOW = SrcInputFileData%StC_X_C_LOW - DstInputFileData%StC_Y_C_HIGH = SrcInputFileData%StC_Y_C_HIGH - DstInputFileData%StC_Y_C_LOW = SrcInputFileData%StC_Y_C_LOW - DstInputFileData%StC_Z_C_HIGH = SrcInputFileData%StC_Z_C_HIGH - DstInputFileData%StC_Z_C_LOW = SrcInputFileData%StC_Z_C_LOW - DstInputFileData%StC_X_C_BRAKE = SrcInputFileData%StC_X_C_BRAKE - DstInputFileData%StC_Y_C_BRAKE = SrcInputFileData%StC_Y_C_BRAKE - DstInputFileData%StC_Z_C_BRAKE = SrcInputFileData%StC_Z_C_BRAKE - DstInputFileData%L_X = SrcInputFileData%L_X - DstInputFileData%B_X = SrcInputFileData%B_X - DstInputFileData%area_X = SrcInputFileData%area_X - DstInputFileData%area_ratio_X = SrcInputFileData%area_ratio_X - DstInputFileData%headLossCoeff_X = SrcInputFileData%headLossCoeff_X - DstInputFileData%rho_X = SrcInputFileData%rho_X - DstInputFileData%L_Y = SrcInputFileData%L_Y - DstInputFileData%B_Y = SrcInputFileData%B_Y - DstInputFileData%area_Y = SrcInputFileData%area_Y - DstInputFileData%area_ratio_Y = SrcInputFileData%area_ratio_Y - DstInputFileData%headLossCoeff_Y = SrcInputFileData%headLossCoeff_Y - DstInputFileData%rho_Y = SrcInputFileData%rho_Y - DstInputFileData%USE_F_TBL = SrcInputFileData%USE_F_TBL - DstInputFileData%NKInpSt = SrcInputFileData%NKInpSt - DstInputFileData%StC_F_TBL_FILE = SrcInputFileData%StC_F_TBL_FILE -IF (ALLOCATED(SrcInputFileData%F_TBL)) THEN - i1_l = LBOUND(SrcInputFileData%F_TBL,1) - i1_u = UBOUND(SrcInputFileData%F_TBL,1) - i2_l = LBOUND(SrcInputFileData%F_TBL,2) - i2_u = UBOUND(SrcInputFileData%F_TBL,2) - IF (.NOT. ALLOCATED(DstInputFileData%F_TBL)) THEN - ALLOCATE(DstInputFileData%F_TBL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%F_TBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%F_TBL = SrcInputFileData%F_TBL -ENDIF - DstInputFileData%PrescribedForcesCoordSys = SrcInputFileData%PrescribedForcesCoordSys - DstInputFileData%PrescribedForcesFile = SrcInputFileData%PrescribedForcesFile -IF (ALLOCATED(SrcInputFileData%StC_PrescribedForce)) THEN - i1_l = LBOUND(SrcInputFileData%StC_PrescribedForce,1) - i1_u = UBOUND(SrcInputFileData%StC_PrescribedForce,1) - i2_l = LBOUND(SrcInputFileData%StC_PrescribedForce,2) - i2_u = UBOUND(SrcInputFileData%StC_PrescribedForce,2) - IF (.NOT. ALLOCATED(DstInputFileData%StC_PrescribedForce)) THEN - ALLOCATE(DstInputFileData%StC_PrescribedForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%StC_PrescribedForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%StC_PrescribedForce = SrcInputFileData%StC_PrescribedForce -ENDIF - END SUBROUTINE StC_CopyInputFile - - SUBROUTINE StC_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(StC_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyInputFile' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InputFileData%F_TBL)) THEN - DEALLOCATE(InputFileData%F_TBL) -ENDIF -IF (ALLOCATED(InputFileData%StC_PrescribedForce)) THEN - DEALLOCATE(InputFileData%StC_PrescribedForce) -ENDIF - END SUBROUTINE StC_DestroyInputFile - - SUBROUTINE StC_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_InputFile), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackInputFile' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%StCFileName) ! StCFileName - Int_BufSz = Int_BufSz + 1 ! Echo - Int_BufSz = Int_BufSz + 1 ! StC_CMODE - Int_BufSz = Int_BufSz + 1 ! StC_SA_MODE - Int_BufSz = Int_BufSz + 1 ! StC_DOF_MODE - Int_BufSz = Int_BufSz + 1 ! StC_X_DOF - Int_BufSz = Int_BufSz + 1 ! StC_Y_DOF - Int_BufSz = Int_BufSz + 1 ! StC_Z_DOF - Re_BufSz = Re_BufSz + 1 ! StC_X_DSP - Re_BufSz = Re_BufSz + 1 ! StC_Y_DSP - Re_BufSz = Re_BufSz + 1 ! StC_Z_DSP - Re_BufSz = Re_BufSz + 1 ! StC_X_M - Re_BufSz = Re_BufSz + 1 ! StC_Y_M - Re_BufSz = Re_BufSz + 1 ! StC_Z_M - Re_BufSz = Re_BufSz + 1 ! StC_XY_M - Re_BufSz = Re_BufSz + 1 ! StC_X_K - Re_BufSz = Re_BufSz + 1 ! StC_Y_K - Re_BufSz = Re_BufSz + 1 ! StC_Z_K - Re_BufSz = Re_BufSz + 1 ! StC_X_C - Re_BufSz = Re_BufSz + 1 ! StC_Y_C - Re_BufSz = Re_BufSz + 1 ! StC_Z_C - Re_BufSz = Re_BufSz + 1 ! StC_X_PSP - Re_BufSz = Re_BufSz + 1 ! StC_X_NSP - Re_BufSz = Re_BufSz + 1 ! StC_Y_PSP - Re_BufSz = Re_BufSz + 1 ! StC_Y_NSP - Re_BufSz = Re_BufSz + 1 ! StC_Z_PSP - Re_BufSz = Re_BufSz + 1 ! StC_Z_NSP - Re_BufSz = Re_BufSz + 1 ! StC_X_KS - Re_BufSz = Re_BufSz + 1 ! StC_X_CS - Re_BufSz = Re_BufSz + 1 ! StC_Y_KS - Re_BufSz = Re_BufSz + 1 ! StC_Y_CS - Re_BufSz = Re_BufSz + 1 ! StC_Z_KS - Re_BufSz = Re_BufSz + 1 ! StC_Z_CS - Re_BufSz = Re_BufSz + 1 ! StC_P_X - Re_BufSz = Re_BufSz + 1 ! StC_P_Y - Re_BufSz = Re_BufSz + 1 ! StC_P_Z - Re_BufSz = Re_BufSz + 1 ! StC_X_C_HIGH - Re_BufSz = Re_BufSz + 1 ! StC_X_C_LOW - Re_BufSz = Re_BufSz + 1 ! StC_Y_C_HIGH - Re_BufSz = Re_BufSz + 1 ! StC_Y_C_LOW - Re_BufSz = Re_BufSz + 1 ! StC_Z_C_HIGH - Re_BufSz = Re_BufSz + 1 ! StC_Z_C_LOW - Re_BufSz = Re_BufSz + 1 ! StC_X_C_BRAKE - Re_BufSz = Re_BufSz + 1 ! StC_Y_C_BRAKE - Re_BufSz = Re_BufSz + 1 ! StC_Z_C_BRAKE - Re_BufSz = Re_BufSz + 1 ! L_X - Re_BufSz = Re_BufSz + 1 ! B_X - Re_BufSz = Re_BufSz + 1 ! area_X - Re_BufSz = Re_BufSz + 1 ! area_ratio_X - Re_BufSz = Re_BufSz + 1 ! headLossCoeff_X - Re_BufSz = Re_BufSz + 1 ! rho_X - Re_BufSz = Re_BufSz + 1 ! L_Y - Re_BufSz = Re_BufSz + 1 ! B_Y - Re_BufSz = Re_BufSz + 1 ! area_Y - Re_BufSz = Re_BufSz + 1 ! area_ratio_Y - Re_BufSz = Re_BufSz + 1 ! headLossCoeff_Y - Re_BufSz = Re_BufSz + 1 ! rho_Y - Int_BufSz = Int_BufSz + 1 ! USE_F_TBL - Int_BufSz = Int_BufSz + 1 ! NKInpSt - Int_BufSz = Int_BufSz + 1*LEN(InData%StC_F_TBL_FILE) ! StC_F_TBL_FILE - Int_BufSz = Int_BufSz + 1 ! F_TBL allocated yes/no - IF ( ALLOCATED(InData%F_TBL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_TBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_TBL) ! F_TBL - END IF - Int_BufSz = Int_BufSz + 1 ! PrescribedForcesCoordSys - Int_BufSz = Int_BufSz + 1*LEN(InData%PrescribedForcesFile) ! PrescribedForcesFile - Int_BufSz = Int_BufSz + 1 ! StC_PrescribedForce allocated yes/no - IF ( ALLOCATED(InData%StC_PrescribedForce) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StC_PrescribedForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StC_PrescribedForce) ! StC_PrescribedForce - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%StCFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%StCFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%StC_CMODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%StC_SA_MODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%StC_DOF_MODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%StC_X_DOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%StC_Y_DOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%StC_Z_DOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_DSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_DSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_DSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_XY_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_K - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_K - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_K - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_C - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_C - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_C - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_PSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_NSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_PSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_NSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_PSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_NSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_KS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_CS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_KS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_CS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_KS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_CS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_P_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_P_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_P_Z - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%L_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%B_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_ratio_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%headLossCoeff_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rho_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%L_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%B_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_ratio_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%headLossCoeff_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rho_Y - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%USE_F_TBL, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NKInpSt - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%StC_F_TBL_FILE) - IntKiBuf(Int_Xferred) = ICHAR(InData%StC_F_TBL_FILE(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%F_TBL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_TBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_TBL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_TBL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_TBL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_TBL,2), UBOUND(InData%F_TBL,2) - DO i1 = LBOUND(InData%F_TBL,1), UBOUND(InData%F_TBL,1) - ReKiBuf(Re_Xferred) = InData%F_TBL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%PrescribedForcesCoordSys - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%PrescribedForcesFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%PrescribedForcesFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%StC_PrescribedForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StC_PrescribedForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_PrescribedForce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StC_PrescribedForce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_PrescribedForce,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StC_PrescribedForce,2), UBOUND(InData%StC_PrescribedForce,2) - DO i1 = LBOUND(InData%StC_PrescribedForce,1), UBOUND(InData%StC_PrescribedForce,1) - ReKiBuf(Re_Xferred) = InData%StC_PrescribedForce(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_PackInputFile - - SUBROUTINE StC_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_InputFile), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackInputFile' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%StCFileName) - OutData%StCFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_Xferred + 1 - OutData%StC_CMODE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%StC_SA_MODE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%StC_DOF_MODE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%StC_X_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%StC_X_DOF) - Int_Xferred = Int_Xferred + 1 - OutData%StC_Y_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%StC_Y_DOF) - Int_Xferred = Int_Xferred + 1 - OutData%StC_Z_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%StC_Z_DOF) - Int_Xferred = Int_Xferred + 1 - OutData%StC_X_DSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_DSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_DSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_M = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_M = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_M = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_XY_M = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_K = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_K = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_K = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_C = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_C = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_C = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_PSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_NSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_PSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_NSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_PSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_NSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_KS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_CS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_KS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_CS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_KS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_CS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_P_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_P_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_P_Z = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_C_HIGH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_C_LOW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_C_HIGH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_C_LOW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_C_HIGH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_C_LOW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_C_BRAKE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_C_BRAKE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_C_BRAKE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%L_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%B_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_ratio_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%headLossCoeff_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rho_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%L_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%B_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_ratio_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%headLossCoeff_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rho_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%USE_F_TBL = TRANSFER(IntKiBuf(Int_Xferred), OutData%USE_F_TBL) - Int_Xferred = Int_Xferred + 1 - OutData%NKInpSt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%StC_F_TBL_FILE) - OutData%StC_F_TBL_FILE(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_TBL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_TBL)) DEALLOCATE(OutData%F_TBL) - ALLOCATE(OutData%F_TBL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_TBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_TBL,2), UBOUND(OutData%F_TBL,2) - DO i1 = LBOUND(OutData%F_TBL,1), UBOUND(OutData%F_TBL,1) - OutData%F_TBL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%PrescribedForcesCoordSys = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%PrescribedForcesFile) - OutData%PrescribedForcesFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StC_PrescribedForce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StC_PrescribedForce)) DEALLOCATE(OutData%StC_PrescribedForce) - ALLOCATE(OutData%StC_PrescribedForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_PrescribedForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StC_PrescribedForce,2), UBOUND(OutData%StC_PrescribedForce,2) - DO i1 = LBOUND(OutData%StC_PrescribedForce,1), UBOUND(OutData%StC_PrescribedForce,1) - OutData%StC_PrescribedForce(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_UnPackInputFile - - SUBROUTINE StC_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(StC_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%NumMeshPts = SrcInitInputData%NumMeshPts -IF (ALLOCATED(SrcInitInputData%InitPosition)) THEN - i1_l = LBOUND(SrcInitInputData%InitPosition,1) - i1_u = UBOUND(SrcInitInputData%InitPosition,1) - i2_l = LBOUND(SrcInitInputData%InitPosition,2) - i2_u = UBOUND(SrcInitInputData%InitPosition,2) - IF (.NOT. ALLOCATED(DstInitInputData%InitPosition)) THEN - ALLOCATE(DstInitInputData%InitPosition(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%InitPosition = SrcInitInputData%InitPosition -ENDIF -IF (ALLOCATED(SrcInitInputData%InitOrientation)) THEN - i1_l = LBOUND(SrcInitInputData%InitOrientation,1) - i1_u = UBOUND(SrcInitInputData%InitOrientation,1) - i2_l = LBOUND(SrcInitInputData%InitOrientation,2) - i2_u = UBOUND(SrcInitInputData%InitOrientation,2) - i3_l = LBOUND(SrcInitInputData%InitOrientation,3) - i3_u = UBOUND(SrcInitInputData%InitOrientation,3) - IF (.NOT. ALLOCATED(DstInitInputData%InitOrientation)) THEN - ALLOCATE(DstInitInputData%InitOrientation(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitOrientation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%InitOrientation = SrcInitInputData%InitOrientation -ENDIF - DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%UseInputFile_PrescribeFrc = SrcInitInputData%UseInputFile_PrescribeFrc - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedPrescribeFrcData, DstInitInputData%PassedPrescribeFrcData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE StC_CopyInitInput - - SUBROUTINE StC_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(StC_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyInitInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitInputData%InitPosition)) THEN - DEALLOCATE(InitInputData%InitPosition) -ENDIF -IF (ALLOCATED(InitInputData%InitOrientation)) THEN - DEALLOCATE(InitInputData%InitOrientation) -ENDIF - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedPrimaryInputData, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedPrescribeFrcData, ErrStat, ErrMsg ) - END SUBROUTINE StC_DestroyInitInput - - SUBROUTINE StC_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + SIZE(InData%Gravity) ! Gravity - Int_BufSz = Int_BufSz + 1 ! NumMeshPts - Int_BufSz = Int_BufSz + 1 ! InitPosition allocated yes/no - IF ( ALLOCATED(InData%InitPosition) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitPosition upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitPosition) ! InitPosition - END IF - Int_BufSz = Int_BufSz + 1 ! InitOrientation allocated yes/no - IF ( ALLOCATED(InData%InitOrientation) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! InitOrientation upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InitOrientation) ! InitOrientation - END IF - Int_BufSz = Int_BufSz + 1 ! UseInputFile - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PassedPrimaryInputData: size of buffers for each call to pack subtype - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedPrimaryInputData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedPrimaryInputData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedPrimaryInputData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedPrimaryInputData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! UseInputFile_PrescribeFrc - Int_BufSz = Int_BufSz + 3 ! PassedPrescribeFrcData: size of buffers for each call to pack subtype - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrescribeFrcData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedPrescribeFrcData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedPrescribeFrcData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedPrescribeFrcData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedPrescribeFrcData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO i1 = LBOUND(InData%Gravity,1), UBOUND(InData%Gravity,1) - ReKiBuf(Re_Xferred) = InData%Gravity(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NumMeshPts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%InitPosition) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitPosition,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitPosition,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitPosition,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitPosition,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitPosition,2), UBOUND(InData%InitPosition,2) - DO i1 = LBOUND(InData%InitPosition,1), UBOUND(InData%InitPosition,1) - ReKiBuf(Re_Xferred) = InData%InitPosition(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitOrientation) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitOrientation,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitOrientation,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitOrientation,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitOrientation,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitOrientation,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitOrientation,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%InitOrientation,3), UBOUND(InData%InitOrientation,3) - DO i2 = LBOUND(InData%InitOrientation,2), UBOUND(InData%InitOrientation,2) - DO i1 = LBOUND(InData%InitOrientation,1), UBOUND(InData%InitOrientation,1) - DbKiBuf(Db_Xferred) = InData%InitOrientation(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, OnlySize ) ! PassedPrimaryInputData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile_PrescribeFrc, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrescribeFrcData, ErrStat2, ErrMsg2, OnlySize ) ! PassedPrescribeFrcData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE StC_PackInitInput - - SUBROUTINE StC_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - i1_l = LBOUND(OutData%Gravity,1) - i1_u = UBOUND(OutData%Gravity,1) - DO i1 = LBOUND(OutData%Gravity,1), UBOUND(OutData%Gravity,1) - OutData%Gravity(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%NumMeshPts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitPosition not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InitPosition)) DEALLOCATE(OutData%InitPosition) - ALLOCATE(OutData%InitPosition(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitPosition,2), UBOUND(OutData%InitPosition,2) - DO i1 = LBOUND(OutData%InitPosition,1), UBOUND(OutData%InitPosition,1) - OutData%InitPosition(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitOrientation not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InitOrientation)) DEALLOCATE(OutData%InitOrientation) - ALLOCATE(OutData%InitOrientation(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitOrientation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%InitOrientation,3), UBOUND(OutData%InitOrientation,3) - DO i2 = LBOUND(OutData%InitOrientation,2), UBOUND(OutData%InitOrientation,2) - DO i1 = LBOUND(OutData%InitOrientation,1), UBOUND(OutData%InitOrientation,1) - OutData%InitOrientation(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackfileinfotype( Re_Buf, Db_Buf, Int_Buf, OutData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) ! PassedPrimaryInputData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%UseInputFile_PrescribeFrc = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile_PrescribeFrc) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackfileinfotype( Re_Buf, Db_Buf, Int_Buf, OutData%PassedPrescribeFrcData, ErrStat2, ErrMsg2 ) ! PassedPrescribeFrcData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE StC_UnPackInitInput - - SUBROUTINE StC_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(StC_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%DummyInitOut = SrcInitOutputData%DummyInitOut - END SUBROUTINE StC_CopyInitOutput - - SUBROUTINE StC_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(StC_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyInitOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE StC_DestroyInitOutput - - SUBROUTINE StC_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyInitOut - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyInitOut - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE StC_PackInitOutput - - SUBROUTINE StC_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyInitOut = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE StC_UnPackInitOutput - - SUBROUTINE StC_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(StC_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState -IF (ALLOCATED(SrcContStateData%StC_x)) THEN - i1_l = LBOUND(SrcContStateData%StC_x,1) - i1_u = UBOUND(SrcContStateData%StC_x,1) - i2_l = LBOUND(SrcContStateData%StC_x,2) - i2_u = UBOUND(SrcContStateData%StC_x,2) - IF (.NOT. ALLOCATED(DstContStateData%StC_x)) THEN - ALLOCATE(DstContStateData%StC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%StC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%StC_x = SrcContStateData%StC_x -ENDIF -IF (ALLOCATED(SrcContStateData%StC_xdot)) THEN - i1_l = LBOUND(SrcContStateData%StC_xdot,1) - i1_u = UBOUND(SrcContStateData%StC_xdot,1) - i2_l = LBOUND(SrcContStateData%StC_xdot,2) - i2_u = UBOUND(SrcContStateData%StC_xdot,2) - IF (.NOT. ALLOCATED(DstContStateData%StC_xdot)) THEN - ALLOCATE(DstContStateData%StC_xdot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%StC_xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%StC_xdot = SrcContStateData%StC_xdot -ENDIF - END SUBROUTINE StC_CopyContState - - SUBROUTINE StC_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(StC_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyContState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ContStateData%StC_x)) THEN - DEALLOCATE(ContStateData%StC_x) -ENDIF -IF (ALLOCATED(ContStateData%StC_xdot)) THEN - DEALLOCATE(ContStateData%StC_xdot) -ENDIF - END SUBROUTINE StC_DestroyContState - - SUBROUTINE StC_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyContState - Int_BufSz = Int_BufSz + 1 ! StC_x allocated yes/no - IF ( ALLOCATED(InData%StC_x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StC_x upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StC_x) ! StC_x - END IF - Int_BufSz = Int_BufSz + 1 ! StC_xdot allocated yes/no - IF ( ALLOCATED(InData%StC_xdot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StC_xdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StC_xdot) ! StC_xdot - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%StC_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StC_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StC_x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_x,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StC_x,2), UBOUND(InData%StC_x,2) - DO i1 = LBOUND(InData%StC_x,1), UBOUND(InData%StC_x,1) - ReKiBuf(Re_Xferred) = InData%StC_x(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StC_xdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StC_xdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_xdot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StC_xdot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_xdot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StC_xdot,2), UBOUND(InData%StC_xdot,2) - DO i1 = LBOUND(InData%StC_xdot,1), UBOUND(InData%StC_xdot,1) - ReKiBuf(Re_Xferred) = InData%StC_xdot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_PackContState - - SUBROUTINE StC_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyContState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StC_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StC_x)) DEALLOCATE(OutData%StC_x) - ALLOCATE(OutData%StC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StC_x,2), UBOUND(OutData%StC_x,2) - DO i1 = LBOUND(OutData%StC_x,1), UBOUND(OutData%StC_x,1) - OutData%StC_x(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StC_xdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StC_xdot)) DEALLOCATE(OutData%StC_xdot) - ALLOCATE(OutData%StC_xdot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StC_xdot,2), UBOUND(OutData%StC_xdot,2) - DO i1 = LBOUND(OutData%StC_xdot,1), UBOUND(OutData%StC_xdot,1) - OutData%StC_xdot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_UnPackContState - - SUBROUTINE StC_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(StC_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE StC_CopyDiscState - - SUBROUTINE StC_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(StC_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyDiscState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE StC_DestroyDiscState - - SUBROUTINE StC_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyDiscState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE StC_PackDiscState - - SUBROUTINE StC_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE StC_UnPackDiscState - - SUBROUTINE StC_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(StC_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE StC_CopyConstrState - - SUBROUTINE StC_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(StC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyConstrState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE StC_DestroyConstrState - - SUBROUTINE StC_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE StC_PackConstrState - - SUBROUTINE StC_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE StC_UnPackConstrState - - SUBROUTINE StC_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(StC_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE StC_CopyOtherState - - SUBROUTINE StC_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(StC_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyOtherState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE StC_DestroyOtherState - - SUBROUTINE StC_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyOtherState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE StC_PackOtherState - - SUBROUTINE StC_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyOtherState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE StC_UnPackOtherState - - SUBROUTINE StC_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(StC_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%F_stop)) THEN - i1_l = LBOUND(SrcMiscData%F_stop,1) - i1_u = UBOUND(SrcMiscData%F_stop,1) - i2_l = LBOUND(SrcMiscData%F_stop,2) - i2_u = UBOUND(SrcMiscData%F_stop,2) - IF (.NOT. ALLOCATED(DstMiscData%F_stop)) THEN - ALLOCATE(DstMiscData%F_stop(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_stop.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_stop = SrcMiscData%F_stop -ENDIF -IF (ALLOCATED(SrcMiscData%F_ext)) THEN - i1_l = LBOUND(SrcMiscData%F_ext,1) - i1_u = UBOUND(SrcMiscData%F_ext,1) - i2_l = LBOUND(SrcMiscData%F_ext,2) - i2_u = UBOUND(SrcMiscData%F_ext,2) - IF (.NOT. ALLOCATED(DstMiscData%F_ext)) THEN - ALLOCATE(DstMiscData%F_ext(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_ext.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_ext = SrcMiscData%F_ext -ENDIF -IF (ALLOCATED(SrcMiscData%F_fr)) THEN - i1_l = LBOUND(SrcMiscData%F_fr,1) - i1_u = UBOUND(SrcMiscData%F_fr,1) - i2_l = LBOUND(SrcMiscData%F_fr,2) - i2_u = UBOUND(SrcMiscData%F_fr,2) - IF (.NOT. ALLOCATED(DstMiscData%F_fr)) THEN - ALLOCATE(DstMiscData%F_fr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_fr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_fr = SrcMiscData%F_fr -ENDIF -IF (ALLOCATED(SrcMiscData%C_ctrl)) THEN - i1_l = LBOUND(SrcMiscData%C_ctrl,1) - i1_u = UBOUND(SrcMiscData%C_ctrl,1) - i2_l = LBOUND(SrcMiscData%C_ctrl,2) - i2_u = UBOUND(SrcMiscData%C_ctrl,2) - IF (.NOT. ALLOCATED(DstMiscData%C_ctrl)) THEN - ALLOCATE(DstMiscData%C_ctrl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%C_ctrl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%C_ctrl = SrcMiscData%C_ctrl -ENDIF -IF (ALLOCATED(SrcMiscData%C_Brake)) THEN - i1_l = LBOUND(SrcMiscData%C_Brake,1) - i1_u = UBOUND(SrcMiscData%C_Brake,1) - i2_l = LBOUND(SrcMiscData%C_Brake,2) - i2_u = UBOUND(SrcMiscData%C_Brake,2) - IF (.NOT. ALLOCATED(DstMiscData%C_Brake)) THEN - ALLOCATE(DstMiscData%C_Brake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%C_Brake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%C_Brake = SrcMiscData%C_Brake -ENDIF -IF (ALLOCATED(SrcMiscData%F_table)) THEN - i1_l = LBOUND(SrcMiscData%F_table,1) - i1_u = UBOUND(SrcMiscData%F_table,1) - i2_l = LBOUND(SrcMiscData%F_table,2) - i2_u = UBOUND(SrcMiscData%F_table,2) - IF (.NOT. ALLOCATED(DstMiscData%F_table)) THEN - ALLOCATE(DstMiscData%F_table(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_table.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_table = SrcMiscData%F_table -ENDIF -IF (ALLOCATED(SrcMiscData%F_k)) THEN - i1_l = LBOUND(SrcMiscData%F_k,1) - i1_u = UBOUND(SrcMiscData%F_k,1) - i2_l = LBOUND(SrcMiscData%F_k,2) - i2_u = UBOUND(SrcMiscData%F_k,2) - IF (.NOT. ALLOCATED(DstMiscData%F_k)) THEN - ALLOCATE(DstMiscData%F_k(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_k.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_k = SrcMiscData%F_k -ENDIF -IF (ALLOCATED(SrcMiscData%a_G)) THEN - i1_l = LBOUND(SrcMiscData%a_G,1) - i1_u = UBOUND(SrcMiscData%a_G,1) - i2_l = LBOUND(SrcMiscData%a_G,2) - i2_u = UBOUND(SrcMiscData%a_G,2) - IF (.NOT. ALLOCATED(DstMiscData%a_G)) THEN - ALLOCATE(DstMiscData%a_G(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%a_G.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%a_G = SrcMiscData%a_G -ENDIF -IF (ALLOCATED(SrcMiscData%rdisp_P)) THEN - i1_l = LBOUND(SrcMiscData%rdisp_P,1) - i1_u = UBOUND(SrcMiscData%rdisp_P,1) - i2_l = LBOUND(SrcMiscData%rdisp_P,2) - i2_u = UBOUND(SrcMiscData%rdisp_P,2) - IF (.NOT. ALLOCATED(DstMiscData%rdisp_P)) THEN - ALLOCATE(DstMiscData%rdisp_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rdisp_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rdisp_P = SrcMiscData%rdisp_P -ENDIF -IF (ALLOCATED(SrcMiscData%rdot_P)) THEN - i1_l = LBOUND(SrcMiscData%rdot_P,1) - i1_u = UBOUND(SrcMiscData%rdot_P,1) - i2_l = LBOUND(SrcMiscData%rdot_P,2) - i2_u = UBOUND(SrcMiscData%rdot_P,2) - IF (.NOT. ALLOCATED(DstMiscData%rdot_P)) THEN - ALLOCATE(DstMiscData%rdot_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rdot_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rdot_P = SrcMiscData%rdot_P -ENDIF -IF (ALLOCATED(SrcMiscData%rddot_P)) THEN - i1_l = LBOUND(SrcMiscData%rddot_P,1) - i1_u = UBOUND(SrcMiscData%rddot_P,1) - i2_l = LBOUND(SrcMiscData%rddot_P,2) - i2_u = UBOUND(SrcMiscData%rddot_P,2) - IF (.NOT. ALLOCATED(DstMiscData%rddot_P)) THEN - ALLOCATE(DstMiscData%rddot_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rddot_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rddot_P = SrcMiscData%rddot_P -ENDIF -IF (ALLOCATED(SrcMiscData%omega_P)) THEN - i1_l = LBOUND(SrcMiscData%omega_P,1) - i1_u = UBOUND(SrcMiscData%omega_P,1) - i2_l = LBOUND(SrcMiscData%omega_P,2) - i2_u = UBOUND(SrcMiscData%omega_P,2) - IF (.NOT. ALLOCATED(DstMiscData%omega_P)) THEN - ALLOCATE(DstMiscData%omega_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%omega_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%omega_P = SrcMiscData%omega_P -ENDIF -IF (ALLOCATED(SrcMiscData%alpha_P)) THEN - i1_l = LBOUND(SrcMiscData%alpha_P,1) - i1_u = UBOUND(SrcMiscData%alpha_P,1) - i2_l = LBOUND(SrcMiscData%alpha_P,2) - i2_u = UBOUND(SrcMiscData%alpha_P,2) - IF (.NOT. ALLOCATED(DstMiscData%alpha_P)) THEN - ALLOCATE(DstMiscData%alpha_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%alpha_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%alpha_P = SrcMiscData%alpha_P -ENDIF -IF (ALLOCATED(SrcMiscData%F_P)) THEN - i1_l = LBOUND(SrcMiscData%F_P,1) - i1_u = UBOUND(SrcMiscData%F_P,1) - i2_l = LBOUND(SrcMiscData%F_P,2) - i2_u = UBOUND(SrcMiscData%F_P,2) - IF (.NOT. ALLOCATED(DstMiscData%F_P)) THEN - ALLOCATE(DstMiscData%F_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_P = SrcMiscData%F_P -ENDIF -IF (ALLOCATED(SrcMiscData%M_P)) THEN - i1_l = LBOUND(SrcMiscData%M_P,1) - i1_u = UBOUND(SrcMiscData%M_P,1) - i2_l = LBOUND(SrcMiscData%M_P,2) - i2_u = UBOUND(SrcMiscData%M_P,2) - IF (.NOT. ALLOCATED(DstMiscData%M_P)) THEN - ALLOCATE(DstMiscData%M_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%M_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%M_P = SrcMiscData%M_P -ENDIF -IF (ALLOCATED(SrcMiscData%Acc)) THEN - i1_l = LBOUND(SrcMiscData%Acc,1) - i1_u = UBOUND(SrcMiscData%Acc,1) - i2_l = LBOUND(SrcMiscData%Acc,2) - i2_u = UBOUND(SrcMiscData%Acc,2) - IF (.NOT. ALLOCATED(DstMiscData%Acc)) THEN - ALLOCATE(DstMiscData%Acc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Acc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Acc = SrcMiscData%Acc -ENDIF - DstMiscData%PrescribedInterpIdx = SrcMiscData%PrescribedInterpIdx - END SUBROUTINE StC_CopyMisc - - SUBROUTINE StC_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(StC_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyMisc' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(MiscData%F_stop)) THEN - DEALLOCATE(MiscData%F_stop) -ENDIF -IF (ALLOCATED(MiscData%F_ext)) THEN - DEALLOCATE(MiscData%F_ext) -ENDIF -IF (ALLOCATED(MiscData%F_fr)) THEN - DEALLOCATE(MiscData%F_fr) -ENDIF -IF (ALLOCATED(MiscData%C_ctrl)) THEN - DEALLOCATE(MiscData%C_ctrl) -ENDIF -IF (ALLOCATED(MiscData%C_Brake)) THEN - DEALLOCATE(MiscData%C_Brake) -ENDIF -IF (ALLOCATED(MiscData%F_table)) THEN - DEALLOCATE(MiscData%F_table) -ENDIF -IF (ALLOCATED(MiscData%F_k)) THEN - DEALLOCATE(MiscData%F_k) -ENDIF -IF (ALLOCATED(MiscData%a_G)) THEN - DEALLOCATE(MiscData%a_G) -ENDIF -IF (ALLOCATED(MiscData%rdisp_P)) THEN - DEALLOCATE(MiscData%rdisp_P) -ENDIF -IF (ALLOCATED(MiscData%rdot_P)) THEN - DEALLOCATE(MiscData%rdot_P) -ENDIF -IF (ALLOCATED(MiscData%rddot_P)) THEN - DEALLOCATE(MiscData%rddot_P) -ENDIF -IF (ALLOCATED(MiscData%omega_P)) THEN - DEALLOCATE(MiscData%omega_P) -ENDIF -IF (ALLOCATED(MiscData%alpha_P)) THEN - DEALLOCATE(MiscData%alpha_P) -ENDIF -IF (ALLOCATED(MiscData%F_P)) THEN - DEALLOCATE(MiscData%F_P) -ENDIF -IF (ALLOCATED(MiscData%M_P)) THEN - DEALLOCATE(MiscData%M_P) -ENDIF -IF (ALLOCATED(MiscData%Acc)) THEN - DEALLOCATE(MiscData%Acc) -ENDIF - END SUBROUTINE StC_DestroyMisc - - SUBROUTINE StC_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! F_stop allocated yes/no - IF ( ALLOCATED(InData%F_stop) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_stop upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_stop) ! F_stop - END IF - Int_BufSz = Int_BufSz + 1 ! F_ext allocated yes/no - IF ( ALLOCATED(InData%F_ext) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_ext upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_ext) ! F_ext - END IF - Int_BufSz = Int_BufSz + 1 ! F_fr allocated yes/no - IF ( ALLOCATED(InData%F_fr) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_fr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_fr) ! F_fr - END IF - Int_BufSz = Int_BufSz + 1 ! C_ctrl allocated yes/no - IF ( ALLOCATED(InData%C_ctrl) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C_ctrl upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C_ctrl) ! C_ctrl - END IF - Int_BufSz = Int_BufSz + 1 ! C_Brake allocated yes/no - IF ( ALLOCATED(InData%C_Brake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C_Brake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C_Brake) ! C_Brake - END IF - Int_BufSz = Int_BufSz + 1 ! F_table allocated yes/no - IF ( ALLOCATED(InData%F_table) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_table upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_table) ! F_table - END IF - Int_BufSz = Int_BufSz + 1 ! F_k allocated yes/no - IF ( ALLOCATED(InData%F_k) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_k upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_k) ! F_k - END IF - Int_BufSz = Int_BufSz + 1 ! a_G allocated yes/no - IF ( ALLOCATED(InData%a_G) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! a_G upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%a_G) ! a_G - END IF - Int_BufSz = Int_BufSz + 1 ! rdisp_P allocated yes/no - IF ( ALLOCATED(InData%rdisp_P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rdisp_P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdisp_P) ! rdisp_P - END IF - Int_BufSz = Int_BufSz + 1 ! rdot_P allocated yes/no - IF ( ALLOCATED(InData%rdot_P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rdot_P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdot_P) ! rdot_P - END IF - Int_BufSz = Int_BufSz + 1 ! rddot_P allocated yes/no - IF ( ALLOCATED(InData%rddot_P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rddot_P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rddot_P) ! rddot_P - END IF - Int_BufSz = Int_BufSz + 1 ! omega_P allocated yes/no - IF ( ALLOCATED(InData%omega_P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! omega_P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%omega_P) ! omega_P - END IF - Int_BufSz = Int_BufSz + 1 ! alpha_P allocated yes/no - IF ( ALLOCATED(InData%alpha_P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! alpha_P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_P) ! alpha_P - END IF - Int_BufSz = Int_BufSz + 1 ! F_P allocated yes/no - IF ( ALLOCATED(InData%F_P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_P) ! F_P - END IF - Int_BufSz = Int_BufSz + 1 ! M_P allocated yes/no - IF ( ALLOCATED(InData%M_P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M_P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%M_P) ! M_P - END IF - Int_BufSz = Int_BufSz + 1 ! Acc allocated yes/no - IF ( ALLOCATED(InData%Acc) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Acc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Acc) ! Acc - END IF - Int_BufSz = Int_BufSz + 1 ! PrescribedInterpIdx - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%F_stop) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_stop,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_stop,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_stop,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_stop,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_stop,2), UBOUND(InData%F_stop,2) - DO i1 = LBOUND(InData%F_stop,1), UBOUND(InData%F_stop,1) - ReKiBuf(Re_Xferred) = InData%F_stop(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_ext) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_ext,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_ext,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_ext,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_ext,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_ext,2), UBOUND(InData%F_ext,2) - DO i1 = LBOUND(InData%F_ext,1), UBOUND(InData%F_ext,1) - ReKiBuf(Re_Xferred) = InData%F_ext(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_fr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_fr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_fr,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_fr,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_fr,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_fr,2), UBOUND(InData%F_fr,2) - DO i1 = LBOUND(InData%F_fr,1), UBOUND(InData%F_fr,1) - ReKiBuf(Re_Xferred) = InData%F_fr(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C_ctrl) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C_ctrl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C_ctrl,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C_ctrl,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C_ctrl,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C_ctrl,2), UBOUND(InData%C_ctrl,2) - DO i1 = LBOUND(InData%C_ctrl,1), UBOUND(InData%C_ctrl,1) - ReKiBuf(Re_Xferred) = InData%C_ctrl(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C_Brake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C_Brake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C_Brake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C_Brake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C_Brake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C_Brake,2), UBOUND(InData%C_Brake,2) - DO i1 = LBOUND(InData%C_Brake,1), UBOUND(InData%C_Brake,1) - ReKiBuf(Re_Xferred) = InData%C_Brake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_table) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_table,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_table,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_table,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_table,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_table,2), UBOUND(InData%F_table,2) - DO i1 = LBOUND(InData%F_table,1), UBOUND(InData%F_table,1) - ReKiBuf(Re_Xferred) = InData%F_table(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_k) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_k,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_k,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_k,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_k,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_k,2), UBOUND(InData%F_k,2) - DO i1 = LBOUND(InData%F_k,1), UBOUND(InData%F_k,1) - ReKiBuf(Re_Xferred) = InData%F_k(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%a_G) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%a_G,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%a_G,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%a_G,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%a_G,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%a_G,2), UBOUND(InData%a_G,2) - DO i1 = LBOUND(InData%a_G,1), UBOUND(InData%a_G,1) - ReKiBuf(Re_Xferred) = InData%a_G(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rdisp_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdisp_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdisp_P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdisp_P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdisp_P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rdisp_P,2), UBOUND(InData%rdisp_P,2) - DO i1 = LBOUND(InData%rdisp_P,1), UBOUND(InData%rdisp_P,1) - ReKiBuf(Re_Xferred) = InData%rdisp_P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rdot_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdot_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdot_P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdot_P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdot_P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rdot_P,2), UBOUND(InData%rdot_P,2) - DO i1 = LBOUND(InData%rdot_P,1), UBOUND(InData%rdot_P,1) - ReKiBuf(Re_Xferred) = InData%rdot_P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rddot_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rddot_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rddot_P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rddot_P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rddot_P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rddot_P,2), UBOUND(InData%rddot_P,2) - DO i1 = LBOUND(InData%rddot_P,1), UBOUND(InData%rddot_P,1) - ReKiBuf(Re_Xferred) = InData%rddot_P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%omega_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omega_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omega_P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omega_P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omega_P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%omega_P,2), UBOUND(InData%omega_P,2) - DO i1 = LBOUND(InData%omega_P,1), UBOUND(InData%omega_P,1) - ReKiBuf(Re_Xferred) = InData%omega_P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alpha_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%alpha_P,2), UBOUND(InData%alpha_P,2) - DO i1 = LBOUND(InData%alpha_P,1), UBOUND(InData%alpha_P,1) - ReKiBuf(Re_Xferred) = InData%alpha_P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_P,2), UBOUND(InData%F_P,2) - DO i1 = LBOUND(InData%F_P,1), UBOUND(InData%F_P,1) - ReKiBuf(Re_Xferred) = InData%F_P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M_P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M_P,2), UBOUND(InData%M_P,2) - DO i1 = LBOUND(InData%M_P,1), UBOUND(InData%M_P,1) - ReKiBuf(Re_Xferred) = InData%M_P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Acc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Acc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Acc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Acc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Acc,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Acc,2), UBOUND(InData%Acc,2) - DO i1 = LBOUND(InData%Acc,1), UBOUND(InData%Acc,1) - ReKiBuf(Re_Xferred) = InData%Acc(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%PrescribedInterpIdx - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE StC_PackMisc - - SUBROUTINE StC_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_stop not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_stop)) DEALLOCATE(OutData%F_stop) - ALLOCATE(OutData%F_stop(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_stop.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_stop,2), UBOUND(OutData%F_stop,2) - DO i1 = LBOUND(OutData%F_stop,1), UBOUND(OutData%F_stop,1) - OutData%F_stop(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_ext not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_ext)) DEALLOCATE(OutData%F_ext) - ALLOCATE(OutData%F_ext(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_ext.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_ext,2), UBOUND(OutData%F_ext,2) - DO i1 = LBOUND(OutData%F_ext,1), UBOUND(OutData%F_ext,1) - OutData%F_ext(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_fr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_fr)) DEALLOCATE(OutData%F_fr) - ALLOCATE(OutData%F_fr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_fr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_fr,2), UBOUND(OutData%F_fr,2) - DO i1 = LBOUND(OutData%F_fr,1), UBOUND(OutData%F_fr,1) - OutData%F_fr(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C_ctrl not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C_ctrl)) DEALLOCATE(OutData%C_ctrl) - ALLOCATE(OutData%C_ctrl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C_ctrl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C_ctrl,2), UBOUND(OutData%C_ctrl,2) - DO i1 = LBOUND(OutData%C_ctrl,1), UBOUND(OutData%C_ctrl,1) - OutData%C_ctrl(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C_Brake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C_Brake)) DEALLOCATE(OutData%C_Brake) - ALLOCATE(OutData%C_Brake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C_Brake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C_Brake,2), UBOUND(OutData%C_Brake,2) - DO i1 = LBOUND(OutData%C_Brake,1), UBOUND(OutData%C_Brake,1) - OutData%C_Brake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_table not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_table)) DEALLOCATE(OutData%F_table) - ALLOCATE(OutData%F_table(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_table.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_table,2), UBOUND(OutData%F_table,2) - DO i1 = LBOUND(OutData%F_table,1), UBOUND(OutData%F_table,1) - OutData%F_table(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_k not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_k)) DEALLOCATE(OutData%F_k) - ALLOCATE(OutData%F_k(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_k.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_k,2), UBOUND(OutData%F_k,2) - DO i1 = LBOUND(OutData%F_k,1), UBOUND(OutData%F_k,1) - OutData%F_k(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! a_G not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%a_G)) DEALLOCATE(OutData%a_G) - ALLOCATE(OutData%a_G(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%a_G.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%a_G,2), UBOUND(OutData%a_G,2) - DO i1 = LBOUND(OutData%a_G,1), UBOUND(OutData%a_G,1) - OutData%a_G(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdisp_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rdisp_P)) DEALLOCATE(OutData%rdisp_P) - ALLOCATE(OutData%rdisp_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdisp_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rdisp_P,2), UBOUND(OutData%rdisp_P,2) - DO i1 = LBOUND(OutData%rdisp_P,1), UBOUND(OutData%rdisp_P,1) - OutData%rdisp_P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdot_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rdot_P)) DEALLOCATE(OutData%rdot_P) - ALLOCATE(OutData%rdot_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdot_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rdot_P,2), UBOUND(OutData%rdot_P,2) - DO i1 = LBOUND(OutData%rdot_P,1), UBOUND(OutData%rdot_P,1) - OutData%rdot_P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rddot_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rddot_P)) DEALLOCATE(OutData%rddot_P) - ALLOCATE(OutData%rddot_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rddot_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rddot_P,2), UBOUND(OutData%rddot_P,2) - DO i1 = LBOUND(OutData%rddot_P,1), UBOUND(OutData%rddot_P,1) - OutData%rddot_P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! omega_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%omega_P)) DEALLOCATE(OutData%omega_P) - ALLOCATE(OutData%omega_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%omega_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%omega_P,2), UBOUND(OutData%omega_P,2) - DO i1 = LBOUND(OutData%omega_P,1), UBOUND(OutData%omega_P,1) - OutData%omega_P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%alpha_P)) DEALLOCATE(OutData%alpha_P) - ALLOCATE(OutData%alpha_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%alpha_P,2), UBOUND(OutData%alpha_P,2) - DO i1 = LBOUND(OutData%alpha_P,1), UBOUND(OutData%alpha_P,1) - OutData%alpha_P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_P)) DEALLOCATE(OutData%F_P) - ALLOCATE(OutData%F_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_P,2), UBOUND(OutData%F_P,2) - DO i1 = LBOUND(OutData%F_P,1), UBOUND(OutData%F_P,1) - OutData%F_P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%M_P)) DEALLOCATE(OutData%M_P) - ALLOCATE(OutData%M_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M_P,2), UBOUND(OutData%M_P,2) - DO i1 = LBOUND(OutData%M_P,1), UBOUND(OutData%M_P,1) - OutData%M_P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Acc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Acc)) DEALLOCATE(OutData%Acc) - ALLOCATE(OutData%Acc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Acc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Acc,2), UBOUND(OutData%Acc,2) - DO i1 = LBOUND(OutData%Acc,1), UBOUND(OutData%Acc,1) - OutData%Acc(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%PrescribedInterpIdx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE StC_UnPackMisc - - SUBROUTINE StC_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_ParameterType), INTENT(IN) :: SrcParamData - TYPE(StC_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%RootName = SrcParamData%RootName - DstParamData%StC_DOF_MODE = SrcParamData%StC_DOF_MODE - DstParamData%StC_X_DOF = SrcParamData%StC_X_DOF - DstParamData%StC_Y_DOF = SrcParamData%StC_Y_DOF - DstParamData%StC_Z_DOF = SrcParamData%StC_Z_DOF - DstParamData%M_X = SrcParamData%M_X - DstParamData%M_Y = SrcParamData%M_Y - DstParamData%M_Z = SrcParamData%M_Z - DstParamData%M_XY = SrcParamData%M_XY - DstParamData%K_X = SrcParamData%K_X - DstParamData%K_Y = SrcParamData%K_Y - DstParamData%K_Z = SrcParamData%K_Z - DstParamData%C_X = SrcParamData%C_X - DstParamData%C_Y = SrcParamData%C_Y - DstParamData%C_Z = SrcParamData%C_Z - DstParamData%K_S = SrcParamData%K_S - DstParamData%C_S = SrcParamData%C_S - DstParamData%P_SP = SrcParamData%P_SP - DstParamData%N_SP = SrcParamData%N_SP - DstParamData%Gravity = SrcParamData%Gravity - DstParamData%StC_CMODE = SrcParamData%StC_CMODE - DstParamData%StC_SA_MODE = SrcParamData%StC_SA_MODE - DstParamData%StC_X_C_HIGH = SrcParamData%StC_X_C_HIGH - DstParamData%StC_X_C_LOW = SrcParamData%StC_X_C_LOW - DstParamData%StC_Y_C_HIGH = SrcParamData%StC_Y_C_HIGH - DstParamData%StC_Y_C_LOW = SrcParamData%StC_Y_C_LOW - DstParamData%StC_Z_C_HIGH = SrcParamData%StC_Z_C_HIGH - DstParamData%StC_Z_C_LOW = SrcParamData%StC_Z_C_LOW - DstParamData%StC_X_C_BRAKE = SrcParamData%StC_X_C_BRAKE - DstParamData%StC_Y_C_BRAKE = SrcParamData%StC_Y_C_BRAKE - DstParamData%StC_Z_C_BRAKE = SrcParamData%StC_Z_C_BRAKE - DstParamData%L_X = SrcParamData%L_X - DstParamData%B_X = SrcParamData%B_X - DstParamData%area_X = SrcParamData%area_X - DstParamData%area_ratio_X = SrcParamData%area_ratio_X - DstParamData%headLossCoeff_X = SrcParamData%headLossCoeff_X - DstParamData%rho_X = SrcParamData%rho_X - DstParamData%L_Y = SrcParamData%L_Y - DstParamData%B_Y = SrcParamData%B_Y - DstParamData%area_Y = SrcParamData%area_Y - DstParamData%area_ratio_Y = SrcParamData%area_ratio_Y - DstParamData%headLossCoeff_Y = SrcParamData%headLossCoeff_Y - DstParamData%rho_Y = SrcParamData%rho_Y - DstParamData%Use_F_TBL = SrcParamData%Use_F_TBL -IF (ALLOCATED(SrcParamData%F_TBL)) THEN - i1_l = LBOUND(SrcParamData%F_TBL,1) - i1_u = UBOUND(SrcParamData%F_TBL,1) - i2_l = LBOUND(SrcParamData%F_TBL,2) - i2_u = UBOUND(SrcParamData%F_TBL,2) - IF (.NOT. ALLOCATED(DstParamData%F_TBL)) THEN - ALLOCATE(DstParamData%F_TBL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%F_TBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%F_TBL = SrcParamData%F_TBL -ENDIF - DstParamData%NumMeshPts = SrcParamData%NumMeshPts - DstParamData%PrescribedForcesCoordSys = SrcParamData%PrescribedForcesCoordSys -IF (ALLOCATED(SrcParamData%StC_PrescribedForce)) THEN - i1_l = LBOUND(SrcParamData%StC_PrescribedForce,1) - i1_u = UBOUND(SrcParamData%StC_PrescribedForce,1) - i2_l = LBOUND(SrcParamData%StC_PrescribedForce,2) - i2_u = UBOUND(SrcParamData%StC_PrescribedForce,2) - IF (.NOT. ALLOCATED(DstParamData%StC_PrescribedForce)) THEN - ALLOCATE(DstParamData%StC_PrescribedForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StC_PrescribedForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StC_PrescribedForce = SrcParamData%StC_PrescribedForce -ENDIF - END SUBROUTINE StC_CopyParam - - SUBROUTINE StC_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(StC_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyParam' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ParamData%F_TBL)) THEN - DEALLOCATE(ParamData%F_TBL) -ENDIF -IF (ALLOCATED(ParamData%StC_PrescribedForce)) THEN - DEALLOCATE(ParamData%StC_PrescribedForce) -ENDIF - END SUBROUTINE StC_DestroyParam - - SUBROUTINE StC_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! StC_DOF_MODE - Int_BufSz = Int_BufSz + 1 ! StC_X_DOF - Int_BufSz = Int_BufSz + 1 ! StC_Y_DOF - Int_BufSz = Int_BufSz + 1 ! StC_Z_DOF - Re_BufSz = Re_BufSz + 1 ! M_X - Re_BufSz = Re_BufSz + 1 ! M_Y - Re_BufSz = Re_BufSz + 1 ! M_Z - Re_BufSz = Re_BufSz + 1 ! M_XY - Re_BufSz = Re_BufSz + 1 ! K_X - Re_BufSz = Re_BufSz + 1 ! K_Y - Re_BufSz = Re_BufSz + 1 ! K_Z - Re_BufSz = Re_BufSz + 1 ! C_X - Re_BufSz = Re_BufSz + 1 ! C_Y - Re_BufSz = Re_BufSz + 1 ! C_Z - Re_BufSz = Re_BufSz + SIZE(InData%K_S) ! K_S - Re_BufSz = Re_BufSz + SIZE(InData%C_S) ! C_S - Re_BufSz = Re_BufSz + SIZE(InData%P_SP) ! P_SP - Re_BufSz = Re_BufSz + SIZE(InData%N_SP) ! N_SP - Re_BufSz = Re_BufSz + SIZE(InData%Gravity) ! Gravity - Int_BufSz = Int_BufSz + 1 ! StC_CMODE - Int_BufSz = Int_BufSz + 1 ! StC_SA_MODE - Re_BufSz = Re_BufSz + 1 ! StC_X_C_HIGH - Re_BufSz = Re_BufSz + 1 ! StC_X_C_LOW - Re_BufSz = Re_BufSz + 1 ! StC_Y_C_HIGH - Re_BufSz = Re_BufSz + 1 ! StC_Y_C_LOW - Re_BufSz = Re_BufSz + 1 ! StC_Z_C_HIGH - Re_BufSz = Re_BufSz + 1 ! StC_Z_C_LOW - Re_BufSz = Re_BufSz + 1 ! StC_X_C_BRAKE - Re_BufSz = Re_BufSz + 1 ! StC_Y_C_BRAKE - Re_BufSz = Re_BufSz + 1 ! StC_Z_C_BRAKE - Re_BufSz = Re_BufSz + 1 ! L_X - Re_BufSz = Re_BufSz + 1 ! B_X - Re_BufSz = Re_BufSz + 1 ! area_X - Re_BufSz = Re_BufSz + 1 ! area_ratio_X - Re_BufSz = Re_BufSz + 1 ! headLossCoeff_X - Re_BufSz = Re_BufSz + 1 ! rho_X - Re_BufSz = Re_BufSz + 1 ! L_Y - Re_BufSz = Re_BufSz + 1 ! B_Y - Re_BufSz = Re_BufSz + 1 ! area_Y - Re_BufSz = Re_BufSz + 1 ! area_ratio_Y - Re_BufSz = Re_BufSz + 1 ! headLossCoeff_Y - Re_BufSz = Re_BufSz + 1 ! rho_Y - Int_BufSz = Int_BufSz + 1 ! Use_F_TBL - Int_BufSz = Int_BufSz + 1 ! F_TBL allocated yes/no - IF ( ALLOCATED(InData%F_TBL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_TBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_TBL) ! F_TBL - END IF - Int_BufSz = Int_BufSz + 1 ! NumMeshPts - Int_BufSz = Int_BufSz + 1 ! PrescribedForcesCoordSys - Int_BufSz = Int_BufSz + 1 ! StC_PrescribedForce allocated yes/no - IF ( ALLOCATED(InData%StC_PrescribedForce) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StC_PrescribedForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StC_PrescribedForce) ! StC_PrescribedForce - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%StC_DOF_MODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%StC_X_DOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%StC_Y_DOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%StC_Z_DOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%M_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%M_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%M_Z - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%M_XY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%K_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%K_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%K_Z - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_Z - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%K_S,1), UBOUND(InData%K_S,1) - ReKiBuf(Re_Xferred) = InData%K_S(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%C_S,1), UBOUND(InData%C_S,1) - ReKiBuf(Re_Xferred) = InData%C_S(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%P_SP,1), UBOUND(InData%P_SP,1) - ReKiBuf(Re_Xferred) = InData%P_SP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%N_SP,1), UBOUND(InData%N_SP,1) - ReKiBuf(Re_Xferred) = InData%N_SP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%Gravity,1), UBOUND(InData%Gravity,1) - ReKiBuf(Re_Xferred) = InData%Gravity(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%StC_CMODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%StC_SA_MODE - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%L_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%B_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_ratio_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%headLossCoeff_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rho_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%L_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%B_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_ratio_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%headLossCoeff_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rho_Y - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Use_F_TBL, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%F_TBL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_TBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_TBL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_TBL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_TBL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_TBL,2), UBOUND(InData%F_TBL,2) - DO i1 = LBOUND(InData%F_TBL,1), UBOUND(InData%F_TBL,1) - ReKiBuf(Re_Xferred) = InData%F_TBL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumMeshPts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%PrescribedForcesCoordSys - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%StC_PrescribedForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StC_PrescribedForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_PrescribedForce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StC_PrescribedForce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_PrescribedForce,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StC_PrescribedForce,2), UBOUND(InData%StC_PrescribedForce,2) - DO i1 = LBOUND(InData%StC_PrescribedForce,1), UBOUND(InData%StC_PrescribedForce,1) - ReKiBuf(Re_Xferred) = InData%StC_PrescribedForce(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_PackParam - - SUBROUTINE StC_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%StC_DOF_MODE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%StC_X_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%StC_X_DOF) - Int_Xferred = Int_Xferred + 1 - OutData%StC_Y_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%StC_Y_DOF) - Int_Xferred = Int_Xferred + 1 - OutData%StC_Z_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%StC_Z_DOF) - Int_Xferred = Int_Xferred + 1 - OutData%M_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%M_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%M_Z = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%M_XY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%K_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%K_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%K_Z = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_Z = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%K_S,1) - i1_u = UBOUND(OutData%K_S,1) - DO i1 = LBOUND(OutData%K_S,1), UBOUND(OutData%K_S,1) - OutData%K_S(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%C_S,1) - i1_u = UBOUND(OutData%C_S,1) - DO i1 = LBOUND(OutData%C_S,1), UBOUND(OutData%C_S,1) - OutData%C_S(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%P_SP,1) - i1_u = UBOUND(OutData%P_SP,1) - DO i1 = LBOUND(OutData%P_SP,1), UBOUND(OutData%P_SP,1) - OutData%P_SP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%N_SP,1) - i1_u = UBOUND(OutData%N_SP,1) - DO i1 = LBOUND(OutData%N_SP,1), UBOUND(OutData%N_SP,1) - OutData%N_SP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Gravity,1) - i1_u = UBOUND(OutData%Gravity,1) - DO i1 = LBOUND(OutData%Gravity,1), UBOUND(OutData%Gravity,1) - OutData%Gravity(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%StC_CMODE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%StC_SA_MODE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%StC_X_C_HIGH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_C_LOW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_C_HIGH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_C_LOW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_C_HIGH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_C_LOW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_C_BRAKE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_C_BRAKE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_C_BRAKE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%L_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%B_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_ratio_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%headLossCoeff_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rho_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%L_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%B_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_ratio_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%headLossCoeff_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rho_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Use_F_TBL = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use_F_TBL) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_TBL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_TBL)) DEALLOCATE(OutData%F_TBL) - ALLOCATE(OutData%F_TBL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_TBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_TBL,2), UBOUND(OutData%F_TBL,2) - DO i1 = LBOUND(OutData%F_TBL,1), UBOUND(OutData%F_TBL,1) - OutData%F_TBL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%NumMeshPts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PrescribedForcesCoordSys = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StC_PrescribedForce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StC_PrescribedForce)) DEALLOCATE(OutData%StC_PrescribedForce) - ALLOCATE(OutData%StC_PrescribedForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_PrescribedForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StC_PrescribedForce,2), UBOUND(OutData%StC_PrescribedForce,2) - DO i1 = LBOUND(OutData%StC_PrescribedForce,1), UBOUND(OutData%StC_PrescribedForce,1) - OutData%StC_PrescribedForce(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_UnPackParam - - SUBROUTINE StC_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_InputType), INTENT(INOUT) :: SrcInputData - TYPE(StC_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%Mesh)) THEN - i1_l = LBOUND(SrcInputData%Mesh,1) - i1_u = UBOUND(SrcInputData%Mesh,1) - IF (.NOT. ALLOCATED(DstInputData%Mesh)) THEN - ALLOCATE(DstInputData%Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%Mesh,1), UBOUND(SrcInputData%Mesh,1) - CALL MeshCopy( SrcInputData%Mesh(i1), DstInputData%Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE StC_CopyInput - - SUBROUTINE StC_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(StC_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InputData%Mesh)) THEN -DO i1 = LBOUND(InputData%Mesh,1), UBOUND(InputData%Mesh,1) - CALL MeshDestroy( InputData%Mesh(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(InputData%Mesh) -ENDIF - END SUBROUTINE StC_DestroyInput - - SUBROUTINE StC_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Mesh allocated yes/no - IF ( ALLOCATED(InData%Mesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Mesh upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Mesh,1), UBOUND(InData%Mesh,1) - Int_BufSz = Int_BufSz + 3 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%Mesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Mesh,1), UBOUND(InData%Mesh,1) - CALL MeshPack( InData%Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE StC_PackInput - - SUBROUTINE StC_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mesh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Mesh)) DEALLOCATE(OutData%Mesh) - ALLOCATE(OutData%Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Mesh,1), UBOUND(OutData%Mesh,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE StC_UnPackInput - - SUBROUTINE StC_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(StC_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%Mesh)) THEN - i1_l = LBOUND(SrcOutputData%Mesh,1) - i1_u = UBOUND(SrcOutputData%Mesh,1) - IF (.NOT. ALLOCATED(DstOutputData%Mesh)) THEN - ALLOCATE(DstOutputData%Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%Mesh,1), UBOUND(SrcOutputData%Mesh,1) - CALL MeshCopy( SrcOutputData%Mesh(i1), DstOutputData%Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE StC_CopyOutput - - SUBROUTINE StC_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(StC_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(OutputData%Mesh)) THEN -DO i1 = LBOUND(OutputData%Mesh,1), UBOUND(OutputData%Mesh,1) - CALL MeshDestroy( OutputData%Mesh(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(OutputData%Mesh) -ENDIF - END SUBROUTINE StC_DestroyOutput - - SUBROUTINE StC_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Mesh allocated yes/no - IF ( ALLOCATED(InData%Mesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Mesh upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Mesh,1), UBOUND(InData%Mesh,1) - Int_BufSz = Int_BufSz + 3 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%Mesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Mesh,1), UBOUND(InData%Mesh,1) - CALL MeshPack( InData%Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE StC_PackOutput - - SUBROUTINE StC_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mesh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Mesh)) DEALLOCATE(OutData%Mesh) - ALLOCATE(OutData%Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Mesh,1), UBOUND(OutData%Mesh,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE StC_UnPackOutput - - - SUBROUTINE StC_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(StC_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(StC_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'StC_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL StC_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL StC_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL StC_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE StC_Input_ExtrapInterp - - - SUBROUTINE StC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = u1, f(t2) = u2 -! -!.................................................................................................................................. - - TYPE(StC_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(StC_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(StC_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'StC_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(u_out%Mesh) .AND. ALLOCATED(u1%Mesh)) THEN - DO i1 = LBOUND(u_out%Mesh,1),UBOUND(u_out%Mesh,1) - CALL MeshExtrapInterp1(u1%Mesh(i1), u2%Mesh(i1), tin, u_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - END SUBROUTINE StC_Input_ExtrapInterp1 - - - SUBROUTINE StC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 -! -!.................................................................................................................................. - - TYPE(StC_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(StC_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(StC_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(StC_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'StC_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(u_out%Mesh) .AND. ALLOCATED(u1%Mesh)) THEN - DO i1 = LBOUND(u_out%Mesh,1),UBOUND(u_out%Mesh,1) - CALL MeshExtrapInterp2(u1%Mesh(i1), u2%Mesh(i1), u3%Mesh(i1), tin, u_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - END SUBROUTINE StC_Input_ExtrapInterp2 - - - SUBROUTINE StC_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(StC_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(StC_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'StC_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL StC_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL StC_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL StC_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE StC_Output_ExtrapInterp - - - SUBROUTINE StC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = y1, f(t2) = y2 -! -!.................................................................................................................................. - - TYPE(StC_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(StC_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(StC_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'StC_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(y_out%Mesh) .AND. ALLOCATED(y1%Mesh)) THEN - DO i1 = LBOUND(y_out%Mesh,1),UBOUND(y_out%Mesh,1) - CALL MeshExtrapInterp1(y1%Mesh(i1), y2%Mesh(i1), tin, y_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - END SUBROUTINE StC_Output_ExtrapInterp1 - - - SUBROUTINE StC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 -! -!.................................................................................................................................. - - TYPE(StC_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(StC_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(StC_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(StC_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'StC_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(y_out%Mesh) .AND. ALLOCATED(y1%Mesh)) THEN - DO i1 = LBOUND(y_out%Mesh,1),UBOUND(y_out%Mesh,1) - CALL MeshExtrapInterp2(y1%Mesh(i1), y2%Mesh(i1), y3%Mesh(i1), tin, y_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - END SUBROUTINE StC_Output_ExtrapInterp2 - -END MODULE StrucCtrl_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/OpenFAST/modules/servodyn/src/UserSubs.f90 b/OpenFAST/modules/servodyn/src/UserSubs.f90 deleted file mode 100644 index 64c3501f6..000000000 --- a/OpenFAST/modules/servodyn/src/UserSubs.f90 +++ /dev/null @@ -1,475 +0,0 @@ - ! NOTE: This source file contains dummy placeholders for the - ! user-specified routines available in ServoDyn. These routines - ! are as follows: - ! Routine Description - ! ------------ --------------------------------------------------- - ! PitchCntrl() User-specified blade pitch control (either - ! independent or rotor-collective) model. - ! UserGen() User-specified generator torque and power model. - ! UserHSSBr() User-specified high-speed shaft brake model. - ! UserVSCont() User-specified variable-speed torque and power - ! control model. - ! UserYawCont() User-specified nacelle-yaw control model. - ! In order to interface FAST with your own user-specified routines, - ! you can develop your own logic within these dummy placeholders and - ! recompile FAST; OR comment out the appropriate dummy placeholders, - ! create your own routines in their own source files, and recompile - ! FAST while linking in these additional source files. For example, - ! the executable version of FAST that is distributed with the FAST - ! archive is linked with the example PitchCntrl() routine contained in - ! source file PitchCntrl_ACH.f90 and the example UserGen() and - ! UserVSCont() routines contained in source file UserVSCont_KP.f90; - ! thus, the dummy placeholders for routines PitchCntrl(), UserGen(), - ! and UserVSCont() are commented out within this source file. The - ! example pitch controller was written by Craig Hansen (ACH) and the - ! example generator and variable speed controllers were written by - ! Kirk Pierce (KP). Please see the aforementioned source files for - ! additional information on these example user-specified routines. - - ! note: we recommend NOT using these routines because they do not conform to the FAST - ! modularization framework. They remain for legacy purposes only. - -module UserSubs -contains - -!======================================================================= -!SUBROUTINE PitchCntrl ( BlPitch, ElecPwr, LSS_Spd, TwrAccel, NumBl, ZTime, DT, DirRoot, BlPitchCom ) -! -! -! ! This is a dummy routine for holding the place of a user-specified -! ! blade pitch control model (either independent or rotor-collective). -! ! Modify this code to create your own model. -! -! -!USE Precision -! -! -!IMPLICIT NONE -! -! -! ! Passed variables: -! -!INTEGER(4), INTENT(IN ) :: NumBl ! Number of blades, (-). -! -!REAL(ReKi), INTENT(IN ) :: BlPitch (NumBl) ! Current values of the blade pitch angles, rad. -!REAL(DbKi), INTENT(IN ) :: DT ! Integration time step, sec. -!REAL(ReKi), INTENT(IN ) :: ElecPwr ! Electrical power, watts. -!REAL(ReKi), INTENT(IN ) :: LSS_Spd ! LSS speed (rad/s) -!REAL(ReKi), INTENT(OUT) :: BlPitchCom(NumBl) ! Commanded blade pitch angles (demand pitch angles), rad. -!REAL(ReKi), INTENT(IN ) :: TwrAccel ! Tower Acceleration, m/s^2. -!REAL(DbKi), INTENT(IN ) :: ZTime ! Current simulation time, sec. -! -!CHARACTER(1024), INTENT(IN ) :: DirRoot ! The name of the root file including the full path to the current working directory. This may be useful if you want this routine to write a permanent record of what it does to be stored with the simulation results: the results should be stored in a file whose name (including path) is generated by appending any suitable extension to DirRoot. -! -! -! -!BlPitchCom = 0.0 -! -! -! -!RETURN -!END SUBROUTINE PitchCntrl -!======================================================================= -!SUBROUTINE UserGen ( HSS_Spd, LSS_Spd, NumBl, ZTime, DT, GenEff, DelGenTrq, DirRoot, GenTrq, ElecPwr ) -! -! -! ! This is a dummy routine for holding the place of a user-specified -! ! generator torque and power model. Modify this code to create your -! ! own model. -! -! ! NOTE: If you (the user) wants to switch on-or-off the generator DOF at -! ! runtime from this user-defined routine, then do the following: -! ! (1) USE MODULE DOFs(). -! ! (2) Type in "DOF_Flag(DOF_GeAz) = VALUE" where VALUE = .TRUE. or -! ! .FALSE. depending on whether you want to turn-on or turn-off -! ! the DOF, respectively. Turning off the DOF forces the -! ! current RATE to remain fixed. If the rate is currently zero, -! ! the current POSITION will remain fixed as well. -! ! Note that this technique WILL NOT work for user-defined routines -! ! written for ADAMS datasets extracted using the FAST-to-ADAMS -! ! preprocessor. -! -! -!USE Precision -! -! -!IMPLICIT NONE -! -! -! ! Passed Variables: -! -!INTEGER(4), INTENT(IN ) :: NumBl ! Number of blades, (-). -! -!REAL(ReKi), INTENT(IN ) :: DelGenTrq ! Pertubation in generator torque used during FAST linearization (zero otherwise), N-m. -!REAL(DbKi), INTENT(IN ) :: DT ! Integration time step, sec. -!REAL(ReKi), INTENT(OUT) :: ElecPwr ! Electrical power (account for losses), watts. -!REAL(ReKi), INTENT(IN ) :: GenEff ! Generator efficiency, (-). -!REAL(ReKi), INTENT(OUT) :: GenTrq ! Electrical generator torque, N-m. -!REAL(ReKi), INTENT(IN ) :: LSS_Spd ! LSS speed, rad/s. -!REAL(ReKi), INTENT(IN ) :: HSS_Spd ! HSS speed, rad/s. -!REAL(DbKi), INTENT(IN ) :: ZTime ! Current simulation time, sec. -! -!CHARACTER(1024), INTENT(IN ) :: DirRoot ! The name of the root file including the full path to the current working directory. This may be useful if you want this routine to write a permanent record of what it does to be stored with the simulation results: the results should be stored in a file whose name (including path) is generated by appending any suitable extension to DirRoot. -! -! -! -!GenTrq = 0.0 + DelGenTrq ! Make sure to add the pertubation on generator torque, DelGenTrq. This is used only for FAST linearization (it is zero otherwise). -! -! -! ! The generator efficiency is either additive for motoring, -! ! or subtractive for generating power. -! -!IF ( GenTrq > 0.0 ) THEN -! ElecPwr = GenTrq*HSS_Spd*GenEff -!ELSE -! ElecPwr = GenTrq*HSS_Spd/GenEff -!ENDIF -! -! -! -!RETURN -!END SUBROUTINE UserGen -!======================================================================= -SUBROUTINE UserHSSBr ( GenTrq, ElecPwr, HSS_Spd, NumBl, ZTime, DT, DirRoot, HSSBrFrac ) - - - ! This is a dummy routine for holding the place of a user-specified - ! HSS brake model. This routine must specify the fraction - ! (HSSBrFrac) of full torque to be applied to the HSS by the HSS - ! brake. The magnitude of the full torque (HSSBrFrac = 1.0) equals - ! HSSBrTqF from the primary input file. Modify this code to create - ! your own model. - - ! NOTE: If you (the user) wants to switch on-or-off the generator DOF at - ! runtime from this user-defined routine, then do the following: - ! (1) USE MODULE DOFs(). - ! (2) Type in "DOF_Flag(DOF_GeAz) = VALUE" where VALUE = .TRUE. or - ! .FALSE. depending on whether you want to turn-on or turn-off - ! the DOF, respectively. Turning off the DOF forces the - ! current RATE to remain fixed. If the rate is currently zero, - ! the current POSITION will remain fixed as well. - ! Note that this technique WILL NOT work for user-defined routines - ! written for ADAMS datasets extracted using the FAST-to-ADAMS - ! preprocessor. - - -USE Precision - - -IMPLICIT NONE - - - ! Passed Variables: - -INTEGER(4), INTENT(IN ) :: NumBl ! Number of blades, (-). - -REAL(DbKi), INTENT(IN ) :: DT ! Integration time step, sec. -REAL(ReKi), INTENT(IN ) :: ElecPwr ! Electrical power (account for losses), watts. -REAL(ReKi), INTENT(IN ) :: GenTrq ! Electrical generator torque, N-m. -REAL(ReKi), INTENT(IN ) :: HSS_Spd ! HSS speed, rad/s. -REAL(ReKi), INTENT(OUT) :: HSSBrFrac ! Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full), (-). -REAL(DbKi), INTENT(IN ) :: ZTime ! Current simulation time, sec. - -CHARACTER(1024), INTENT(IN ) :: DirRoot ! The name of the root file including the full path to the current working directory. This may be useful if you want this routine to write a permanent record of what it does to be stored with the simulation results: the results should be stored in a file whose name (including path) is generated by appending any suitable extension to DirRoot. - - - -HSSBrFrac = 0.0 ! NOTE: This must be specified as a real number between 0.0 (off - no brake torque) and 1.0 (full - max brake torque = HSSBrTqF); FAST/ADAMS will Abort otherwise. - - - -RETURN -END SUBROUTINE UserHSSBr -!======================================================================= -SUBROUTINE UserTFin ( TFrlDef , TFrlRate, ZTime , DirRoot, & - TFinCPxi, TFinCPyi, TFinCPzi, & - TFinCPVx, TFinCPVy, TFinCPVz, & - TFinAOA , TFinQ , & - TFinCL , TFinCD , & - TFinKFx , TFinKFy ) - - - ! This is a dummy routine for holding the place of user-specified - ! computations for tail fin aerodynamic loads. Modify this code to - ! create your own logic. - - -USE Precision - - -IMPLICIT NONE - - - ! Passed Variables: - -REAL(ReKi), INTENT(OUT) :: TFinAOA ! Angle-of-attack between the relative wind velocity and tail fin chordline, rad. -REAL(ReKi), INTENT(OUT) :: TFinCD ! Tail fin drag coefficient resulting from current TFinAOA, (-). -REAL(ReKi), INTENT(OUT) :: TFinCL ! Tail fin lift coefficient resulting from current TFinAOA, (-). -REAL(ReKi), INTENT(IN ) :: TFinCPVx ! Absolute Velocity of the tail center-of-pressure along tail fin chordline pointing toward tail fin trailing edge, m/s. -REAL(ReKi), INTENT(IN ) :: TFinCPVy ! Absolute Velocity of the tail center-of-pressure normal to plane of tail fin pointing towards suction surface , m/s. -REAL(ReKi), INTENT(IN ) :: TFinCPVz ! Absolute Velocity of the tail center-of-pressure in plane of tail fin normal to chordline and nominally upward , m/s. -!jmj Start of proposed change. v6.02a-jmj 25-Aug-2006. -!jmj Improve the description of input arguments TFinCPxi, TFinCPyi, and -!jmj TFinCPzi: -!remove6.02aREAL(ReKi), INTENT(IN ) :: TFinCPxi ! Downwind distance from the inertial frame origin to the tail fin center-of-pressure, m. -!remove6.02aREAL(ReKi), INTENT(IN ) :: TFinCPyi ! Lateral distance from the inertial frame origin to the tail fin center-of-pressure, m. -!remove6.02aREAL(ReKi), INTENT(IN ) :: TFinCPzi ! Vertical distance from the inertial frame origin to the tail fin center-of-pressure, m. -REAL(ReKi), INTENT(IN ) :: TFinCPxi ! Downwind distance from the inertial frame origin at ground level [onshore] or MSL [offshore] to the tail fin center-of-pressure, m. -REAL(ReKi), INTENT(IN ) :: TFinCPyi ! Lateral distance from the inertial frame origin at ground level [onshore] or MSL [offshore] to the tail fin center-of-pressure, m. -REAL(ReKi), INTENT(IN ) :: TFinCPzi ! Vertical distance from the inertial frame origin at ground level [onshore] or MSL [offshore] to the tail fin center-of-pressure, m. -!jmj End of proposed change. v6.02a-jmj 25-Aug-2006. -REAL(ReKi), INTENT(OUT) :: TFinKFx ! Aerodynamic force at the tail fin center-of-pressure (point K) along tail fin chordline pointing toward tail fin trailing edge, N. -REAL(ReKi), INTENT(OUT) :: TFinKFy ! Aerodynamic force at the tail fin center-of-pressure (point K) normal to plane of tail fin pointing towards suction surface , N. -REAL(ReKi), INTENT(OUT) :: TFinQ ! Dynamic pressure of the relative wind velocity, Pa. -REAL(ReKi), INTENT(IN ) :: TFrlDef ! Tail-furl angular deflection, rad. -REAL(ReKi), INTENT(IN ) :: TFrlRate ! Tail-furl angular rate, rad/s -REAL(DbKi), INTENT(IN ) :: ZTime ! Current simulation time, sec. - -CHARACTER(1024), INTENT(IN ) :: DirRoot ! The name of the root file including the full path to the current working directory. This may be useful if you want this routine to write a permanent record of what it does to be stored with the simulation results: the results should be stored in a file whose name (including path) is generated by appending any suitable extension to DirRoot. - - - -TFinAOA = 0.0 -TFinCL = 0.0 -TFinCD = 0.0 -TFinQ = 0.0 -TFinKFx = 0.0 -TFinKFy = 0.0 - - - -RETURN -END SUBROUTINE UserTFin -!======================================================================= -!SUBROUTINE UserVSCont ( HSS_Spd, LSS_Spd, NumBl, ZTime, DT, GenEff, DelGenTrq, DirRoot, GenTrq, ElecPwr ) -! -! -! ! This is a dummy routine for holding the place of a user-specified -! ! variable-speed torque and power control model. Modify this code to -! ! create your own model. -! -! ! NOTE: If you (the user) wants to switch on-or-off the generator DOF at -! ! runtime from this user-defined routine, then do the following: -! ! (1) USE MODULE DOFs(). -! ! (2) Type in "DOF_Flag(DOF_GeAz) = VALUE" where VALUE = .TRUE. or -! ! .FALSE. depending on whether you want to turn-on or turn-off -! ! the DOF, respectively. Turning off the DOF forces the -! ! current RATE to remain fixed. If the rate is currently zero, -! ! the current POSITION will remain fixed as well. -! ! Note that this technique WILL NOT work for user-defined routines -! ! written for ADAMS datasets extracted using the FAST-to-ADAMS -! ! preprocessor. -! -! -!USE Precision -! -! -!IMPLICIT NONE -! -! -! ! Passed Variables: -! -!INTEGER(4), INTENT(IN ) :: NumBl ! Number of blades, (-). -! -!REAL(ReKi), INTENT(IN ) :: DelGenTrq ! Pertubation in generator torque used during FAST linearization (zero otherwise), N-m. -!REAL(DbKi), INTENT(IN ) :: DT ! Integration time step, sec. -!REAL(ReKi), INTENT(OUT) :: ElecPwr ! Electrical power (account for losses), watts. -!REAL(ReKi), INTENT(IN ) :: LSS_Spd ! LSS speed, rad/s. -!REAL(ReKi), INTENT(IN ) :: GenEff ! Generator efficiency, (-). -!REAL(ReKi), INTENT(OUT) :: GenTrq ! Electrical generator torque, N-m. -!REAL(ReKi), INTENT(IN ) :: HSS_Spd ! HSS speed, rad/s. -!REAL(DbKi), INTENT(IN ) :: ZTime ! Current simulation time, sec. -! -!CHARACTER(1024), INTENT(IN ) :: DirRoot ! The name of the root file including the full path to the current working directory. This may be useful if you want this routine to write a permanent record of what it does to be stored with the simulation results: the results should be stored in a file whose name (including path) is generated by appending any suitable extension to DirRoot. -! -! -! -!GenTrq = 0.0 + DelGenTrq ! Make sure to add the pertubation on generator torque, DelGenTrq. This is used only for FAST linearization (it is zero otherwise). -! -! -! ! The generator efficiency is either additive for motoring, -! ! or subtractive for generating power. -! -!IF ( GenTrq > 0.0 ) THEN -! ElecPwr = GenTrq*HSS_Spd*GenEff -!ELSE -! ElecPwr = GenTrq*HSS_Spd/GenEff -!ENDIF -! -! -! -!RETURN -!END SUBROUTINE UserVSCont -!======================================================================= -SUBROUTINE UserYawCont ( YawPos, YawRate, WindDir, YawError, NumBl, ZTime, DT, DirRoot, YawPosCom, YawRateCom ) - - - ! This is a dummy routine for holding the place of a user-specified - ! nacelle-yaw controller. Modify this code to create your own device. - - - ! As indicated, the yaw controller must always specify a command (demand) - ! yaw angle, YawPosCom, AND command (demand) yaw rate, YawRateCom. - ! Normally, you should correlate these commands so that the commanded yaw - ! angle is the integral of the commanded yaw rate, or likewise, the - ! commanded yaw rate is the derivative of the commanded yaw angle. FAST - ! WILL NOT compute these correlations for you and DOES NOT check to - ! ensure that they are correlated. In some situations, it is desirable to - ! set one of the commands (either yaw angle OR yaw rate) to ZERO depending - ! on the desired transfer function of FAST's built-in actuator model (see - ! below for a discussion of FAST's built-in actuator model). In general, - ! the commanded yaw angle and rate SHOULD NEVER be defined independent of - ! each other with BOTH commands NONZERO. - - - ! The yaw controller's effect on the FAST model depends on whether or not - ! the yaw DOF is enabled as follows: - ! - ! YawDOF = False - If the yaw DOF is disabled, then the commanded yaw angle - ! and rate will be the ACTUAL yaw angle and yaw rate used - ! internally by FAST (in general, you should ensure these - ! are correlated). In this case, any desired actuator - ! effects should be built within this controller. Also in - ! this case, FAST WILL NOT compute the correlated yaw - ! acceleration, but assume that it is ZERO. If the - ! commanded yaw rate is zero while the commanded yaw angle - ! is changing in time, then the yaw controller's effect - ! on yaw angle is the identical to routine PitchCntrl()'s - ! effect on pitch angle (i.e., routine PitchCntrl() - ! commands changes in pitch angle with no associated - ! changes in pitch rate or pitch acceleration). For yaw - ! control, this situation should be avoided however, since - ! yaw-induced gyroscopic pitching loads on the turbine - ! brought about by the yaw rate may be significant. - ! - ! YawDOF = True - If the yaw DOF is enabled, then the commanded yaw angle - ! and rate, YawPosCom and YawRateCom, become the neutral - ! yaw angle, YawNeut, and neutral yaw rate, YawRateNeut, in - ! FAST's built-in second-order actuator model defined by - ! inputs YawSpr and YawDamp. - - - ! Description of FAST's built-in actuator model: - ! - ! In the time-domain, FAST's built-in actuator model is defined as follows: - ! - ! YawIner*YawAccel + YawDamp*YawRate + YawSpr*YawPos - ! = YawDamp*YawRateNeut + YawSpr*YawNeut + YawTq - ! - ! so that the transmitted torque is: - ! - ! YawMom = YawSpr*( YawPos - YawNeut ) + YawDamp*( YawRate - YawRateNeut ) - ! - ! where, - ! YawSpr = nacelle-yaw spring constant (defined in FAST's primary - ! input file) - ! YawDamp = nacelle-yaw damping constant (defined in FAST's primary - ! input file) - ! YawIner = instantaneous inertia of the nacelle and rotor about the - ! yaw axis - ! YawNeut = the commanded (neutral) yaw angle = YawPosCom - ! YawRateNeut = the commanded (neutral) yaw rate = YawRateCom - ! YawPos = yaw angle (position) - ! YawRate = yaw rate - ! YawAccel = yaw acceleration - ! YawTq = torque about the yaw axis applied by external forces above - ! the yaw bearing, such as wind loading - ! YawMom = torque transmitted through the yaw bearing - ! - ! If the commanded yaw angle and rate are correlated (so that the commanded - ! yaw angle is the integral of the commanded yaw rate, or likewise, the - ! commanded yaw rate is the derivative of the commanded yaw angle), then - ! FAST's built-in second-order actuator model will have the following - ! characteristic transfer function: - ! - ! YawDamp*s + YawSpr 2*Zeta*OmegaN*s + OmegaN^2 - ! T(s) = -------------------------------- = -------------------------------- - ! YawIner*s^2 + YawDamp*s + YawSpr s^2 + 2*Zeta*OmegaN*s + OmegaN^2 - ! - ! where, - ! T(s) = the transfer function of FAST's built-in 2nd order actuator - ! model - ! OmegaN = SQRT(YawSpr/YawIner) = yaw actuator natural frequency - ! Zeta = YawDamp/(2*SQRT(YawSpr*YawIner)) = yaw actuator damping ratio - ! in fraction of critical - ! - ! If only the yaw angle is commanded, and YawRateCom is zeroed, then the - ! charecteristic transfer function of FAST's built-in second-order - ! actuator model simplifies to: - ! - ! YawSpr OmegaN^2 - ! T(s) = -------------------------------- = -------------------------------- - ! YawIner*s^2 + YawDamp*s + YawSpr s^2 + 2*Zeta*OmegaN*s + OmegaN^2 - ! - ! If only the yaw rate is commanded, and YawPosCom is zeroed, then the - ! charecteristic transfer function of FAST's built-in second-order - ! actuator model simplifies to: - ! - ! YawDamp 2*Zeta*OmegaN - ! T(s) = -------------------------------- = -------------------------------- - ! YawIner*s^2 + YawDamp*s + YawSpr s^2 + 2*Zeta*OmegaN*s + OmegaN^2 - - - ! NOTE: If you (the user) wants to switch on-or-off the yaw DOF at - ! runtime from this user-defined routine, then do the following: - ! (1) USE MODULE DOFs(). - ! (2) Type in "DOF_Flag(DOF_Yaw) = VALUE" where VALUE = .TRUE. or - ! .FALSE. depending on whether you want to turn-on or turn-off - ! the DOF, respectively. Turning off the DOF acts is like - ! setting YawDOF to False. - ! This technique is useful, for example, if the yaw bearing has - ! an electromagnetic latch that will unlock and relock the hinge under - ! certain specified conditions. - ! Note that this technique WILL NOT work for user-defined routines - ! written for ADAMS datasets extracted using the FAST-to-ADAMS - ! preprocessor. - - -USE Precision -USE NWTC_Library - - -IMPLICIT NONE - - - ! Passed Variables: - -INTEGER(4), INTENT(IN ) :: NumBl ! Number of blades, (-). - -REAL(DbKi), INTENT(IN ) :: DT ! Integration time step, sec. -REAL(ReKi), INTENT(IN ) :: WindDir ! Current horizontal hub-height wind direction (positive about the zi-axis), rad. -REAL(ReKi), INTENT(IN ) :: YawError ! Current nacelle-yaw error estimate (positve about the zi-axis), rad. -REAL(ReKi), INTENT(IN ) :: YawPos ! Current nacelle-yaw angular position, rad. -REAL(ReKi), INTENT(OUT) :: YawPosCom ! Commanded nacelle-yaw angular position (demand yaw angle), rad. -REAL(ReKi), INTENT(IN ) :: YawRate ! Current nacelle-yaw angular rate, rad/s. -REAL(ReKi), INTENT(OUT) :: YawRateCom ! Commanded nacelle-yaw angular rate (demand yaw rate), rad/s. -REAL(DbKi), INTENT(IN ) :: ZTime ! Current simulation time, sec. - -CHARACTER(1024), INTENT(IN ) :: DirRoot ! The name of the root file including the full path to the current working directory. This may be useful if you want this routine to write a permanent record of what it does to be stored with the simulation results: the results should be stored in a file whose name (including path) is generated by appending any suitable extension to DirRoot. - - - -YawPosCom = 0.0 -YawRateCom = 0.0 - -!JASON: IMPOSE YAW STEP FOR FAST.Farm CALIBRATION CASE - START -IF ( ( ZTime >= 648.0_DbKi ) .AND. ( ZTime < 650.0_DbKi ) ) THEN - YawRateCom = ( 10.0_ReKi/2.0_ReKi )*D2R - YawPosCom = 0.0 + YawRateCom*( ZTime - 648.0_DbKi ) -ELSE IF ( ( ZTime >= 650.0_DbKi ) .AND. ( ZTime < 948.0_DbKi ) ) THEN - YawRateCom = 0.0 - YawPosCom = 10.0_ReKi*D2R -ELSE IF ( ( ZTime >= 948.0_DbKi ) .AND. ( ZTime < 950.0_DbKi ) ) THEN - YawRateCom = ( 15.0_ReKi/2.0_ReKi )*D2R - YawPosCom = 10.0_ReKi*D2R + YawRateCom*( ZTime - 948.0_DbKi ) -ELSE IF ( ( ZTime >= 950.0_DbKi ) ) THEN - YawRateCom = 0.0 - YawPosCom = 25.0_ReKi*D2R -END IF -!JASON: IMPOSE YAW STEP FOR FAST.Farm CALIBRATION CASE - END - - -RETURN -END SUBROUTINE UserYawCont -!======================================================================= -end module UserSubs diff --git a/OpenFAST/modules/servodyn/src/UserVSCont_KP.f90 b/OpenFAST/modules/servodyn/src/UserVSCont_KP.f90 deleted file mode 100644 index d36239968..000000000 --- a/OpenFAST/modules/servodyn/src/UserVSCont_KP.f90 +++ /dev/null @@ -1,243 +0,0 @@ - !> NOTE: This source file contains an example UserVSCont() user-specified - !! routine for computing variable-speed controlled generator torque - !! based on a table look-up of LSS speed and LSS torque provided in a - !! spd_trq.dat input file. It also contains an example UserGen, which - !! calls UserVSCont. These routines were written by Kirk Pierce (KP), - !! formerly of NREL/NWTC, and now with GE Wind Energy. Questions - !! related to the use of these routines should be addressed to Kirk - !! Pierce. -module UserVSCont_KP -contains - -!======================================================================= -SUBROUTINE UserGen ( HSS_Spd, LSS_Spd, NumBl, ZTime, DT, GenEff, DelGenTrq, DirRoot, GenTrq, ElecPwr ) - - - ! This example UserGen() is used do the same thing as SUBROUTINE - ! UserVSCont(), so that setting VSContrl to 0 and GenModel to 3 does - ! the same thing as setting VSContrl to 3. - - -USE Precision - - -IMPLICIT NONE - - - ! Passed Variables: - -INTEGER(IntKi), INTENT(IN ) :: NumBl ! Number of blades, (-). - -REAL(ReKi), INTENT(IN ) :: DelGenTrq ! Pertubation in generator torque used during FAST linearization (zero otherwise), N-m. -REAL(DbKi), INTENT(IN ) :: DT ! Integration time step, sec. -REAL(ReKi), INTENT(OUT) :: ElecPwr ! Electrical power (account for losses), watts. -REAL(ReKi), INTENT(IN ) :: GenEff ! Generator efficiency, (-). -REAL(ReKi), INTENT(OUT) :: GenTrq ! Electrical generator torque, N-m. -REAL(ReKi), INTENT(IN ) :: LSS_Spd ! LSS speed, rad/s. -REAL(ReKi), INTENT(IN ) :: HSS_Spd ! HSS speed, rad/s. -REAL(DbKi), INTENT(IN ) :: ZTime ! Current simulation time, sec. - -CHARACTER(1024),INTENT(IN ) :: DirRoot ! The name of the root file including the full path to the current working directory. This may be useful if you want this routine to write a permanent record of what it does to be stored with the simulation results: the results should be stored in a file whose name (including path) is generated by appending any suitable extension to DirRoot. - - - -CALL UserVSCont ( HSS_Spd, LSS_Spd, NumBl, ZTime, DT, GenEff, DelGenTrq, DirRoot, GenTrq, ElecPwr ) ! Let's have UserGen() do the same thing as SUBROUTINE UserVSCont(). - - - -RETURN -END SUBROUTINE UserGen -!======================================================================= -SUBROUTINE UserVSCont ( HSS_Spd, LSS_Spd, NumBl, ZTime, DT, GenEff, DelGenTrq, DirRoot, GenTrq, ElecPwr ) - - - ! Written 2/28/00 by Kirk Pierce for use with FAST. - ! This subroutine uses a torque vs speed lookup table. - ! A first order lag of time constant TCONST is applied to the - ! calculated torque. - - ! Converted to modern Fortran by M. Buhl. - ! Modified to calculate electrical generator power by J. Jonkman. - - ! 1 - ! GenTrq = ----------- TRQ - ! TCONST*S+1 - - -USE NWTC_Library - -IMPLICIT NONE - - - ! Passed Variables: -!type(strd_outputtype), intent(in), optional :: y_StrD -INTEGER(IntKi), INTENT(IN ) :: NumBl ! Number of blades, (-). - -REAL(ReKi), INTENT(IN ) :: DelGenTrq ! Pertubation in generator torque used during FAST linearization (zero otherwise), N-m. -REAL(DbKi), INTENT(IN ) :: DT ! Integration time step, sec. -REAL(ReKi), INTENT(OUT) :: ElecPwr ! Electrical power (account for losses), watts. -REAL(ReKi), INTENT(IN ) :: LSS_Spd ! LSS speed, rad/s. -REAL(ReKi), INTENT(IN ) :: GenEff ! Generator efficiency, (-). -REAL(ReKi), INTENT(OUT) :: GenTrq ! Electrical generator torque, N-m. -REAL(ReKi), INTENT(IN ) :: HSS_Spd ! HSS speed, rad/s. -REAL(DbKi), INTENT(IN ) :: ZTime ! Current simulation time, sec. - -CHARACTER(1024),INTENT(IN ) :: DirRoot ! The name of the root file including the full path to the current working directory. This may be useful if you want this routine to write a permanent record of what it does to be stored with the simulation results: the results should be stored in a file whose name (including path) is generated by appending any suitable extension to DirRoot. - - - ! Local Variables: - -REAL(ReKi), SAVE :: C1 -REAL(ReKi), SAVE :: C2 -REAL(DbKi) :: DELT -REAL(ReKi), SAVE :: FRPM (5) = 0.0 ! Filtered RPM. -REAL(ReKi), SAVE :: FTRQ = 0.0 ! Filtered torque, N-m. -REAL(ReKi), SAVE :: OLTRQ = 0.0 -REAL(ReKi) :: OMEGA ! Rotor speed, rad/s. -REAL(ReKi) :: RPM -REAL(ReKi), SAVE :: RPMSCH (100) -REAL(DbKi), SAVE :: SMPDT -REAL(DbKi), PARAMETER :: TCONST = 0.05 ! Time constant of first order lag applied to torque -REAL(ReKi), SAVE :: TLST = 0.0 -REAL(ReKi), SAVE :: TRQ = 0.0 -REAL(ReKi), SAVE :: TRQSCH (100) -REAL(DbKi), SAVE :: TTRQ = 0.0 - -INTEGER(IntKi) :: I -INTEGER(IntKi) :: IOS ! I/O status. Negative values indicate end of file. -INTEGER(IntKi) :: N1 -INTEGER, SAVE :: NSCH = 0 ! Number of lines found in the file -INTEGER, PARAMETER :: NST = 5 ! Number of integration time steps between controller torque calculations. -INTEGER, PARAMETER :: UnCont = 99 ! Unit number for the input file - -LOGICAL, SAVE :: SFLAG = .TRUE. - -CHARACTER(1024) :: TITLE -CHARACTER(1024) :: inFileName ! name of the input file - -INTEGER(IntKi) :: ErrStat -CHARACTER(ErrMsgLen) :: ErrMsg - -!bjj: there are numerical issues with time in this routine - - ! Abort if GBRatio is not unity; since this example routine returns the - ! generator torque cast to the LSS side of the gearbox, whereas routine - ! UserVSCont() should be returning the torque on the HSS side: -IF ( .NOT. EqualRealNos( HSS_Spd, LSS_Spd ) ) THEN - CALL ProgAbort ( " GBRatio must be set to 1.0 when using Kirk Pierce's UserVSCont() routine." ) -END IF - - -OMEGA = HSS_Spd - - -IF ( SFLAG ) THEN - - I = INDEX( DirRoot, PathSep, BACK=.TRUE. ) - IF ( I < LEN_TRIM(DirRoot) .OR. I > 0 ) THEN - inFileName = DirRoot(1:I)//'spd_trq.dat' - ELSE - inFileName = 'spd_trq.dat' - END IF - - - CALL OpenFInpFile ( UnCont, TRIM(inFileName), ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) CALL ProgAbort(TRIM(ErrMsg)) - - READ (UnCont,'(A)') TITLE - - CALL WrScr1( ' Using variable speed generator option.' ) - CALL WrScr ( ' '//TRIM( TITLE ) ) - CALL WrScr ( ' ' ) - - DO I=1,100 - READ(UnCont,*,IOSTAT=IOS) RPMSCH(I), TRQSCH(I) - IF ( IOS < 0 ) EXIT - - IF ( I > 1 ) THEN - IF ( RPMSCH(I) <= RPMSCH(I-1) ) THEN - CALL ProgWarn('RPM schedule must be increasing in file spd_trq.dat. Schedule will be stopped at ' & - //TRIM(Num2LStr(RPMSCH(I-1)))//' RPM.') - EXIT - END IF - END IF - NSCH = NSCH + 1 - ENDDO ! I - - SMPDT = REAL( NST, DbKi )*DT - - C1 = EXP( -DT/TCONST ) - C2 = 1.0 - C1 - - SFLAG = .FALSE. - CLOSE(UnCont) - - IF ( NSCH < 2 ) THEN - IF ( NSCH == 0 ) THEN - RPMSCH(1) = 0.0 - TRQSCH(1) = 0.0 - END IF - NSCH = 2 - RPMSCH(2) = RPMSCH(1) - TRQSCH(2) = TRQSCH(1) - END IF -ENDIF - -DELT = ZTime - TLST - - - ! Calculate torque setting at every NST time steps. -IF ( EqualRealNos( DELT, ( SMPDT - 0.5_DbKi*DT ) ) .OR. (DELT > ( SMPDT - 0.5*DT ))) then -!IF ( DELT >= ( SMPDT - 0.5*DT ) ) THEN !this should be comparing with EqualRealNos() - - TLST = ZTime !BJJ: TLST is a saved variable, which may have issues on re-initialization. - - - ! Update old values. - - DO I=5,2,-1 - FRPM(I) = FRPM(I-1) - ENDDO ! I - - RPM = OMEGA * 30.0/PI - - ! Calculate recursive lowpass filtered value. - - FRPM(1) = 0.7*FRPM(2) + 0.3*RPM - - - FRPM(1) = MIN( MAX( FRPM(1), RPMSCH(1) ), RPMSCH(NSCH) ) - TRQ = InterpBin( FRPM(1), RPMSCH(1:NSCH), TRQSCH(1:NSCH), N1, NSCH ) - - -ENDIF - - - ! Torque is updated at every integrator time step -IF ( (.NOT. EqualRealNos(ZTime, TTRQ )) .AND. ZTime > TTRQ ) THEN -!IF ( ZTime > TTRQ ) THEN - - FTRQ = C1*FTRQ + C2*OLTRQ - OLTRQ = TRQ - TTRQ = ZTime + 0.5_DbKi*DT - -ENDIF - - -GenTrq = FTRQ + DelGenTrq ! Make sure to add the pertubation on generator torque, DelGenTrq. This is used only for FAST linearization (it is zero otherwise). - - ! The generator efficiency is either additive for motoring, - ! or subtractive for generating power. - -IF ( GenTrq > 0.0 ) THEN - ElecPwr = GenTrq*HSS_Spd*GenEff -ELSE - ElecPwr = GenTrq*HSS_Spd/GenEff -ENDIF - - - -RETURN -END SUBROUTINE UserVSCont -!======================================================================= -end module UserVSCont_KP diff --git a/OpenFAST/modules/subdyn/CMakeLists.txt b/OpenFAST/modules/subdyn/CMakeLists.txt deleted file mode 100644 index 8d56cc80f..000000000 --- a/OpenFAST/modules/subdyn/CMakeLists.txt +++ /dev/null @@ -1,46 +0,0 @@ -# -# Copyright 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. -# - -if (GENERATE_TYPES) - generate_f90_types(src/SubDyn_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/SubDyn_Types.f90) -endif() - -set(SUBDYN_SOURCES - src/SubDyn.f90 - src/FEM.f90 - src/SD_FEM.f90 - src/SubDyn_Output.f90 - src/SubDyn_Output_Params.f90 - src/SubDyn_Tests.f90 - src/IntegerList.f90 - src/Yaml.f90 - src/SubDyn_Types.f90 -) - -add_library(subdynlib ${SUBDYN_SOURCES}) -target_link_libraries(subdynlib nwtclibs) - -set(SUBDYN_DRIVER_SOURCES - src/SubDyn_Driver.f90) - -add_executable(subdyn_driver ${SUBDYN_DRIVER_SOURCES}) -target_link_libraries(subdyn_driver subdynlib nwtclibs versioninfolib) - -install(TARGETS subdynlib subdyn_driver - EXPORT "${CMAKE_PROJECT_NAME}Libraries" - RUNTIME DESTINATION bin - LIBRARY DESTINATION lib - ARCHIVE DESTINATION lib) diff --git a/OpenFAST/modules/subdyn/README.md b/OpenFAST/modules/subdyn/README.md deleted file mode 100644 index 1e5f84bec..000000000 --- a/OpenFAST/modules/subdyn/README.md +++ /dev/null @@ -1,25 +0,0 @@ -# SubDyn Module -The legacy version of this module and additional documentation are available -at the [NWTC Software Portal](https://nwtc.nrel.gov/SubDyn/). - -## Overview -SubDyn is a time-domain structural-dynamics module for multi-member -fixed-bottom substructures that has been coupled into the OpenFAST -aero-hydro-servo-elastic computer-aided engineering (CAE) tool. Substructure -types supported by SubDyn include monopiles, tripods, jackets, and other -lattice-type substructures common for offshore wind installations in shallow -and transitional water depths. SubDyn can also be used to model lattice -support structures for land-based wind turbines. - -SubDyn follows the requirements of the FAST modularization framework and -couples to OpenFAST. It can also be driven as a standalone code to compute -the mode shapes, natural frequencies, and time-domain responses of -substructures, uncoupled from OpenFAST and in the absence of external loading -other than gravity and interface motion. - -SubDyn relies on two main engineering schematizations -1. a linear frame finite-element beam model (LFEB) -2. a dynamics system reduction via Craig-Bampton’s (C-B) method - -together with a Static-Improvement method, greatly reducing the number of modes -needed to obtain an accurate solution. diff --git a/OpenFAST/modules/subdyn/src/FEM.f90 b/OpenFAST/modules/subdyn/src/FEM.f90 deleted file mode 100644 index 2d5972e4d..000000000 --- a/OpenFAST/modules/subdyn/src/FEM.f90 +++ /dev/null @@ -1,1410 +0,0 @@ -!.................................................................................................................................. -! LICENSING -! Copyright (C) 2013-2016 National Renewable Energy Laboratory -! -! This file is part of SubDyn. -! -! 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. -!********************************************************************************************************************************** -!> Standalone tools for beam-based finite element method (FEM) -!! No dependency with SubDyn types and representation -MODULE FEM - USE NWTC_Library - IMPLICIT NONE - - INTEGER, PARAMETER :: FEKi = R8Ki ! Define the kind to be used for FEM - INTEGER, PARAMETER :: LaKi = R8Ki ! Define the kind to be used for LaPack - -CONTAINS -!------------------------------------------------------------------------------------------------------ -!> Return eigenvalues, Omega, and eigenvectors - -SUBROUTINE EigenSolve(K, M, N, bCheckSingularity, EigVect, Omega, ErrStat, ErrMsg ) - USE NWTC_LAPACK, only: LAPACK_ggev - INTEGER , INTENT(IN ) :: N !< Number of degrees of freedom, size of M and K - REAL(LaKi), INTENT(INOUT) :: K(N, N) !< Stiffness matrix - REAL(LaKi), INTENT(INOUT) :: M(N, N) !< Mass matrix - LOGICAL, INTENT(IN ) :: bCheckSingularity ! If True, the solver will fail if rigid modes are present - REAL(LaKi), INTENT(INOUT) :: EigVect(N, N) !< Returned Eigenvectors - REAL(LaKi), INTENT(INOUT) :: Omega(N) !< Returned Eigenvalues - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - ! LOCALS - REAL(LaKi), ALLOCATABLE :: WORK (:), VL(:,:), AlphaR(:), AlphaI(:), BETA(:) ! eigensolver variables - INTEGER :: i - INTEGER :: LWORK !variables for the eigensolver - INTEGER, ALLOCATABLE :: KEY(:) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - REAL(LaKi) :: normA - REAL(LaKi) :: Omega2(N) !< Squared eigenvalues - REAL(LaKi), parameter :: MAX_EIGENVALUE = HUGE(1.0_ReKi) ! To avoid overflow when switching to ReKi - - ErrStat = ErrID_None - ErrMsg = '' - - ! allocate working arrays and return arrays for the eigensolver - LWORK=8*N + 16 !this is what the eigensolver wants >> bjj: +16 because of MKL ?ggev documenation ( "lwork >= max(1, 8n+16) for real flavors"), though LAPACK documenation says 8n is fine - !bjj: there seems to be a memory problem in *GGEV, so I'm making the WORK array larger to see if I can figure it out - CALL AllocAry( Work, LWORK, 'Work', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'EigenSolve') - CALL AllocAry( AlphaR, N, 'AlphaR', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'EigenSolve') - CALL AllocAry( AlphaI, N, 'AlphaI', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'EigenSolve') - CALL AllocAry( Beta, N, 'Beta', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'EigenSolve') - CALL AllocAry( VL, N, N, 'VL', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'EigenSolve') - CALL AllocAry( KEY, N, 'KEY', ErrStat2, ErrMsg2 ); if(Failed()) return - - ! --- Eigenvalue analysis - ! note: SGGEV seems to have memory issues in certain cases. The eigenvalues seem to be okay, but the eigenvectors vary wildly with different compiling options. - ! DGGEV seems to work better, so I'm making these variables LaKi (which is set to R8Ki for now) - bjj 4/25/2014 - ! bjj: This comes from the LAPACK documentation: - ! Note: the quotients AlphaR(j)/BETA(j) and AlphaI(j)/BETA(j) may easily over- or underflow, and BETA(j) may even be zero. - ! Thus, the user should avoid naively computing the ratio Alpha/beta. However, AlphaR and AlphaI will be always less - ! than and usually comparable with norm(A) in magnitude, and BETA always less than and usually comparable with norm(B). - ! Omega2=AlphaR/BETA !Note this may not be correct if AlphaI<>0 and/or BETA=0 TO INCLUDE ERROR CHECK, also they need to be sorted - CALL LAPACK_ggev('N','V',N ,K, M, AlphaR, AlphaI, Beta, VL, EigVect, WORK, LWORK, ErrStat2, ErrMsg2) - if(Failed()) return - - ! --- Determinign and sorting eigen frequencies - Omega2(:) =0.0_LaKi - DO I=1,N !Initialize the key and calculate Omega - KEY(I)=I - Omega2(I) = AlphaR(I)/Beta(I) - if ( EqualRealNos(real(Beta(I),ReKi),0.0_ReKi) ) then - ! --- Beta =0 - if (bCheckSingularity) call WrScr('[WARN] Large eigenvalue found, system may be ill-conditioned') - Omega2(I) = MAX_EIGENVALUE - elseif ( EqualRealNos(real(AlphaI(I),ReKi),0.0_ReKi) ) THEN - ! --- Real Eigenvalues - IF ( AlphaR(I)<0.0_LaKi ) THEN - if ( (AlphaR(I)/Beta(I))<1e-6_LaKi ) then - ! Tolerating very small negative eigenvalues - if (bCheckSingularity) call WrScr('[INFO] Negative eigenvalue found with small norm (system may contain rigid body mode)') - Omega2(I)=0.0_LaKi - else - if (bCheckSingularity) call WrScr('[WARN] Negative eigenvalue found, system may be ill-conditioned.') - Omega2(I)=AlphaR(I)/Beta(I) - endif - else - Omega2(I) = AlphaR(I)/Beta(I) - endif - else - ! --- Complex Eigenvalues - normA = sqrt(AlphaR(I)**2 + AlphaI(I)**2) - if ( (normA/Beta(I))<1e-6_LaKi ) then - ! Tolerating very small eigenvalues with imaginary part - if (bCheckSingularity) call WrScr('[WARN] Complex eigenvalue found with small norm, approximating as 0') - Omega2(I) = 0.0_LaKi - elseif ( abs(AlphaR(I))>1e3_LaKi*abs(AlphaI(I)) ) then - ! Tolerating very small imaginary part compared to real part... (not pretty) - if (bCheckSingularity) call WrScr('[WARN] Complex eigenvalue found with small Im compare to Re') - Omega2(I) = AlphaR(I)/Beta(I) - else - if (bCheckSingularity) call WrScr('[WARN] Complex eigenvalue found with large imaginary value)') - Omega2(I) = MAX_EIGENVALUE - endif - !call Fatal('Complex eigenvalue found, system may be ill-conditioned'); return - endif - ! Capping to avoid overflow - if (Omega2(I)> MAX_EIGENVALUE) then - Omega2(I) = MAX_EIGENVALUE - endif - enddo - - ! Sorting. LASRT has issues for double precision 64 bit on windows - !CALL ScaLAPACK_LASRT('I',N,Omega2,KEY,ErrStat2,ErrMsg2); if(Failed()) return - CALL sort_in_place(Omega2,KEY) - - ! --- Sorting eigen vectors - ! KEEP ME: scaling of the eigenvectors using generalized mass =identity criterion - ! ALLOCATE(normcoeff(N,N), STAT = ErrStat ) - ! result1 = matmul(M,EigVect) - ! result2 = matmul(transpose(EigVect),result1) - ! normcoeff=sqrt(result2) !This should be a diagonal matrix which contains the normalization factors - ! normcoeff=sqrt(matmul(transpose(EigVect),matmul(M,EigVect))) !This should be a diagonal matrix which contains the normalization factors - VL=EigVect !temporary storage for sorting EigVect - DO I=1,N - !EigVect(:,I)=VL(:,KEY(I))/normcoeff(KEY(I),KEY(I)) !reordered and normalized - EigVect(:,I)=VL(:,KEY(I)) !just reordered as Huimin had a normalization outside of this one - ENDDO - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! - - ! --- Return Omega (capped by huge(ReKi)) and check for singularity - Omega(:) = 0.0_LaKi - do I=1,N - if (EqualRealNos(real(Omega2(I),ReKi), 0.0_ReKi)) then ! NOTE: may be necessary for some corner numerics - Omega(i)=0.0_LaKi - if (bCheckSingularity) then - call Fatal('Zero eigenvalue found, system may contain rigid body mode'); return - endif - elseif (Omega2(I)>0) then - Omega(i)=sqrt(Omega2(I)) - else - ! Negative eigenfrequency - print*,'>>> Wrong eigenfrequency, Omega^2=',Omega2(I) ! <<< This should never happen - Omega(i)= 0.0_LaKi - call Fatal('Negative eigenvalue found, system may be ill-conditioned'); return - endif - enddo - - CALL CleanupEigen() - RETURN - -CONTAINS - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'EigenSolve') - Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUpEigen() - END FUNCTION Failed - - SUBROUTINE Fatal(ErrMsg_in) - character(len=*), intent(in) :: ErrMsg_in - CALL SetErrStat(ErrID_Fatal, ErrMsg_in, ErrStat, ErrMsg, 'EigenSolve'); - CALL CleanUpEigen() - END SUBROUTINE Fatal - - SUBROUTINE CleanupEigen() - IF (ALLOCATED(Work) ) DEALLOCATE(Work) - IF (ALLOCATED(AlphaR)) DEALLOCATE(AlphaR) - IF (ALLOCATED(AlphaI)) DEALLOCATE(AlphaI) - IF (ALLOCATED(Beta) ) DEALLOCATE(Beta) - IF (ALLOCATED(VL) ) DEALLOCATE(VL) - IF (ALLOCATED(KEY) ) DEALLOCATE(KEY) - END SUBROUTINE CleanupEigen - -END SUBROUTINE EigenSolve - -pure subroutine sort_in_place(a,key) - real(LaKi), intent(inout), dimension(:) :: a - integer(IntKi), intent(inout), dimension(:) :: key - integer(IntKi) :: tempI - real(LaKi) :: temp - integer(IntKi) :: i, j - do i = 2, size(a) - j = i - 1 - temp = a(i) - tempI = key(i) - do while (j>=1 .and. a(j)>temp) - a(j+1) = a(j) - key(j+1) = key(j) - j = j - 1 - if (j<1) then - exit - endif - end do - a(j+1) = temp - key(j+1) = tempI - end do -end subroutine sort_in_place - -!> Compute the determinant of a real matrix using an LU factorization -FUNCTION Determinant(A, ErrStat, ErrMsg) result(det) - use NWTC_LAPACK, only: LAPACK_GETRF - REAL(FEKi), INTENT(IN ) :: A(:, :) !< Input matrix, no side effect - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - real(FEKi) :: det !< May easily overflow - integer(IntKi) :: i - integer :: n - integer, allocatable :: ipiv(:) - real(FEKi), allocatable :: PLU(:,:) - real(FEKi) :: ScaleVal - - n = size(A(1,:)) - allocate(PLU(n,n)) - allocate(ipiv(n)) - ScaleVal= 1.0_FEKi - PLU = A/ScaleVal - ! general matrix factorization: Factor matrix into A=PLU. - call LAPACK_GETRF( n, n, PLU, ipiv, ErrStat, ErrMsg ) !call dgetrf(n, n, PLU, n, ipiv, info) - if (ErrStat==ErrID_Fatal) then - print*,'Error in getrf' - det = 0 - deallocate(PLU) - deallocate(ipiv) - return - endif - ! PLU now contains the LU of the factorization A = PLU - ! As L has unit diagonal entries, the determinant can be computed - ! from the product of U's diagonal entries. Additional sign changes - ! stemming from the permutations P have to be taken into account as well. - det = 1.0_FEKi - do i = 1,n - if(ipiv(i) /= i) then ! additional sign change - det = -det*PLU(i,i) - else - det = det*PLU(i,i) - endif - end do - deallocate(PLU) - deallocate(ipiv) - IF ( EqualRealNos(real(det, ReKi), 0.0_ReKi) ) THEN - print*,'Det is zero' - return - else - det = det*(ScaleVal**n) - endif -END FUNCTION Determinant -!------------------------------------------------------------------------------------------------------ -!> Create a chessboard-like matrix with `valBlack` on the "black" cases, starting with black at (1,1) -!! As a generalization, "black" values may be spaced every `nSpace` squares -!! For instance, blackVal=9, whiteVal=0, nSpace=2 -!! [9 0 0 9 0 0 9] -!! [0 9 0 0 9 0 0] -!! [0 0 9 0 0 9 0] -!! Diagonal values may be overriden by `diagVal` -!! Matrix M does not need to be square -subroutine ChessBoard(M, blackVal, whiteVal, nSpace, diagVal) - real(ReKi), dimension(:,:), intent( out) :: M !< Output matrix - real(ReKi), intent(in ) :: blackVal !< value for black squares - real(ReKi), intent(in ) :: whiteVal !< value for white squre - integer(IntKi), optional, intent(in ) :: nSpace !< spacing between black values, default 1 - real(ReKi), optional, intent(in ) :: diagVal !< Value to override diagonal - integer(IntKi) :: i, j, jFake, n - ! Default value for spacing is 1 if not provided - if (present(nSpace)) then; n=nSpace+1; else; n=2; endif - ! Default values are white values - M(:,:) = whiteVal - ! Setting black values everyother n values - do i=1,size(M,2) - do jFake=1,size(M,2),n ! everyother n values - j = mod(jFake+i-2, size(M,2)) +1 - !print*,'i,j',i,jFake,j - M(i,j) = blackVal - enddo - enddo - ! Forcing diagonal values - if (present(diagVal)) then - do i=1,size(M,1) - do j=1,size(M,2) ! Matrix not necessarily square - if (i==j) M(i,i) = diagVal - enddo - enddo - endif -end subroutine ChessBoard -!------------------------------------------------------------------------------------------------------ -!> Partition matrices and vectors into Boundary (R) and internal (L) nodes -!! M = [ MRR, MRL ] -!! [ sym, MLL ] -!! MRR = M(IDR, IDR), KRR = M(IDR, IDR), FR = F(IDR) -!! MLL = M(IDL, IDL), KRR = K(IDL, IDL), FL = F(IDL) -!! MRL = M(IDR, IDL), KRR = K(IDR, IDL) -!! NOTE: generic code -SUBROUTINE BreakSysMtrx(MM, KK, IDR, IDL, nR, nL, MRR, MLL, MRL, KRR, KLL, KRL, FG, FGR, FGL, CC, CRR, CLL, CRL) - REAL(FEKi), INTENT(IN ) :: MM(:,:) !< Mass Matrix - REAL(FEKi), INTENT(IN ) :: KK(:,:) !< Stiffness matrix - INTEGER(IntKi), INTENT(IN ) :: nR - INTEGER(IntKi), INTENT(IN ) :: nL - INTEGER(IntKi), INTENT(IN ) :: IDR(nR) !< Indices of leader DOFs - INTEGER(IntKi), INTENT(IN ) :: IDL(nL) !< Indices of interior DOFs - REAL(FEKi), INTENT( OUT) :: MRR(nR, nR) - REAL(FEKi), INTENT( OUT) :: MLL(nL, nL) - REAL(FEKi), INTENT( OUT) :: MRL(nR, nL) - REAL(FEKi), INTENT( OUT) :: KRR(nR, nR) - REAL(FEKi), INTENT( OUT) :: KLL(nL, nL) - REAL(FEKi), INTENT( OUT) :: KRL(nR, nL) - REAL(FEKi), OPTIONAL, INTENT(IN ) :: FG(:) !< Force vector - REAL(FEKi), OPTIONAL, INTENT( OUT) :: FGR(nR) - REAL(FEKi), OPTIONAL, INTENT( OUT) :: FGL(nL) - REAL(FEKi), OPTIONAL, INTENT(IN ) :: CC(:,:) !< Stiffness matrix - REAL(FEKi), OPTIONAL, INTENT( OUT) :: CRR(nR, nR) - REAL(FEKi), OPTIONAL, INTENT( OUT) :: CLL(nL, nL) - REAL(FEKi), OPTIONAL, INTENT( OUT) :: CRL(nR, nL) - INTEGER(IntKi) :: I, J, II, JJ - - ! RR: Leader/Boundary DOFs - DO I = 1, nR - II = IDR(I) - DO J = 1, nR - JJ = IDR(J) - MRR(I, J) = MM(II, JJ) - KRR(I, J) = KK(II, JJ) - ENDDO - ENDDO - ! LL: Interior/follower DOFs - DO I = 1, nL - II = IDL(I) - DO J = 1, nL - JJ = IDL(J) - MLL(I, J) = MM(II, JJ) - KLL(I, J) = KK(II, JJ) - ENDDO - ENDDO - ! RL: cross terms - DO I = 1, nR - II = IDR(I) - DO J = 1, nL - JJ = IDL(J) - MRL(I, J) = MM(II, JJ) - KRL(I, J) = KK(II, JJ) - ENDDO - ENDDO - ! Forces - if (present(FG)) then - if (present(FGR)) then - do I = 1, nR - II = IDR(I) - FGR(I) = FG(II) - enddo - endif - if (present(FGL)) then - do I = 1, nL - II = IDL(I) - FGL(I) = FG(II) - enddo - endif - endif - if (present(CC)) then - ! RR: Leader/Boundary DOFs - DO I = 1, nR - II = IDR(I) - DO J = 1, nR - JJ = IDR(J) - CRR(I, J) = CC(II, JJ) - ENDDO - ENDDO - ! LL: Interior/follower DOFs - DO I = 1, nL - II = IDL(I) - DO J = 1, nL - JJ = IDL(J) - CLL(I, J) = CC(II, JJ) - ENDDO - ENDDO - ! RL: cross terms - DO I = 1, nR - II = IDR(I) - DO J = 1, nL - JJ = IDL(J) - CRL(I, J) = CC(II, JJ) - ENDDO - ENDDO - endif -END SUBROUTINE BreakSysMtrx - -!------------------------------------------------------------------------------------------------------ -!> Performs Craig-Bampton reduction of M and K matrices and optional Force vector -!! TODO: (Damping optional) -!! Convention is: -!! "R": leader DOF -> "B": reduced leader DOF -!! "L": interior DOF -> "M": reduced interior DOF (CB-modes) -!! NOTE: -!! - M_MM = Identity and K_MM = Omega*2 hence these matrices are not returned -!! - Possibility to get more CB modes using the input nM_Out>nM -!! -!! NOTE: generic code -SUBROUTINE CraigBamptonReduction(MM, KK, IDR, nR, IDL, nL, nM, nM_Out, MBB, MBM, KBB, PhiL, PhiR, OmegaL, ErrStat, ErrMsg, FG, FGR, FGL, FGB, FGM, CC, CBB, CBM, CMM) - use NWTC_LAPACK, only: LAPACK_GEMV - REAL(FEKi), INTENT(IN ) :: MM(:, :) !< Mass matrix - REAL(FEKi), INTENT(IN ) :: KK(:, :) !< Stiffness matrix - INTEGER(IntKi), INTENT(IN ) :: nR - INTEGER(IntKi), INTENT(IN ) :: IDR(nR) !< Indices of leader DOFs - INTEGER(IntKi), INTENT(IN ) :: nL - INTEGER(IntKi), INTENT(IN ) :: IDL(nL) !< Indices of interior DOFs - INTEGER(IntKi), INTENT(IN ) :: nM !< Number of CB modes - INTEGER(IntKi), INTENT(IN ) :: nM_Out !< Number of modes returned for PhiL & OmegaL - REAL(FEKi), INTENT( OUT) :: MBB( nR, nR) !< Reduced Guyan Mass Matrix - REAL(FEKi), INTENT( OUT) :: KBB( nR, nR) !< Reduced Guyan Stiffness matrix - REAL(FEKi), INTENT( OUT) :: MBM( nR, nM) !< Cross term - REAL(FEKi), INTENT( OUT) :: PhiR(nL, nR) !< Guyan Modes - REAL(FEKi), INTENT( OUT) :: PhiL(nL, nM_out) !< Craig-Bampton modes - REAL(FEKi), INTENT( OUT) :: OmegaL(nM_out) !< Eigenvalues - REAL(FEKi), OPTIONAL, INTENT(IN ) :: FG(:) !< Force vector (typically a constant force, like gravity) - REAL(FEKi), OPTIONAL, INTENT( OUT) :: FGR(nR) !< Force vector partitioned for R DOFs (TODO remove me) - REAL(FEKi), OPTIONAL, INTENT( OUT) :: FGL(nL) !< Force vector partitioned for L DOFs (TODO somehow for Static improvment..) - REAL(FEKi), OPTIONAL, INTENT( OUT) :: FGB(nR) !< Force vector in Guyan modes = FR+PhiR^t FL - REAL(FEKi), OPTIONAL, INTENT( OUT) :: FGM(nM) !< Force vector in CB modes = PhiM^t FL - REAL(FEKi), OPTIONAL, INTENT(IN ) :: CC(:, :) !< Damping matrix - REAL(FEKi), OPTIONAL, INTENT( OUT) :: CBB(nR, nR) !< Guyan Damping matrix - REAL(FEKi), OPTIONAL, INTENT( OUT) :: CBM(nR, nM) !< Coupling Damping matrix - REAL(FEKi), OPTIONAL, INTENT( OUT) :: CMM(nM, nM) !< Craig-Bampton Damping matrix - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'CraigBamptonReduction_FromPartition' - ! Partitioned variables - real(FEKi), allocatable :: MRR(:, :) - real(FEKi), allocatable :: MLL(:, :) - real(FEKi), allocatable :: MRL(:, :) - real(FEKi), allocatable :: KRR(:, :) - real(FEKi), allocatable :: KLL(:, :) - real(FEKi), allocatable :: KRL(:, :) - real(FEKi), allocatable :: CRR(:, :) - real(FEKi), allocatable :: CRL(:, :) - real(FEKi), allocatable :: CLL(:, :) - ! --- Break system - CALL AllocAry(MRR, nR, nR, 'matrix MRR', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(MLL, nL, nL, 'matrix MLL', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(MRL, nR, nL, 'matrix MRL', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(KRR, nR, nR, 'matrix KRR', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(KLL, nL, nL, 'matrix KLL', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(KRL, nR, nL, 'matrix KRL', ErrStat2, ErrMsg2 ); if(Failed()) return - if (present(CC)) then - CALL AllocAry(CRR, nR, nR, 'matrix CRR', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(CLL, nL, nL, 'matrix CLL', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(CRL, nR, nL, 'matrix CRL', ErrStat2, ErrMsg2 ); if(Failed()) return - endif - call BreakSysMtrx(MM, KK, IDR, IDL, nR, nL, MRR, MLL, MRL, KRR, KLL, KRL, FG=FG, FGR=FGR, FGL=FGL, CC=CC, CRR=CRR, CLL=CLL, CRL=CRL) - ! --- CB reduction - call CraigBamptonReduction_FromPartition( MRR, MLL, MRL, KRR, KLL, KRL, nR, nL, nM, nM_Out,& !< Inputs - MBB, MBM, KBB, PhiL, PhiR, OmegaL, ErrStat2, ErrMsg2, & !< Outputs - CRR=CRR, CLL=CLL, CRL=CRL,& !< Optional inputs - CBB=CBB, CBM=CBM, CMM=CMM) !< Optional Outputs - if(Failed()) return - - ! --- Reduction of force if provided - if (present(FG).and.present(FGR).and.present(FGL)) then - if (present(FGB)) then - !FGB = FGR + matmul( transpose(PhiR), FGL) - if (nL>0) then - CALL LAPACK_GEMV('t', nL , nR, 1.0_FeKi, PhiR, nL, FGL, 1, 0.0_FeKi, FGB, 1 ) - FGB = FGR + FGB - else - FGB = FGR - endif - endif - if (present(FGM)) then - !FGM = matmul( FGL, PhiL(:,1:nM) ) != matmul( transpose(PhiM), FGL ) because FGL is 1-D - if (nM>0) then - CALL LAPACK_GEMV('t', nL , nM, 1.0_FeKi, PhiL(:,1:nM), nL, FGL, 1, 0.0_FeKi, FGM, 1 ) - endif - endif - endif - call CleanUp() - -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CraigBamptonReduction') - Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() - end function Failed - subroutine CleanUp() - IF(ALLOCATED(MRR) ) DEALLOCATE(MRR) - IF(ALLOCATED(MLL) ) DEALLOCATE(MLL) - IF(ALLOCATED(MRL) ) DEALLOCATE(MRL) - IF(ALLOCATED(KRR) ) DEALLOCATE(KRR) - IF(ALLOCATED(KLL) ) DEALLOCATE(KLL) - IF(ALLOCATED(KRL) ) DEALLOCATE(KRL) - IF(ALLOCATED(CRR) ) DEALLOCATE(CRR) - IF(ALLOCATED(CLL) ) DEALLOCATE(CLL) - IF(ALLOCATED(CRL) ) DEALLOCATE(CRL) - end subroutine -END SUBROUTINE CraigBamptonReduction - -!------------------------------------------------------------------------------------------------------ -!> Performs Craig-Bampton reduction based on partitioned matrices M and K -!! Convention is: -!! "R": leader DOF -> "B": reduced leader DOF -!! "L": interior DOF -> "M": reduced interior DOF (CB-modes) -!! NOTE: -!! - M_MM = Identity and K_MM = Omega*2 hence these matrices are not returned -!! - Possibility to get more CB modes using the input nM_Out>nM (e.g. for static improvement) -!! -!! NOTE: generic code -SUBROUTINE CraigBamptonReduction_FromPartition( MRR, MLL, MRL, KRR, KLL, KRL, nR, nL, nM, nM_Out,& - MBB, MBM, KBB, PhiL, PhiR, OmegaL, ErrStat, ErrMsg,& - CRR, CLL, CRL, CBB, CBM, CMM) - USE NWTC_LAPACK, only: LAPACK_getrs, LAPACK_getrf, LAPACK_gemm - INTEGER(IntKi), INTENT( in) :: nR - INTEGER(IntKi), INTENT( in) :: nL - INTEGER(IntKi), INTENT( in) :: nM_Out - INTEGER(IntKi), INTENT( in) :: nM - REAL(FEKi), INTENT( IN) :: MRR( nR, nR) !< Partitioned mass and stiffness matrices - REAL(FEKi), INTENT( IN) :: MLL( nL, nL) - REAL(FEKi), INTENT( IN) :: MRL( nR, nL) - REAL(FEKi), INTENT( IN) :: KRR( nR, nR) - REAL(FEKi), INTENT(INOUT) :: KLL( nL, nL) ! on exit, it has been factored (otherwise not changed) - REAL(FEKi), INTENT( IN) :: KRL( nR, nL) - REAL(FEKi), INTENT( OUT) :: MBB( nR, nR) - REAL(FEKi), INTENT( OUT) :: MBM( nR, nM) - REAL(FEKi), INTENT( OUT) :: KBB( nR, nR) - REAL(FEKi), INTENT( OUT) :: PhiR(nL, nR) !< Guyan Modes - REAL(FEKi), INTENT( OUT) :: PhiL(nL, nM_Out) !< Craig-Bampton modes - REAL(FEKi), INTENT( OUT) :: OmegaL(nM_Out) !< Eigenvalues - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(FEKi), OPTIONAL, INTENT( IN) :: CRR( nR, nR) !< Partitioned damping matrices - REAL(FEKi), OPTIONAL, INTENT( IN) :: CLL( nL, nL) - REAL(FEKi), OPTIONAL, INTENT( IN) :: CRL( nR, nL) - REAL(FEKi), OPTIONAL, INTENT( OUT) :: CBB( nR, nR) !< Guyan damping matrix - REAL(FEKi), OPTIONAL, INTENT( OUT) :: CBM( nR, nM) !< Coupling damping matrix - REAL(FEKi), OPTIONAL, INTENT( OUT) :: CMM( nM, nM) !< CB damping matrix - ! LOCAL VARIABLES - REAL(FEKi) , allocatable :: Mu(:, :) ! matrix for normalization Mu(p%nDOFL, p%nDOFL) [bjj: made allocatable to try to avoid stack issues] - REAL(FEKi) , allocatable :: Temp(:, :) ! temp matrix for intermediate steps [bjj: made allocatable to try to avoid stack issues] - REAL(FEKi) , allocatable :: PhiR_T_MLL(:,:) ! PhiR_T_MLL(nR,nL) = transpose of PhiR * MLL (temporary storage) - INTEGER :: I !counter - INTEGER :: ipiv(nL) ! length min(m,n) (See LAPACK documentation) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'CraigBamptonReduction_FromPartition' - ErrStat = ErrID_None - ErrMsg = '' - - if (nM_out>nL) then - ErrMsg2='Cannot request more modes than internal degrees of Freedom'; ErrStat2=ErrID_Fatal; - if(Failed()) return; - endif - if (nM_out 0 ) then - ! bCheckSingularity = True - CALL EigenSolveWrap(KLL, MLL, nL, nM_out, .True., PhiL(:,1:nM_out), OmegaL(1:nM_out), ErrStat2, ErrMsg2); if(Failed()) return - ! --- Normalize PhiL - ! MU = MATMUL ( MATMUL( TRANSPOSE(PhiL), MLL ), PhiL ) - CALL AllocAry( Temp , nM_out, nL , 'Temp' , ErrStat2 , ErrMsg2); if(Failed()) return - CALL AllocAry( MU , nM_out, nM_out , 'Mu' , ErrStat2 , ErrMsg2); if(Failed()) return - CALL LAPACK_gemm( 'T', 'N', 1.0_FeKi, PhiL, MLL, 0.0_FeKi, Temp , ErrStat2, ErrMsg2); if(Failed()) return - CALL LAPACK_gemm( 'N', 'N', 1.0_FeKi, Temp, PhiL, 0.0_FeKi, MU , ErrStat2, ErrMsg2); if(Failed()) return - DEALLOCATE(Temp) - ! PhiL = MATMUL( PhiL, MU ) ! this is the normalization (MU is diagonal) - DO I = 1, nM_out - PhiL(:,I) = PhiL(:,I) / SQRT( MU(I, I) ) - ENDDO - DEALLOCATE(MU) - if (present(CRR)) then - ! CB damping CMM = PhiL^T CLL PhiL - CALL AllocAry( Temp , nM, nL , 'Temp' , ErrStat2 , ErrMsg2); if(Failed()) return - CALL LAPACK_gemm( 'T', 'N', 1.0_FeKi, PhiL(1:nL, 1:nM), CLL, 0.0_FeKi, Temp , ErrStat2, ErrMsg2); if(Failed()) return - CALL LAPACK_gemm( 'N', 'N', 1.0_FeKi, Temp, PhiL(1:nL, 1:nM), 0.0_FeKi, CMM , ErrStat2, ErrMsg2); if(Failed()) return - DEALLOCATE(Temp) - endif - else - PhiL = 0.0_FEKi - OmegaL = 0.0_FEKi - if (present(CRR)) CMM = 0.0_FEKi - end if - - if (nL>0) then - ! --- Compute Guyan Modes (PhiR) - ! factor KLL to compute PhiR: KLL*PhiR=-TRANSPOSE(KRL) - ! ** note this must be done after EigenSolveWrap() because it modifies KLL ** - CALL LAPACK_getrf( nL, nL, KLL, ipiv, ErrStat2, ErrMsg2); if(Failed()) return - - PhiR = -1.0_FEKi * TRANSPOSE(KRL) !set "b" in Ax=b (solve KLL * PhiR = - TRANSPOSE( KRL ) for PhiR) - CALL LAPACK_getrs( TRANS='N', N=nL, A=KLL, IPIV=ipiv, B=PhiR, ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return - - ! --- Set MBB, MBM, and KBB from Eq. 4: - CALL AllocAry( PhiR_T_MLL, nR, nL, 'PhiR_T_MLL', ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry( Temp , nR, nR, 'Temp' , ErrStat2 , ErrMsg2); if(Failed()) return - - ! PhiR_T_MLL = TRANSPOSE(PhiR) * MLL - CALL LAPACK_gemm( 'T', 'N', 1.0_FeKi, PhiR, MLL, 0.0_FeKi, PhiR_T_MLL , ErrStat2, ErrMsg2); if(Failed()) return - ! MBB1 = MATMUL(MRL, PhiR) - CALL LAPACK_gemm( 'N', 'N', 1.0_FeKi, MRL, PhiR, 0.0_FeKi, MBB , ErrStat2, ErrMsg2); if(Failed()) return - ! MBB2 = MATMUL( PhiR_T_MLL, PhiR ) - CALL LAPACK_gemm( 'N', 'N', 1.0_FeKi, PhiR_T_MLL, PhiR, 0.0_FeKi, Temp , ErrStat2, ErrMsg2); if(Failed()) return - MBB = MRR + MBB + TRANSPOSE( MBB ) + Temp - DEALLOCATE(Temp) - - IF ( nM == 0) THEN - MBM = 0.0_FEKi - ELSE - CALL AllocAry( Temp , nR, nM, 'Temp' , ErrStat2 , ErrMsg2); if(Failed()) return - !MBM = MATMUL( PhiR_T_MLL, PhiL(:,1:nM)) ! last half of operation - CALL LAPACK_gemm( 'N', 'N', 1.0_FeKi, PhiR_T_MLL, PhiL(:,1:nM), 0.0_FeKi, MBM , ErrStat2, ErrMsg2); if(Failed()) return - ! Temp = MATMUL( MRL, PhiL(:,1:nM) ) - CALL LAPACK_gemm( 'N', 'N', 1.0_FeKi, MRL, PhiL(:,1:nM), 0.0_FeKi, Temp , ErrStat2, ErrMsg2); if(Failed()) return - MBM = Temp + MBM !This had PhiM - DEALLOCATE(Temp) - ENDIF - - !KBB = MATMUL(KRL, PhiR) - CALL LAPACK_gemm( 'N', 'N', 1.0_FeKi, KRL, PhiR, 0.0_FeKi, KBB , ErrStat2, ErrMsg2); if(Failed()) return - KBB = KBB + KRR - - if (present(CRR)) then - ! Guyan damping CBB = CRR + (CRL*PhiR) + (CRL*PhiR)^T + PhiR^T*CLL*PhiR - ! PhiR_T_CLL = TRANSPOSE(PhiR) * CLL - CALL AllocAry( Temp , nR, nR, 'Temp' , ErrStat2 , ErrMsg2); if(Failed()) return - CALL LAPACK_gemm( 'T', 'N', 1.0_FeKi, PhiR, MLL, 0.0_FeKi, PhiR_T_MLL , ErrStat2, ErrMsg2); if(Failed()) return - ! CBB = MATMUL(CRL, PhiR) - CALL LAPACK_gemm( 'N', 'N', 1.0_FeKi, CRL, PhiR, 0.0_FeKi, CBB , ErrStat2, ErrMsg2); if(Failed()) return - ! CBB2 = MATMUL( PhiR_T_CLL, PhiR ) - CALL LAPACK_gemm( 'N', 'N', 1.0_FeKi, PhiR_T_MLL, PhiR, 0.0_FeKi, Temp , ErrStat2, ErrMsg2); if(Failed()) return - CBB = CRR + CBB + TRANSPOSE( CBB ) + Temp - DEALLOCATE(Temp) - ! Cross coupling CMB = PhiM^T*CLR + PhiM^T CLL PhiR - ! CBM = CRL*PhiM + PhiR^T CLL^T PhiM (NOTE: assuming CLL symmetric) - IF ( nM == 0) THEN - CBM = 0.0_FEKi - CMM = 0.0_FEKi - ELSE - CBM = MATMUL( PhiR_T_MLL, PhiL(:,1:nM)) ! last half of operation - CBM = MATMUL( CRL, PhiL(:,1:nM) ) + CBM !This had PhiM - ENDIF - endif - else - PhiR(1:nL,1:nR) = 0.0_FEKi ! Empty - MBM (1:nR,1:nM) = 0.0_FEKi ! Empty - MBB = MRR - KBB = KRR - if (present(CRR)) then - CBB=CRR - CBM=0.0_FEKi - endif - endif - - call CleanUp() -CONTAINS - - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CraigBamptonReduction_FromPartition') - Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() - end function Failed - - subroutine CleanUp() - if (allocated(Mu )) DEALLOCATE(Mu ) - if (allocated(Temp )) DEALLOCATE(Temp ) - if (allocated(PhiR_T_MLL)) DEALLOCATE(PhiR_T_MLL) - end subroutine -END SUBROUTINE CraigBamptonReduction_FromPartition - -!------------------------------------------------------------------------------------------------------ -!> Wrapper function for eigen value analyses, for two cases: -!! Case1: K and M are taken "as is", this is used for the "LL" part of the matrix -!! Case2: K and M contain some constraints lines, and they need to be removed from the Mass/Stiffness matrix. Used for full system -SUBROUTINE EigenSolveWrap(K, M, nDOF, NOmega, bCheckSingularity, EigVect, Omega, ErrStat, ErrMsg, bDOF ) - INTEGER, INTENT(IN ) :: nDOF ! Total degrees of freedom of the incoming system - REAL(FEKi), INTENT(IN ) :: K(nDOF, nDOF) ! stiffness matrix - REAL(FEKi), INTENT(IN ) :: M(nDOF, nDOF) ! mass matrix - INTEGER, INTENT(IN ) :: NOmega ! No. of requested eigenvalues - LOGICAL, INTENT(IN ) :: bCheckSingularity ! If True, the solver will fail if rigid modes are present - REAL(FEKi), INTENT( OUT) :: EigVect(nDOF, NOmega) ! Returned Eigenvectors - REAL(FEKi), INTENT( OUT) :: Omega(NOmega) ! Returned Eigenvalues - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - LOGICAL, OPTIONAL, INTENT(IN ) :: bDOF(nDOF) ! Optinal Mask for DOF to keep (True), or reduce (False) - - ! LOCALS - REAL(LaKi), ALLOCATABLE :: K_LaKi(:,:), M_LaKi(:,:) - REAL(LaKi), ALLOCATABLE :: EigVect_LaKi(:,:), Omega_LaKi(:) - INTEGER(IntKi) :: N - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - ErrStat = ErrID_None - ErrMsg = '' - EigVect=0.0_FeKi - Omega=0.0_FeKi - - ! --- Unfortunate conversion to FEKi... TODO TODO consider storing M and K in FEKi - if (present(bDOF)) then - ! Remove unwanted DOFs - call RemoveDOF(M, bDOF, M_LaKi, ErrStat2, ErrMsg2); if(Failed()) return - call RemoveDOF(K, bDOF, K_LaKi, ErrStat2, ErrMsg2); if(Failed()) return - else - N=size(K,1) - CALL AllocAry(K_LaKi , N, N, 'K_FEKi', ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(M_LaKi , N, N, 'M_FEKi', ErrStat2, ErrMsg2); if(Failed()) return - K_LaKi = real( K, LaKi ) - M_LaKi = real( M, LaKi ) - endif - N=size(K_LaKi,1) - - ! Note: NOmega must be <= N, which is the length of Omega2, Phi! - if ( NOmega > nDOF ) then - CALL SetErrStat(ErrID_Fatal,"NOmega must be less than or equal to N",ErrStat,ErrMsg,'EigenSolveWrap') - CALL CleanupEigen() - return - end if - - ! --- Eigenvalue analysis - CALL AllocAry(EigVect_LAKi, N, N, 'EigVect', ErrStat2, ErrMsg2); if(Failed()) return; - CALL AllocAry(Omega_LaKi, N , 'Omega', ErrStat2, ErrMsg2); if(Failed()) return; ! <<< NOTE: Needed due to dimension of Omega - CALL EigenSolve(K_LaKi, M_LaKi, N, bCheckSingularity, EigVect_LaKi, Omega_LaKi, ErrStat2, ErrMsg2 ); if (Failed()) return; - - Omega(:) = huge(1.0_ReKi) - Omega(1:nOmega) = real(Omega_LaKi(1:nOmega), FEKi) !<<< nOmega= AbortErrLev - if (Failed) call CleanUpEigen() - END FUNCTION Failed - - SUBROUTINE CleanupEigen() - IF (ALLOCATED(Omega_LaKi) ) DEALLOCATE(Omega_LaKi) - IF (ALLOCATED(EigVect_LaKi)) DEALLOCATE(EigVect_LaKi) - IF (ALLOCATED(K_LaKi) ) DEALLOCATE(K_LaKi) - IF (ALLOCATED(M_LaKi) ) DEALLOCATE(M_LaKi) - END SUBROUTINE CleanupEigen - -END SUBROUTINE EigenSolveWrap -!------------------------------------------------------------------------------------------------------ -!> Remove degrees of freedom from a matrix (lines and rows) -SUBROUTINE RemoveDOF(A, bDOF, Ared, ErrStat, ErrMsg ) - REAL(FEKi), INTENT(IN ) :: A(:, :) ! full matrix - logical, INTENT(IN ) :: bDOF(:) ! Array of logical specifying whether a DOF is to be kept(True), or removed (False) - REAL(LaKi),ALLOCATABLE, INTENT( OUT) :: Ared(:,:) ! reduced matrix - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - !locals - INTEGER :: I, J ! counters into full matrix - INTEGER :: Ir, Jr ! counters into reduced matrix - INTEGER :: nr ! number of reduced DOF - ErrStat = ErrID_None - ErrMsg = '' - - nr= count(bDOF) - CALL AllocAry(Ared, nr, nr, 'Ared', ErrStat, ErrMsg ); if (ErrStat >= AbortErrLev) return - - ! Remove rows and columns from A when bDOF is - Jr=0 - do J = 1, size(A,1) - if (bDOF(J)) then - Jr=Jr+1 - Ir=0 - do I = 1, size(A,1) - if (bDOF(I)) then - Ir=Ir+1 - Ared(Ir, Jr) = REAL( A(I, J), FEKi ) - end if - end do - endif - end do -END SUBROUTINE RemoveDOF - -!> Expand a matrix to includes rows where bDOF is False (inverse behavior as RemoveDOF) -SUBROUTINE InsertDOFrows(Ared, bDOF, DefaultVal, A, ErrStat, ErrMsg ) - REAL(LaKi), INTENT(IN ) :: Ared(:, :) ! Reduced matrix - logical, INTENT(IN ) :: bDOF(:) ! Array of logical specifying whether a DOF is to be kept(True), or removed (False) - REAL(FEKi), INTENT(IN ) :: DefaultVal ! Default value to fill the - REAL(FEKi) , INTENT(INOUT) :: A(:,:) ! Full matrix - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - !locals - INTEGER :: I ! counter into full matrix - INTEGER :: Ir ! counter into reduced matrix - INTEGER :: n ! number of DOF (fullsystem) - ErrStat = ErrID_None - ErrMsg = '' - n= size(bDOF) - IF ( size(Ared,1) > n) THEN - ErrStat = ErrID_Fatal - ErrMsg = 'InsertDOFrows: Number of reduced rows needs to be lower than full system rows' - RETURN - END IF - IF ( size(Ared,2) /= size(A,2) ) THEN - ErrStat = ErrID_Fatal - ErrMsg = 'InsertDOFrows: Inconsistent number of columns between A and Ared' - RETURN - END IF - !CALL AllocAry(A, n, size(Ared,2), 'A', ErrStat, ErrMsg ); if (ErrStat >= AbortErrLev) return - - ! Use rows from Ared when bDOF is true, use default value otherwise - ir=0 ! initialize - do i=1,n - if (bDOF(i)) then - ir =ir +1 - A(i,:)=Ared(ir,:) - else - A(i,:)=DefaultVal - endif - enddo -END SUBROUTINE InsertDOFrows -!------------------------------------------------------------------------------------------------------ -!> Returns index of val in Array (val is an integer!) -! NOTE: in the future use intrinsinc function findloc -FUNCTION FINDLOCI_ReKi(Array, Val) result(i) - real(ReKi) , dimension(:), intent(in) :: Array !< Array to search in - integer(IntKi), intent(in) :: val !< Val - integer(IntKi) :: i !< Index of joint in joint table - i = 1 - do while ( i <= size(Array) ) - if ( Val == NINT(Array(i)) ) THEN - return ! Exit when found - else - i = i + 1 - endif - enddo - i=-1 -END FUNCTION -!> Returns index of val in Array (val is an integer!) -! NOTE: in the future use intrinsinc function findloc -FUNCTION FINDLOCI_IntKi(Array, Val) result(i) - integer(IntKi), dimension(:), intent(in) :: Array !< Array to search in - integer(IntKi), intent(in) :: val !< Val - integer(IntKi) :: i !< Index of joint in joint table - i = 1 - do while ( i <= size(Array) ) - if ( Val == Array(i) ) THEN - return ! Exit when found - else - i = i + 1 - endif - enddo - i=-1 -END FUNCTION -!------------------------------------------------------------------------------------------------------ -SUBROUTINE RigidTransformationLine(dx,dy,dz,iLine,Line) - real(ReKi), INTENT(IN) :: dx,dy,dz - integer(IntKi) , INTENT(IN) :: iLine - Real(ReKi), dimension(6), INTENT(OUT) :: Line - SELECT CASE (iLine) - CASE (1); Line = (/1.0_ReKi, 0.0_ReKi, 0.0_ReKi, 0.0_ReKi, dz, -dy/) - CASE (2); Line = (/0.0_ReKi, 1.0_ReKi, 0.0_ReKi, -dz, 0.0_ReKi, dx/) - CASE (3); Line = (/0.0_ReKi, 0.0_ReKi, 1.0_ReKi, dy, -dx, 0.0_ReKi/) - CASE (4); Line = (/0.0_ReKi, 0.0_ReKi, 0.0_ReKi, 1.0_ReKi, 0.0_ReKi, 0.0_ReKi/) - CASE (5); Line = (/0.0_ReKi, 0.0_ReKi, 0.0_ReKi, 0.0_ReKi, 1.0_ReKi, 0.0_ReKi/) - CASE (6); Line = (/0.0_ReKi, 0.0_ReKi, 0.0_ReKi, 0.0_ReKi, 0.0_ReKi, 1.0_ReKi/) - CASE DEFAULT - Line=-99999999_ReKi - print*,'Error in RigidTransformationLine' - STOP -! ErrStat = ErrID_Fatal -! ErrMsg = 'Error calculating transformation matrix TI ' -! return - END SELECT -END SUBROUTINE -!------------------------------------------------------------------------------------------------------ -!> Rigid transformation matrix between DOFs of node j and k where node j is the leader node. -SUBROUTINE GetRigidTransformation(Pj, Pk, TRigid, ErrStat, ErrMsg) - REAL(ReKi), INTENT(IN ) :: Pj(3) ! (x,y,z) positions of leader node - REAL(ReKi), INTENT(IN ) :: Pk(3) ! (x,y,z) positions of follower node - REAL(ReKi), INTENT( OUT) :: TRigid(6,6) ! Transformation matrix such that xk = T.xj - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! Local - !REAL(ReKi) :: L ! length of element - !REAL(ReKi) :: DirCos(3, 3) ! direction cosine matrix - !REAL(ReKi) :: R0(3,3) - integer(IntKi) :: I - ErrStat = ErrID_None - ErrMsg = "" - - ! --- Formulation using Delta of Global coordinates - Trigid=0; do I = 1,6; Trigid(I,I) = 1; enddo - Trigid ( 1, 5 ) = (Pk(3) - Pj(3)) - Trigid ( 1, 6 ) = -(Pk(2) - Pj(2)) - Trigid ( 2, 4 ) = -(Pk(3) - Pj(3)) - Trigid ( 2, 6 ) = (Pk(1) - Pj(1)) - Trigid ( 3, 4 ) = (Pk(2) - Pj(2)) - Trigid ( 3, 5 ) = -(Pk(1) - Pj(1)) - - ! --- Formulation bty transforming the "local" matrix into a global one - !call GetDirCos(Pj, Pk, R0, L, ErrStat, ErrMsg) - !TRigid = 0 ; do I = 1,6; TRigid(I,I) = 1; enddo - !TRigid (1, 5) = L - !TRigid (2, 4) = -L - !TRigid(1:3,4:6) = matmul( R0 , matmul(TRigid(1:3,4:6), transpose(R0)) ) - - ! --- Formulation using L and Rotation matrix - !TRigid = 0; do I = 1,6; TRigid(I,I) = 1; enddo - !TRigid ( 1, 5 ) = L*R0(3,3) - !TRigid ( 1, 6 ) = -L*R0(2,3) - !TRigid ( 2, 4 ) = -L*R0(3,3) - !TRigid ( 2, 6 ) = L*R0(1,3) - !TRigid ( 3, 4 ) = L*R0(2,3) - !TRigid ( 3, 5 ) = -L*R0(1,3) -END SUBROUTINE GetRigidTransformation -!------------------------------------------------------------------------------------------------------ -!> Computes directional cosine matrix DirCos -!! Transforms from element to global coordinates: xg = DC.xe, Kg = DC.Ke.DC^t -!! Assumes that the element main direction is along ze. -!! -!! bjj: note that this is the transpose of what is normally considered the Direction Cosine Matrix -!! in the FAST framework. -SUBROUTINE GetDirCos(P1, P2, DirCos, L_out, ErrStat, ErrMsg) - REAL(ReKi) , INTENT(IN ) :: P1(3), P2(3) ! (x,y,z) global positions of two nodes making up an element - REAL(FEKi) , INTENT( OUT) :: DirCos(3, 3) ! calculated direction cosine matrix - REAL(ReKi) , INTENT( OUT) :: L_out ! length of element - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - REAL(FEKi) :: Dx, Dy, Dz, Dxy,L! distances between nodes - ErrMsg = "" - ErrStat = ErrID_None - - Dx=P2(1)-P1(1) - Dy=P2(2)-P1(2) - Dz=P2(3)-P1(3) - Dxy = sqrt( Dx**2 + Dy**2 ) - L = sqrt( Dx**2 + Dy**2 + Dz**2) - - IF ( EqualRealNos(L, 0.0_FEKi) ) THEN - ErrMsg = ' Same starting and ending location in the element.' - ErrStat = ErrID_Fatal - RETURN - ENDIF - - IF ( EqualRealNos(Dxy, 0.0_FEKi) ) THEN - DirCos=0.0_FEKi ! whole matrix set to 0 - IF ( Dz < 0) THEN !x is kept along global x - DirCos(1, 1) = 1.0_FEKi - DirCos(2, 2) = -1.0_FEKi - DirCos(3, 3) = -1.0_FEKi - ELSE - DirCos(1, 1) = 1.0_ReKi - DirCos(2, 2) = 1.0_ReKi - DirCos(3, 3) = 1.0_ReKi - ENDIF - ELSE - DirCos(1, 1) = Dy/Dxy - DirCos(1, 2) = +Dx*Dz/(L*Dxy) - DirCos(1, 3) = Dx/L - - DirCos(2, 1) = -Dx/Dxy - DirCos(2, 2) = +Dz*Dy/(L*Dxy) - DirCos(2, 3) = Dy/L - - DirCos(3, 1) = 0.0_FEKi - DirCos(3, 2) = -Dxy/L - DirCos(3, 3) = +Dz/L - ENDIF - L_out= real(L, ReKi) - -END SUBROUTINE GetDirCos -!------------------------------------------------------------------------------------------------------ -!> Returns two vectors orthonormal to the input vector -SUBROUTINE GetOrthVectors(e1, e2, e3, ErrStat, ErrMsg) - real(ReKi) , intent(in ) :: e1(3) !< - real(ReKi) , intent( out) :: e2(3) !< - real(ReKi) , intent( out) :: e3(3) !< - integer(IntKi), intent( out) :: ErrStat ! error status of the operation - character(*), intent( out) :: ErrMsg ! error message if errstat /= errid_none - real(ReKi) :: min_norm - real(ReKi) :: e2_norm - real(ReKi) :: e1b(3) - ErrMsg = "" - ErrStat = ErrID_None - - min_norm = min( abs(e1(1)), abs(e1(2)), abs(e1(3)) ) - ! Finding a good candidate for orthogonality - if (min_norm == abs(e1(1))) then; e2 = (/ 0._ReKi, -e1(3), e1(2) /) - else if (min_norm == abs(e1(2))) then; e2 = (/ e1(3) , 0._ReKi, -e1(1) /) - else if (min_norm == abs(e1(3))) then; e2 = (/-e1(2) , e1(1), 0._ReKi /) - endif - ! Normalizing - e2_norm=sqrt(e2(1)**2 + e2(2)**2 + e2(3)**2) - if (abs(e2_norm)<1e-8) then - ErrStat=ErrID_Fatal - ErrMsg='Failed to determine orthogonal vector' - e2=-99999._ReKi - e3=-99999._ReKi - return - endif - e2 = e2/e2_norm - e1b= e1/sqrt(e1(1)**2 + e1(2)**2 + e1(3)**2) - ! Third - e3 = cross_product(e1b,e2) -END SUBROUTINE GetOrthVectors -!------------------------------------------------------------------------------------------------------ -!> Element stiffness matrix for classical beam elements -!! shear is true -- non-tapered Timoshenko beam -!! shear is false -- non-tapered Euler-Bernoulli beam -SUBROUTINE ElemK_Beam(A, L, Ixx, Iyy, Jzz, Shear, kappa, E, G, DirCos, K) - REAL(ReKi), INTENT( IN) :: A, L, Ixx, Iyy, Jzz, E, G, kappa - REAL(FEKi), INTENT( IN) :: DirCos(3,3) !< From element to global: xg = DC.xe, Kg = DC.Ke.DC^t - LOGICAL , INTENT( IN) :: Shear - REAL(FEKi), INTENT(OUT) :: K(12, 12) - ! Local variables - REAL(FEKi) :: Ax, Ay, Kx, Ky - REAL(FEKi) :: DC(12, 12) - - Ax = kappa*A - Ay = kappa*A - - K(1:12,1:12) = 0.0_FEKi - - IF (Shear) THEN - Kx = 12.0_FEKi*E*Iyy / (G*Ax*L*L) - Ky = 12.0_FEKi*E*Ixx / (G*Ay*L*L) - ELSE - Kx = 0.0_FEKi - Ky = 0.0_FEKi - ENDIF - - K( 9, 9) = E*A/L - K( 7, 7) = 12.0_FEKi*E*Iyy/( L*L*L*(1.0_FEKi + Kx) ) - K( 8, 8) = 12.0_FEKi*E*Ixx/( L*L*L*(1.0_FEKi + Ky) ) - K(12, 12) = G*Jzz/L - K(10, 10) = (4.0_FEKi + Ky)*E*Ixx / ( L*(1.0_FEKi+Ky) ) - K(11, 11) = (4.0_FEKi + Kx)*E*Iyy / ( L*(1.0_FEKi+Kx) ) - K( 2, 4) = -6._FEKi*E*Ixx / ( L*L*(1.0_FEKi+Ky) ) - K( 1, 5) = 6._FEKi*E*Iyy / ( L*L*(1.0_FEKi+Kx) ) - K( 4, 10) = (2.0_FEKi-Ky)*E*Ixx / ( L*(1.0_FEKi+Ky) ) - K( 5, 11) = (2.0_FEKi-Kx)*E*Iyy / ( L*(1.0_FEKi+Kx) ) - - K( 3, 3) = K(9,9) - K( 1, 1) = K(7,7) - K( 2, 2) = K(8,8) - K( 6, 6) = K(12,12) - K( 4, 4) = K(10,10) - K(5,5) = K(11,11) - K(4,2) = K(2,4) - K(5,1) = K(1,5) - K(10,4) = K(4,10) - K(11,5) = K(5,11) - K(12,6)= -K(6,6) - K(10,2)= K(4,2) - K(11,1)= K(5,1) - K(9,3) = -K(3,3) - K(7,1) = -K(1,1) - K(8,2) = -K(2,2) - K(6, 12) = -K(6,6) - K(2, 10) = K(4,2) - K(1, 11) = K(5,1) - K(3, 9) = -K(3,3) - K(1, 7) = -K(1,1) - K(2, 8) = -K(2,2) - K(11,7) = -K(5,1) - K(10,8) = -K(4,2) - K(7,11) = -K(5,1) - K(8,10) = -K(4,2) - K(7,5) = -K(5,1) - K(5,7) = -K(5,1) - K(8,4) = -K(4,2) - K(4,8) = -K(4,2) - - DC = 0.0_FEKi - DC( 1: 3, 1: 3) = DirCos - DC( 4: 6, 4: 6) = DirCos - DC( 7: 9, 7: 9) = DirCos - DC(10:12, 10:12) = DirCos - - K = MATMUL( MATMUL(DC, K), TRANSPOSE(DC) ) ! TODO: change me if DirCos convention is transposed - -END SUBROUTINE ElemK_Beam -!------------------------------------------------------------------------------------------------------ -!> Element stiffness matrix for pretension cable -!! Element coordinate system: z along the cable! -SUBROUTINE ElemK_Cable(A, L, E, T0, DirCos, K) - REAL(ReKi), INTENT( IN) :: A, L, E - REAL(ReKi), INTENT( IN) :: T0 ! Pretension [N] - REAL(FEKi), INTENT( IN) :: DirCos(3,3) !< From element to global: xg = DC.xe, Kg = DC.Ke.DC^t - REAL(FEKi), INTENT(OUT) :: K(12, 12) - ! Local variables - REAL(FEKi) :: L0, Eps0, EAL0, EE - REAL(FEKi) :: DC(12, 12) - - Eps0 = T0/(E*A) - L0 = L/(1+Eps0) ! "rest length" for which pretension would be 0 - EAL0 = E*A/L0 - EE = EAL0* Eps0/(1+Eps0) - - K(1:12,1:12)=0.0_FEKi - - ! Note: only translational DOF involved (1-3, 7-9) - K(1,1)= EE - K(2,2)= EE - K(3,3)= EAL0 - - K(1,7)= -EE - K(2,8)= -EE - K(3,9)= -EAL0 - - K(7,1)= -EE - K(8,2)= -EE - K(9,3)= -EAL0 - - K(7,7)= EE - K(8,8)= EE - K(9,9)= EAL0 - - - DC = 0.0_FEKi - DC( 1: 3, 1: 3) = DirCos - DC( 4: 6, 4: 6) = DirCos - DC( 7: 9, 7: 9) = DirCos - DC(10:12, 10:12) = DirCos - - K = MATMUL( MATMUL(DC, K), TRANSPOSE(DC) ) ! TODO: change me if DirCos convention is transposed -END SUBROUTINE ElemK_Cable -!------------------------------------------------------------------------------------------------------ -!> Element mass matrix for classical beam elements -SUBROUTINE ElemM_Beam(A, L, Ixx, Iyy, Jzz, rho, DirCos, M) - REAL(ReKi), INTENT( IN) :: A, L, Ixx, Iyy, Jzz, rho - REAL(FEKi), INTENT( IN) :: DirCos(3,3) !< From element to global: xg = DC.xe, Kg = DC.Ke.DC^t - REAL(FEKi), INTENT(OUT) :: M(12, 12) - - REAL(FEKi) :: t, rx, ry, po - REAL(FEKi) :: DC(12, 12) - - t = rho*A*L; - rx = rho*Ixx; - ry = rho*Iyy; - po = rho*Jzz*L; - - M(1:12,1:12) = 0.0_FEKi - - M( 9, 9) = t/3.0_FEKi - M( 7, 7) = 13.0_FEKi*t/35.0_FEKi + 6.0_FEKi*ry/(5.0_FEKi*L) - M( 8, 8) = 13.0_FEKi*t/35.0_FEKi + 6.0_FEKi*rx/(5.0_FEKi*L) - M(12, 12) = po/3.0_FEKi - M(10, 10) = t*L*L/105.0_FEKi + 2.0_FEKi*L*rx/15.0_FEKi - M(11, 11) = t*L*L/105.0_FEKi + 2.0_FEKi*L*ry/15.0_FEKi - M( 2, 4) = -11.0_FEKi*t*L/210.0_FEKi - rx/10.0_FEKi - M( 1, 5) = 11.0_FEKi*t*L/210.0_FEKi + ry/10.0_FEKi - M( 3, 9) = t/6.0_FEKi - M( 5, 7) = 13._FEKi*t*L/420._FEKi - ry/10._FEKi - M( 4, 8) = -13._FEKi*t*L/420._FEKi + rx/10._FEKi - M( 6, 12) = po/6._FEKi - M( 2, 10) = 13._FEKi*t*L/420._FEKi - rx/10._FEKi - M( 1, 11) = -13._FEKi*t*L/420._FEKi + ry/10._FEKi - M( 8, 10) = 11._FEKi*t*L/210._FEKi + rx/10._FEKi - M( 7, 11) = -11._FEKi*t*L/210._FEKi - ry/10._FEKi - M( 1, 7) = 9._FEKi*t/70._FEKi - 6._FEKi*ry/(5._FEKi*L) - M( 2, 8) = 9._FEKi*t/70._FEKi - 6._FEKi*rx/(5._FEKi*L) - M( 4, 10) = -L*L*t/140._FEKi - rx*L/30._FEKi - M( 5, 11) = -L*L*t/140._FEKi - ry*L/30._FEKi - - M( 3, 3) = M( 9, 9) - M( 1, 1) = M( 7, 7) - M( 2, 2) = M( 8, 8) - M( 6, 6) = M(12, 12) - M( 4, 4) = M(10, 10) - M( 5, 5) = M(11, 11) - M( 4, 2) = M( 2, 4) - M( 5, 1) = M( 1, 5) - M( 9, 3) = M( 3, 9) - M( 7, 5) = M( 5, 7) - M( 8, 4) = M( 4, 8) - M(12, 6) = M( 6, 12) - M(10, 2) = M( 2, 10) - M(11, 1) = M( 1, 11) - M(10, 8) = M( 8, 10) - M(11, 7) = M( 7, 11) - M( 7, 1) = M( 1, 7) - M( 8, 2) = M( 2, 8) - M(10, 4) = M( 4, 10) - M(11, 5) = M( 5, 11) - - DC = 0.0_FEKi - DC( 1: 3, 1: 3) = DirCos - DC( 4: 6, 4: 6) = DirCos - DC( 7: 9, 7: 9) = DirCos - DC(10:12, 10:12) = DirCos - - M = MATMUL( MATMUL(DC, M), TRANSPOSE(DC) ) ! TODO change me if direction cosine is transposed - -END SUBROUTINE ElemM_Beam -!------------------------------------------------------------------------------------------------------ -!> Element stiffness matrix for pretension cable -SUBROUTINE ElemM_Cable(A, L, rho, DirCos, M) - REAL(ReKi), INTENT( IN) :: A,rho - REAL(FEKi), INTENT( IN) :: L - REAL(FEKi), INTENT( IN) :: DirCos(3,3) !< From element to global: xg = DC.xe, Kg = DC.Ke.DC^t - REAL(FEKi), INTENT(OUT) :: M(12, 12) - ! Local variables - REAL(FEKi) :: DC(12, 12) - REAL(FEKi) :: t - - t = rho*A*L; - - M(1:12,1:12) = 0.0_FEKi - - M( 1, 1) = 13._FEKi/35._FEKi * t - M( 2, 2) = 13._FEKi/35._FEKi * t - M( 3, 3) = t/3.0_FEKi - - M( 7, 7) = 13._FEKi/35._FEKi * t - M( 8, 8) = 13._FEKi/35._FEKi * t - M( 9, 9) = t/3.0_FEKi - - M( 1, 7) = 9._FEKi/70._FEKi * t - M( 2, 8) = 9._FEKi/70._FEKi * t - M( 3, 9) = t/6.0_FEKi - - M( 7, 1) = 9._FEKi/70._FEKi * t - M( 8, 2) = 9._FEKi/70._FEKi * t - M( 9, 3) = t/6.0_FEKi - - DC = 0.0_FEKi - DC( 1: 3, 1: 3) = DirCos - DC( 4: 6, 4: 6) = DirCos - DC( 7: 9, 7: 9) = DirCos - DC(10:12, 10:12) = DirCos - - M = MATMUL( MATMUL(DC, M), TRANSPOSE(DC) ) ! TODO: change me if DirCos convention is transposed -END SUBROUTINE ElemM_Cable -!------------------------------------------------------------------------------------------------------ -!> calculates the lumped forces and moments due to gravity on a given element: -!! the element has two nodes, with the loads for both elements stored in array F. Indexing of F is: -!! Fx_n1=1,Fy_n1=2,Fz_n1=3,Mx_n1= 4,My_n1= 5,Mz_n1= 6, -!! Fx_n2=7,Fy_n2=8,Fz_n2=9,Mx_n2=10,My_n2=11,Mz_n2=12 -SUBROUTINE ElemG(A, L, rho, DirCos, F, g) - REAL(ReKi), INTENT( IN ) :: A !< area - REAL(ReKi), INTENT( IN ) :: L !< element length - REAL(ReKi), INTENT( IN ) :: rho !< density - REAL(FEKi), INTENT( IN) :: DirCos(3,3) !< From element to global: xg = DC.xe, Kg = DC.Ke.DC^t - REAL(ReKi), INTENT( IN ) :: g !< gravity - REAL(FEKi), INTENT( OUT) :: F(12) !< returned loads. positions 1-6 are the loads for node 1 ; 7-12 are loads for node 2. - REAL(FEKi) :: TempCoeff - REAL(FEKi) :: w ! weight per unit length - - F = 0.0_FEKi ! initialize whole array to zero, then set the non-zero portions - w = rho*A*g ! weight per unit length - - ! lumped forces on both nodes (z component only): - F(3) = -0.5_FEKi*L*w - F(9) = F(3) - - ! lumped moments on node 1 (x and y components only): - ! bjj: note that RRD wants factor of 1/12 because of boundary conditions. Our MeshMapping routines use factor of 1/6 (assuming generic/different boundary - ! conditions), so we may have some inconsistent behavior. JMJ suggests using line2 elements for SubDyn's input/output meshes to improve the situation. - TempCoeff = L*L*w/12.0_FEKi ! let's not calculate this twice - F(4) = -TempCoeff * DirCos(2,3) ! = -L*w*Dy/12._FEKi !bjj: DirCos(2,3) = Dy/L - F(5) = TempCoeff * DirCos(1,3) ! = L*w*Dx/12._FEKi !bjj: DirCos(1,3) = Dx/L - - ! lumped moments on node 2: (note the opposite sign of node 1 moment) - F(10) = -F(4) - F(11) = -F(5) - !F(12) is 0 for g along z alone - -END SUBROUTINE ElemG -!------------------------------------------------------------------------------------------------------ -!> -SUBROUTINE ElemF_Cable(T0, DirCos, F) - REAL(ReKi), INTENT( IN ) :: T0 !< Pretension load [N] - REAL(FEKi), INTENT( IN) :: DirCos(3,3) !< From element to global: xg = DC.xe, Kg = DC.Ke.DC^t - REAL(FEKi), INTENT( OUT) :: F(12) !< returned loads. 1-6 for node 1; 7-12 for node 2. - ! Local variables - REAL(FEKi) :: DC(12, 12) - - F(1:12) = 0.0_FEKi ! init - F(3) = +T0 - F(9) = -T0 - - DC = 0.0_FEKi - DC( 1: 3, 1: 3) = DirCos - DC( 4: 6, 4: 6) = DirCos - DC( 7: 9, 7: 9) = DirCos - DC(10:12, 10:12) = DirCos - - F = MATMUL(DC, F)! TODO: change me if DirCos convention is transposed - -END SUBROUTINE ElemF_Cable -!------------------------------------------------------------------------------------------------------ -!> Calculates the lumped gravity forces at the nodes given the element geometry -!! It assumes a linear variation of the dimensions from node 1 to node 2, thus the area may be quadratically varying if crat<>1 -!! bjj: note this routine is a work in progress, intended for future version of SubDyn. Compare with ElemG. -SUBROUTINE LumpForces(Area1,Area2,crat,L,rho, g, DirCos, F) - REAL(ReKi), INTENT( IN ) :: Area1,Area2,crat !< X-sectional areas at node 1 and node 2, t2/t1 thickness ratio - REAL(ReKi), INTENT( IN ) :: g !< gravity - REAL(ReKi), INTENT( IN ) :: L !< Length of element - REAL(ReKi), INTENT( IN ) :: rho !< density - REAL(ReKi), INTENT( IN) :: DirCos(3,3) !< From element to global: xg = DC.xe, Kg = DC.Ke.DC^t - REAL(ReKi), INTENT( OUT) :: F(12) !< Lumped forces - !LOCALS - REAL(ReKi) :: TempCoeff,a0,a1,a2 !coefficients of the gravity quadratically distributed force - - !Calculate quadratic polynomial coefficients - a0 = a1 - print*,'Error: the function lumpforces is not ready to use' - STOP - - !Calculate quadratic polynomial coefficients - a0 = -99999 ! TODO: this is wrong - a2 = ( (Area1+A2) - (Area1*crat+Area2/crat) )/L**2. ! *x**2 - a1 = (Area2-Area1)/L -a2*L ! *x - - !Now calculate the Lumped Forces - F = 0 - F(3) = -(a0*L/2. +a1*L**2/6. +a2*L**3/12. )*rho*g !Forces along z (must be negative on earth) - F(9) = -(a0*L/2. +a1*L**2/3. +a2*L**3/4. )*rho*g !Forces along z (must be negative on earth) - - !Now calculate the Lumped Moments - !HERE TO BE COMPLETED FOR THE BELOW - TempCoeff = 1.0/12.0*g*L*L*rho*Area2 !RRD : I am changing this to >0 sign 6/10/13 - - !F(4) = TempCoeff*( DirCos(1, 3)*DirCos(2, 1) - DirCos(1, 1)*DirCos(2, 3) ) !These do not work if convnetion on z2>z1, x2>x1, y2>y1 are not followed as I have discovered 7/23 - !F(5) = TempCoeff*( DirCos(1, 3)*DirCos(2, 2) - DirCos(1, 2)*DirCos(2, 3) ) - - !RRD attempt at new dircos which keeps x in the X-Y plane - F(4) = -TempCoeff * SQRT(1-DirCos(3,3)**2) * DirCos(1,1) !bjj: compare with ElemG() and verify this lumping is consistent - F(5) = -TempCoeff * SQRT(1-DirCos(3,3)**2) * DirCos(2,1) !bjj: compare with ElemG() and verify this lumping is consistent - !RRD ends - F(10) = -F(4) - F(11) = -F(5) - !F(12) is 0 for g along z alone -END SUBROUTINE LumpForces - -!------------------------------------------------------------------------------------------------------ -!> -!! Method 1: pinv_A = A \ eye(m) (matlab) -!! call _GELSS to solve A.X=B -!! pinv(A) = B(1:n,1:m) -!! Method 2: [U,S,V] = svd(A); pinv_A = ( V / S ) * U'; (matlab) -! perform lapack GESVD and then pinv(A) = V*(inv(S))*U' -SUBROUTINE PseudoInverse(A, Ainv, ErrStat, ErrMsg) - use NWTC_LAPACK, only: LAPACK_GESVD, LAPACK_GEMM - real(FEKi), dimension(:,:), intent(in) :: A - real(FEKi), dimension(:,:), allocatable :: Ainv - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! < Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! < Error message if ErrStat / = ErrID_None - ! - real(FEKi), dimension(:), allocatable :: S - real(FEKi), dimension(:,:), allocatable :: U - real(FEKi), dimension(:,:), allocatable :: Vt - real(FEKi), dimension(:), allocatable :: WORK - real(FEKi), dimension(:,:), allocatable :: Acopy - integer :: j ! Loop indices - integer :: M !< The number of rows of the input matrix A - integer :: N !< The number of columns of the input matrix A - integer :: K !< - integer :: L !< - integer :: LWORK !< - M = size(A,1) - N = size(A,2) - K = min(M,N) - L = max(M,N) - LWORK = MAX(1,3*K +L,5*K) - allocate(S(K)); S = 0; - !! LWORK >= MAX(1,3*MIN(M,N) + MAX(M,N),5*MIN(M,N)) for the other paths - allocate(Work(LWORK)); Work=0 - allocate(U (M,K) ); U=0; - allocate(Vt(K,N) ); Vt=0; - allocate(Ainv(N,M)); Ainv=0; - allocate(Acopy(M,N)); Acopy=A; - - ! --- Compute the SVD of A - ! [U,S,V] = svd(A) - !call DGESVD ('S', 'S', M, N, A, M, S, U, M , Vt , K, WORK, LWORK, INFO) - call LAPACK_GESVD('S', 'S', M, N, Acopy, S, U, Vt, WORK, LWORK, ErrStat, ErrMsg) - - !--- Compute PINV = V**T * SIGMA * U**T in two steps - ! SIGMA = S^(-1)=1/S(j), S is diagonal - do j = 1, K - U(:,j) = U(:,j)/S(j) - end do - ! Compute Ainv = 1.0*V^t * U^t + 0.0*Ainv V*(inv(S))*U' - !call DGEMM( 'T', 'T', N, M, K, 1.0, V, K, U, M, 0.0, Ainv, N) - print*,'8' - call LAPACK_GEMM( 'T', 'T', 1.0_FEKi, Vt, U, 0.0_FEKi, Ainv, ErrStat, ErrMsg) - ! --- Compute rank - !tol=maxval(shape(A))*epsilon(maxval(S)) - !rank=0 - !do i=1,K - ! if(S(i) .gt. tol)then - ! rank=rank+1 - ! end if - !end do - !print*,'Rank',rank - ! Ainv=transpose(matmul(matmul(U(:,1:r),S_inv(1:r,1:r)),Vt(1:r,:))) - END SUBROUTINE PseudoInverse - -END MODULE FEM diff --git a/OpenFAST/modules/subdyn/src/IntegerList.f90 b/OpenFAST/modules/subdyn/src/IntegerList.f90 deleted file mode 100644 index a5f74112c..000000000 --- a/OpenFAST/modules/subdyn/src/IntegerList.f90 +++ /dev/null @@ -1,458 +0,0 @@ -!> Module providing suport for an integer list stored as an array and not a chained list -!! Used since registry does not support pointer with recursive types. -module IntegerList - use SubDyn_Types, only: IList - use NWTC_Library, only: IntKi, ReKi, AllocAry, ErrID_None, ErrID_Fatal, num2lstr - - implicit none - - public :: IList - - public :: init_list - public :: destroy_list - public :: len - public :: append - public :: pop - public :: get - public :: find - public :: sort - public :: reverse - interface pop - module procedure pop_last - module procedure pop_item - end interface - interface init_list - module procedure init_list_n_def - module procedure init_list_vect - end interface - interface find - module procedure find_list - module procedure find_intarray - end interface - interface unique - module procedure unique_list - module procedure unique_intarray - module procedure unique_intarray_in_place - end interface -contains - - !> Concatenate lists: I3=[I1,I2] - subroutine concatenate_lists(I1,I2,I3, ErrStat, ErrMsg) - integer(intki), intent(in) :: i1(:), i2(:) - integer(intki), intent(out) :: i3(:) - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat / = ErrID_None - ErrStat=ErrID_None - ErrMsg='' - I3(1:size(I1)) = I1 - I3(size(I1)+1:size(I1)+size(I2)) = I2 - endsubroutine - subroutine concatenate_3lists(I1,I2,I3,I4, ErrStat, ErrMsg) - integer(intki), intent(in) :: i1(:), i2(:), i3(:) - integer(intki), intent(out) :: i4(:) - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat / = ErrID_None - ErrStat=ErrID_None - ErrMsg='' - I4( 1:size(I1) ) = I1 - I4(size(I1) +1:size(I1)+size(I2) ) = I2 - I4(size(I1)+size(I2)+1:size(I1)+size(I2)+size(I3)) = I3 - endsubroutine - - !> Set difference: I3=I1-I2 (assumes I1 is biggger than I2), elements of I1 not in I2 - subroutine lists_difference(I1, I2, I3, ErrStat, ErrMsg) - integer(IntKi), intent(in) :: I1(:), I2(:) - integer(IntKi), intent(out) :: I3(:) - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - integer(IntKi) :: I - logical, dimension(:), allocatable :: bUnique - ErrStat = ErrID_None - ErrMsg = "" - allocate(bUnique(1:size(I1))) - ! Then, remove DOFs on the boundaries: - DO i = 1, size(I1) !Boundary DOFs (Interface + Constraints) - if (find(I2,I1(i))>0) then - bUnique(I) = .false. - else - bUnique(I) = .true. - endif - ENDDO - if (count(bUnique) /= size(I3)) then - ErrStat=ErrID_Fatal; ErrMsg='Storage for list difference is of wrong size'; return - endif - I3 = pack(I1, bUnique) - deallocate(bUnique) - endsubroutine - - !> Initialize an integer list - subroutine init_list_n_def(L,n,default_val,ErrStat,ErrMsg) - type(IList), intent(inout) :: L !< List - integer(IntKi), intent(in) :: n !< number of initial values - integer(IntKi), intent(in) :: default_val !< default values - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - ErrStat = ErrID_None - ErrMsg = "" - call AllocAry(L%List, n, 'L%List', ErrStat, ErrMsg) - if (ErrStat/=ErrID_None) return - L%List(1:n) = default_val - end subroutine init_list_n_def - - subroutine init_list_vect(L,vect,ErrStat,ErrMsg) - type(IList), intent(inout) :: L !< List - integer(IntKi), dimension(:), intent(in) :: vect !< number of initial values - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - ErrStat = ErrID_None - ErrMsg = "" - call AllocAry(L%List, size(vect), 'L%List', ErrStat, ErrMsg) - if (ErrStat/=ErrID_None) return - L%List = vect - end subroutine init_list_vect - - !> Deallocate list - subroutine destroy_list(L,ErrStat,ErrMsg) - type(IList), intent(inout) :: L !< List - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - ErrStat = ErrID_None - ErrMsg = "" - if (allocated(L%List)) deallocate(L%List) - end subroutine destroy_list - - !> Returns list length - integer function len(L) - type(IList), intent(in) :: L - if (allocated(L%List)) then - len=size(L%List) - else - len=0 - endif - end function len - - !> Append element to list - subroutine append(L,e, ErrStat, ErrMsg) - type(IList), intent(inout) :: L - integer(IntKi), intent(in) :: e - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat / = ErrID_None - ErrStat = ErrID_None - ErrMsg = "" - if (allocated(L%List)) then - call resize_array(L%List,len(L)+1,e) - else - call init_list(L, 1, e, ErrStat, ErrMsg) - endif - end subroutine append - - !> Get element i from list - integer function get(L,i, ErrStat, ErrMsg) - type(IList), intent(inout) :: L - integer(IntKi), intent(in) :: i - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat / = ErrID_None - if ((i<=0).or.(i>len(L))) then - ErrStat=ErrID_Fatal - ErrMsg="Index out of bound "//trim(num2lstr(i))//", list length is "//trim(num2lstr(len(L))) - get=-9999 - else - ErrStat = ErrID_None - ErrMsg = "" - get = L%List(i) ! No error handling, throws "index array out of bound", like a regular array - endif - end function get - - !> Pop last element of the list and reduce list size by 1 - integer function pop_last(L,ErrStat,ErrMsg) - type(IList), intent(inout) :: L - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat / = ErrID_None - integer(IntKi) :: n - ErrStat = ErrID_None - ErrMsg = "" - n=len(L) - pop_last = get(L, n, ErrStat, ErrMsg) ! index array out of bound will be thrown - call resize_array(L%List,n-1,0) - end function pop_last - - !> Pop element i from the list and reduce the size of the list by 1 - integer function pop_item(L,i,ErrStat,ErrMsg) - type(IList), intent(inout) :: L - integer(IntKi), intent(in) :: i - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat / = ErrID_None - integer(IntKi) :: n - ErrStat = ErrID_None - ErrMsg = "" - n=len(L) - pop_item = get(L, i, ErrStat, ErrMsg) ! index array out of bound will be thrown - L%List(i:n-1)=L%List(i+1:n) - call resize_array(L%List,n-1,0) - end function pop_item - - !> Sort list - subroutine sort(L, ErrStat, ErrMsg) - type(IList), intent(inout) :: L - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat / = ErrID_None - ErrStat = ErrID_None - ErrMsg = "" - if (allocated(L%List)) then - call sort_in_place(L%List) - else - ErrStat=ErrID_Fatal - ErrMsg="Cannot sort a list not allocated" - endif - end subroutine sort - - !> Reverse list - subroutine reverse(L, ErrStat, ErrMsg) - type(IList), intent(inout) :: L - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat / = ErrID_None - integer(IntKi) :: i - integer(IntKi) :: n - ErrStat = ErrID_None - ErrMsg = "" - n=len(L) - do i =1,int(n/2) - call swap(i, n-i+1) - enddo - contains - subroutine swap(i,j) - integer(IntKi), intent(in) :: i,j - integer(IntKi) :: tmp - tmp=L%List(i) - L%List(i) = L%List(j) - L%List(j) = tmp - end subroutine - end subroutine reverse - - - !> Returns index of element e in L, returns 0 if not found - !! NOTE: list but be sorted to call this function - integer(IntKi) function find_list(L, e, ErrStat, ErrMsg) - type(IList), intent(inout) :: L - integer(IntKi), intent(in ) :: e - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat / = ErrID_None - ErrStat = ErrID_None - ErrMsg = "" - if (len(L)>0) then - find_list = binary_search(L%List, e) ! Binary search returns index for inequality List(i)<=e - if (find_list>0) then - if (L%List(find_list)/=e) then - find_list=-1 - endif - endif - else - find_list=-1 - endif - end function find_list - - !> Unique, in place - subroutine unique_list(L, ErrStat, ErrMsg) - type(IList), intent(inout) :: L - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat / = ErrID_None - ErrStat = ErrID_None - ErrMsg = "" - if (len(L)>0) then - call unique_intarray_in_place(L%List) - endif - end subroutine - - !> Print - subroutine print_list(L, varname, u_opt) - type(IList), intent(in) :: L - character(len=*),intent(in) :: varname - integer(IntKi), intent(in),optional :: u_opt - ! - character(len=*),parameter :: IFMT='I7.0' !< - integer(IntKi) :: u - integer(IntKi) :: n - character(len=20) :: fmt - ! Optional args - if (present(u_opt)) then - u=u_opt - else - u=6 - endif - n=len(L) - if (n>0) then - write(fmt,*) n - write(u,"(A,A,"// adjustl(fmt)//IFMT//",A)") varname,"=[",L%List,"];" - else - write(u,'(A,A)') varname,'=[];' - endif - end subroutine print_list - - ! -------------------------------------------------------------------------------- - ! --- Generic helper functions (should be part of NWTC library) - ! -------------------------------------------------------------------------------- - !> Sort integer array in place - pure subroutine sort_in_place(a) - integer(IntKi), intent(inout), dimension(:) :: a - integer(IntKi) :: temp - integer(IntKi) :: i, j - do i = 2, size(a) - j = i - 1 - temp = a(i) - do while (j>=1 .and. a(j)>temp) - a(j+1) = a(j) - j = j - 1 - if (j<1) then - exit - endif - end do - a(j+1) = temp - end do - end subroutine sort_in_place - - !> Performs binary search and return the largest index such that x(i) <= x0 - !! allows equlity - Integer(IntKi) function binary_search(x, x0) result(i_inf) - ! Arguments declarations - integer(IntKi), dimension(:),intent(in) :: x !< x *sorted* vector - integer(IntKi), intent(in) :: x0 !< - ! Variable declarations - integer(IntKi) :: i_sup !< - integer(IntKi) :: mid !< - i_inf=1 - i_sup=size(x) - ! Safety test - if (x0=x(i_sup)) then - i_inf=i_sup - return - end if - ! We loop until we narrow down to one index - do while (i_inf+1 Returns index of val in Array (val is an integer!) - ! NOTE: in the future use intrinsinc function findloc - function find_intarray(Array, Val) result(i) - integer(IntKi), dimension(:), intent(in) :: Array !< Array to search in - integer(IntKi), intent(in) :: val !< Val - integer(IntKi) :: i !< Index of joint in joint table - i = 1 - do while ( i <= size(Array) ) - if ( Val == Array(i) ) THEN - return ! Exit when found - else - i = i + 1 - endif - enddo - i=-1 - end function - - !> return in res the unique values of v - subroutine unique_intarray(v,res) - ! Arguments - integer(IntKi),dimension(:),intent(in) :: v - integer(IntKi),dimension(:),allocatable::res - ! - integer(IntKi),dimension(:),pointer::tmp - integer :: k !< number of unique elements - integer :: i, j - if (allocated(res)) deallocate(res) - allocate(tmp(1:size(v))) - k = 1 - tmp(1) = v(1) - outer: do i=2,size(v) - do j=1,k - if (tmp(j) == v(i)) then - ! Found a match so start looking again - cycle outer - end if - end do - ! No match found so add it to the output - k = k + 1 - tmp(k) = v(i) - end do outer - allocate(res(1:k)) - res(1:k)=tmp(1:k) - deallocate(tmp) - end subroutine - - subroutine unique_intarray_in_place(v) - integer(IntKi),dimension(:),allocatable :: v - integer(IntKi),dimension(:),allocatable::res - integer :: k !< number of unique elements - integer :: i, j - allocate(res(1:size(v))) - k = 1 - res(1) = v(1) - outer: do i=2,size(v) - do j=1,k - if (res(j) == v(i)) then - ! Found a match so start looking again - cycle outer - end if - end do - ! No match found so add it to the output - k = k + 1 - res(k) = v(i) - end do outer - deallocate(v) - allocate(v(1:k)) - v(1:k)=res(1:k) - deallocate(res) - end subroutine - - !> Resize integer array of dimension 1 - subroutine resize_array(array,nNewSize,default_val) - integer(IntKi),dimension(:),allocatable,intent(inout) :: array - integer(IntKi) , intent(in) :: nNewSize - integer(IntKi), intent(in) :: default_val - ! Local variables - integer(IntKi),dimension(:),allocatable :: tmp !< backup of input - integer(IntKi) :: nDimTmp - integer(IntKi) :: AllocateStatus - ! To save memory, if nNewSize is below second dim, we take the min - nDimTmp= min(size(array,1),nNewSize) - ! Making of copy of the input - allocate(tmp(1:nDimTmp), STAT = AllocateStatus) - if (AllocateStatus /= 0) STOP "*** Not enough memory ***" - tmp(1:nDimTmp)=array(1:nDimTmp) - ! Reallocating the array - deallocate(array) - allocate(array(1:nNewSize), STAT = AllocateStatus) - if (AllocateStatus /= 0) STOP "*** Not enough memory ***" - ! We copy the original data into it - array(1:nDimTmp)=tmp(1:nDimTmp) - if(nDimTmp+1<=nNewSize) array(nDimTmp+1:nNewSize)=default_val - end subroutine - - !> Append two integer arrays of dimension 1 - subroutine append_arrays(array1,n1,array2,n2) - integer(IntKi), dimension(:), allocatable :: array1 - integer(IntKi), dimension(:) :: array2 - integer(IntKi), intent(inout) :: n1 !< SIDE EFFECTS - integer(IntKi), intent(in) :: n2 - ! Local variables - integer :: nNew - nNew=n1+n2 - ! --- Making enough space if needed - if(nNew>size(array1,1)) then - call resize_array(array1,nNew,0) - endif - ! --- Appending - array1((n1+1):(n1+n2))=array2(1:n2) - ! updating n1 - n1=n1+n2; - end subroutine - -end module IntegerList diff --git a/OpenFAST/modules/subdyn/src/SD_FEM.f90 b/OpenFAST/modules/subdyn/src/SD_FEM.f90 deleted file mode 100644 index c705e6aea..000000000 --- a/OpenFAST/modules/subdyn/src/SD_FEM.f90 +++ /dev/null @@ -1,2112 +0,0 @@ -!.................................................................................................................................. -! LICENSING -! Copyright (C) 2013-2016 National Renewable Energy Laboratory -! -! This file is part of SubDyn. -! -! 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. -!********************************************************************************************************************************** -MODULE SD_FEM - USE NWTC_Library - USE SubDyn_Types - USE FEM - IMPLICIT NONE - - - INTEGER(IntKi), PARAMETER :: MaxMemJnt = 10 ! Maximum number of members at one joint - INTEGER(IntKi), PARAMETER :: MaxOutChs = 2000 ! Max number of Output Channels to be read in - INTEGER(IntKi), PARAMETER :: nDOFL_TP = 6 !TODO rename me ! 6 degrees of freedom (length of u subarray [UTP]) - - ! values of these parameters are ordered by their place in SubDyn input file: - INTEGER(IntKi), PARAMETER :: JointsCol = 9 ! Number of columns in Joints (JointID, JointXss, JointYss, JointZss, JointType, JointDirX JointDirY JointDirZ JointStiff) - INTEGER(IntKi), PARAMETER :: InterfCol = 7 ! Number of columns in interf matrix (JointID,ItfTDxss,ItfTDYss,ItfTDZss,ItfRDXss,ItfRDYss,ItfRDZss) - INTEGER(IntKi), PARAMETER :: ReactCol = 7 ! Number of columns in reaction matrix (JointID,ItfTDxss,ItfTDYss,ItfTDZss,ItfRDXss,ItfRDYss,ItfRDZss) - INTEGER(IntKi), PARAMETER :: MaxNodesPerElem = 2 ! Maximum number of nodes per element (currently 2) - INTEGER(IntKi), PARAMETER :: MembersCol = MaxNodesPerElem + 3+1 ! Number of columns in Members (MemberID,MJointID1,MJointID2,MPropSetID1,MPropSetID2,COSMID) - INTEGER(IntKi), PARAMETER :: PropSetsBCol = 6 ! Number of columns in PropSets (PropSetID,YoungE,ShearG,MatDens,XsecD,XsecT) !bjj: this really doesn't need to store k, does it? or is this supposed to be an ID, in which case we shouldn't be storing k (except new property sets), we should be storing IDs - INTEGER(IntKi), PARAMETER :: PropSetsXCol = 10 ! Number of columns in XPropSets (PropSetID,YoungE,ShearG,MatDens,XsecA,XsecAsx,XsecAsy,XsecJxx,XsecJyy,XsecJ0) - INTEGER(IntKi), PARAMETER :: PropSetsCCol = 5 ! Number of columns in CablePropSet (PropSetID, EA, MatDens, T0) - INTEGER(IntKi), PARAMETER :: PropSetsRCol = 2 ! Number of columns in RigidPropSet (PropSetID, MatDens) - INTEGER(IntKi), PARAMETER :: COSMsCol = 10 ! Number of columns in (cosine matrices) COSMs (COSMID,COSM11,COSM12,COSM13,COSM21,COSM22,COSM23,COSM31,COSM32,COSM33) - INTEGER(IntKi), PARAMETER :: CMassCol = 11 ! Number of columns in Concentrated Mass (CMJointID,JMass,JMXX,JMYY,JMZZ, Optional:JMXY,JMXZ,JMYZ,CGX,CGY,CGZ) - ! Indices in Members table - INTEGER(IntKi), PARAMETER :: iMType= 6 ! Index in Members table where the type is stored - INTEGER(IntKi), PARAMETER :: iMProp= 4 ! Index in Members table where the PropSet1 and 2 are stored - - ! Indices in Joints table - INTEGER(IntKi), PARAMETER :: iJointType= 5 ! Index in Joints where the joint type is stored - INTEGER(IntKi), PARAMETER :: iJointDir= 6 ! Index in Joints where the joint-direction are stored - INTEGER(IntKi), PARAMETER :: iJointStiff= 9 ! Index in Joints where the joint-stiffness is stored - - ! ID for joint types - INTEGER(IntKi), PARAMETER :: idJointCantilever = 1 - INTEGER(IntKi), PARAMETER :: idJointUniversal = 2 - INTEGER(IntKi), PARAMETER :: idJointPin = 3 - INTEGER(IntKi), PARAMETER :: idJointBall = 4 - - ! ID for member types - INTEGER(IntKi), PARAMETER :: idMemberBeam = 1 - INTEGER(IntKi), PARAMETER :: idMemberCable = 2 - INTEGER(IntKi), PARAMETER :: idMemberRigid = 3 - - ! Types of Boundary Conditions - INTEGER(IntKi), PARAMETER :: idBC_Fixed = 11 ! Fixed BC - INTEGER(IntKi), PARAMETER :: idBC_Internal = 12 ! Free BC - INTEGER(IntKi), PARAMETER :: idBC_Leader = 13 ! TODO, and maybe "BC" not appropriate here - - ! Types of Static Improvement Methods - INTEGER(IntKi), PARAMETER :: idSIM_None = 0 - INTEGER(IntKi), PARAMETER :: idSIM_Full = 1 - INTEGER(IntKi) :: idSIM_Valid(2) = (/idSIM_None, idSIM_Full/) - - ! Types of Guyan Damping - INTEGER(IntKi), PARAMETER :: idGuyanDamp_None = 0 - INTEGER(IntKi), PARAMETER :: idGuyanDamp_Rayleigh = 1 - INTEGER(IntKi), PARAMETER :: idGuyanDamp_66 = 2 - INTEGER(IntKi) :: idGuyanDamp_Valid(3) = (/idGuyanDamp_None, idGuyanDamp_Rayleigh, idGuyanDamp_66 /) - - INTEGER(IntKi), PARAMETER :: SDMaxInpCols = MAX(JointsCol,InterfCol,MembersCol,PropSetsBCol,PropSetsXCol,COSMsCol,CMassCol) - - ! Implementation Flags - LOGICAL, PARAMETER :: DEV_VERSION = .false. - LOGICAL, PARAMETER :: BC_Before_CB = .true. - LOGICAL, PARAMETER :: ANALYTICAL_LIN = .true. - LOGICAL, PARAMETER :: GUYAN_RIGID_FLOATING = .true. - - INTERFACE FINDLOCI ! In the future, use FINDLOC from intrinsic - MODULE PROCEDURE FINDLOCI_ReKi - MODULE PROCEDURE FINDLOCI_IntKi - END INTERFACE - - -CONTAINS -!------------------------------------------------------------------------------------------------------ -! --- Helper functions -!------------------------------------------------------------------------------------------------------ -!> Maps nodes to elements -!! allocate NodesConnE and NodesConnN -SUBROUTINE NodeCon(Init,p, ErrStat, ErrMsg) - TYPE(SD_InitType), INTENT( INOUT ) :: Init - TYPE(SD_ParameterType), INTENT( IN ) :: p - INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! Local variables - INTEGER(IntKi) :: I,J,K !counter - - ! The row index is the number of the real node, i.e. ID, 1st col has number of elements attached to node, and 2nd col has element numbers (up to 10) - CALL AllocAry(Init%NodesConnE, p%nNodes, MaxMemJnt+1,'NodesConnE', ErrStat, ErrMsg); if (ErrStat/=0) return; - CALL AllocAry(Init%NodesConnN, p%nNodes, MaxMemJnt+2,'NodesConnN', ErrStat, ErrMsg); if (ErrStat/=0) return; - Init%NodesConnE = 0 - Init%NodesConnN = -99999 ! Not Used - - ! find the node connectivity, nodes/elements that connect to a common node - DO I = 1, p%nNodes - !Init%NodesConnN(I, 1) = NINT( Init%Nodes(I, 1) ) !This should not be needed, could remove the extra 1st column like for the other array - k = 0 - DO J = 1, Init%NElem !This should be vectorized - IF ( ( NINT(Init%Nodes(I, 1))==p%Elems(J, 2)) .OR. (NINT(Init%Nodes(I, 1))==p%Elems(J, 3) ) ) THEN !If i-th nodeID matches 1st node or 2nd of j-th element - k = k + 1 - if (k > MaxMemJnt+1) then - CALL SetErrStat(ErrID_Fatal, 'Maximum number of members reached on node'//trim(Num2LStr(NINT(Init%Nodes(I,1)))), ErrStat, ErrMsg, 'NodeCon'); - endif - Init%NodesConnE(I, k + 1) = p%Elems(J, 1) - ENDIF - ENDDO - Init%NodesConnE(I, 1) = k !Store how many elements connect i-th node in 2nd column - ENDDO - -END SUBROUTINE NodeCon - -!---------------------------------------------------------------------------- -!> Check if two elements are connected -!! returns true if they are, and return which node (1 or 2) of each element is involved -LOGICAL FUNCTION ElementsConnected(p, ie1, ie2, iWhichNode_e1, iWhichNode_e2) - TYPE(SD_ParameterType), INTENT(IN) :: p - INTEGER(IntKi), INTENT(IN) :: ie1, ie2 ! Indices of elements - INTEGER(IntKi), INTENT(OUT) :: iWhichNode_e1, iWhichNode_e2 ! 1 or 2 if node 1 or node 2 - if ((p%Elems(ie1, 2) == p%Elems(ie2, 2))) then ! node 1 connected to node 1 - iWhichNode_e1=1 - iWhichNode_e2=1 - ElementsConnected=.True. - else if((p%Elems(ie1, 2) == p%Elems(ie2, 3))) then ! node 1 connected to node 2 - iWhichNode_e1=1 - iWhichNode_e2=2 - ElementsConnected=.True. - else if((p%Elems(ie1, 3) == p%Elems(ie2, 2))) then ! node 2 connected to node 1 - iWhichNode_e1=2 - iWhichNode_e2=1 - ElementsConnected=.True. - else if((p%Elems(ie1, 3) == p%Elems(ie2, 3))) then ! node 2 connected to node 2 - iWhichNode_e1=2 - iWhichNode_e2=2 - ElementsConnected=.True. - else - ElementsConnected=.False. - iWhichNode_e1=-1 - iWhichNode_e2=-1 - endif -END FUNCTION ElementsConnected - -!> Loop through a list of elements and returns a list of unique joints -TYPE(IList) FUNCTION NodesList(p, Elements) - use IntegerList, only: init_list, append, find, sort - use IntegerList, only: print_list - TYPE(SD_ParameterType), INTENT(IN) :: p - integer(IntKi), dimension(:), INTENT(IN) :: Elements - integer(IntKi) :: ie, ei, j1, j2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - - call init_list(NodesList, 0, 0, ErrStat2, ErrMsg2) - do ie = 1, size(Elements) - ei = Elements(ie) ! Element index - j1 = p%Elems(ei,2) ! Joint 1 - j2 = p%Elems(ei,3) ! Joint 2 - ! Append joints indices if not in list already - if (find(NodesList, j1, ErrStat2, ErrMsg2)<=0) call append(NodesList, j1, ErrStat2, ErrMsg2) - if (find(NodesList, j2, ErrStat2, ErrMsg2)<=0) call append(NodesList, j2, ErrStat2, ErrMsg2) - ! Sorting required by find function - call sort(NodesList, ErrStat2, ErrMsg2) - enddo - if (DEV_VERSION) then - call print_list(NodesList, 'Joint list') - endif -END FUNCTION NodesList -!------------------------------------------------------------------------------------------------------ -!> Returns list of rigid link elements (Er) -TYPE(IList) FUNCTION RigidLinkElements(Init, p, ErrStat, ErrMsg) - use IntegerList, only: init_list, append - use IntegerList, only: print_list - TYPE(SD_InitType), INTENT(INOUT) :: Init - TYPE(SD_ParameterType), INTENT(INOUT) :: p - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! Local variables - integer(IntKi) :: ie !< Index on elements - ErrStat = ErrID_None - ErrMsg = "" - ! --- Establish a list of rigid link elements - call init_list(RigidLinkElements, 0, 0, ErrStat, ErrMsg); - - do ie = 1, Init%NElem - if (p%ElemProps(ie)%eType == idMemberRigid) then - call append(RigidLinkElements, ie, ErrStat, ErrMsg); - endif - end do - if (DEV_VERSION) then - call print_list(RigidLinkElements,'Rigid element list') - endif -END FUNCTION RigidLinkElements - -!------------------------------------------------------------------------------------------------------ -!> Returns true if one of the element connected to the node is a rigid link -LOGICAL FUNCTION NodeHasRigidElem(iJoint, Init, p, ei) - integer(IntKi), intent(in) :: iJoint - type(SD_InitType), intent(in) :: Init - type(SD_ParameterType), intent(in) :: p - integer(IntKi), intent( out) :: ei !< Element index that connects do iJoint rigidly - ! Local variables - integer(IntKi) :: ie !< Loop index on elements - - NodeHasRigidElem = .False. ! default return value - ! Loop through elements connected to node J - do ie = 1, Init%NodesConnE(iJoint, 1) - ei = Init%NodesConnE(iJoint, ie+1) - if (p%ElemProps(ei)%eType == idMemberRigid) then - NodeHasRigidElem = .True. - return ! we exit as soon as one rigid member is found - endif - enddo - ei=-1 -END FUNCTION NodeHasRigidElem -!------------------------------------------------------------------------------------------------------ -!> Returns a rigid body transformation matrix from nDOF to 6 reference DOF: T_ref (6 x nDOF), such that Uref = T_ref.U_subset -!! Typically called to get: -!! - the transformation from the interface points to the TP point -!! - the transformation from the bottom nodes to SubDyn origin (0,0,) -SUBROUTINE RigidTrnsf(Init, p, RefPoint, DOF, nDOF, T_ref, ErrStat, ErrMsg) - TYPE(SD_InitType), INTENT(IN ) :: Init ! Input data for initialization routine - TYPE(SD_ParameterType), INTENT(IN ) :: p - REAL(ReKi), INTENT(IN ) :: RefPoint(3) ! Coordinate of the reference point - INTEGER(IntKi), INTENT(IN ) :: nDOF ! Number of DOFS - INTEGER(IntKi), INTENT(IN ) :: DOF(nDOF) ! DOF indices that are used to create the transformation matrix - REAL(ReKi), INTENT( OUT) :: T_ref(nDOF,6) ! matrix that relates the subset of DOFs to the reference point - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER :: I, iDOF, iiDOF, iNode, nDOFPerNode - REAL(ReKi) :: dx, dy, dz - REAL(ReKi), dimension(6) :: Line - ErrStat = ErrID_None - ErrMsg = "" - T_ref(:,:)=0 - DO I = 1, nDOF - iDOF = DOF(I) ! DOF index in constrained system - iNode = p%DOFred2Nodes(iDOF,1) ! First column is node - nDOFPerNode = p%DOFred2Nodes(iDOF,2) ! Second column is number of DOF per node - iiDOF = p%DOFred2Nodes(iDOF,3) ! Third column is dof index for this joint (1-6 for cantilever) - - if ((iiDOF<1) .or. (iiDOF>6)) then - ErrMsg = 'RigidTrnsf, node DOF number is not valid. DOF:'//trim(Num2LStr(iDOF))//' Node:'//trim(Num2LStr(iNode))//' iiDOF:'//trim(Num2LStr(iiDOF)); ErrStat = ErrID_Fatal - return - endif - if (nDOFPerNode/=6) then - ErrMsg = 'RigidTrnsf, node doesnt have 6 DOFs. DOF:'//trim(Num2LStr(iDOF))//' Node:'//trim(Num2LStr(iNode))//' nDOF:'//trim(Num2LStr(nDOFPerNode)); ErrStat = ErrID_Fatal - return - endif - - dx = Init%Nodes(iNode, 2) - RefPoint(1) - dy = Init%Nodes(iNode, 3) - RefPoint(2) - dz = Init%Nodes(iNode, 4) - RefPoint(3) - - CALL RigidTransformationLine(dx,dy,dz,iiDOF,Line) !returns Line - T_ref(I, 1:6) = Line - ENDDO -END SUBROUTINE RigidTrnsf - -!------------------------------------------------------------------------------------------------------ -! --- Main routines, more or less listed in order in which they are called -!------------------------------------------------------------------------------------------------------ -!> -! - Removes the notion of "ID" and use Index instead -! - Creates Nodes (use indices instead of ID), similar to Joints array -! - Creates Elems (use indices instead of ID) similar to Members array -! - Updates Reacts (use indices instead of ID) -! - Updates Interf (use indices instead of ID) -SUBROUTINE SD_ReIndex_CreateNodesAndElems(Init,p, ErrStat, ErrMsg) - TYPE(SD_InitType), INTENT(INOUT) ::Init - TYPE(SD_ParameterType), INTENT(INOUT) ::p - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variable - INTEGER :: I, n, iMem, iNode, JointID - INTEGER(IntKi) :: mType !< Member Type - CHARACTER(1255) :: sType !< String for element type - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - ErrStat = ErrID_None - ErrMsg = "" - - ! TODO See if Elems is actually used elsewhere - - CALL AllocAry(p%Elems, Init%NElem, MembersCol, 'p%Elems', ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(Init%Nodes, p%nNodes, JointsCol, 'Init%Nodes', ErrStat2, ErrMsg2); if(Failed()) return - - ! --- Initialize Nodes - Init%Nodes = -999999 ! Init to unphysical values - do I = 1,Init%NJoints - Init%Nodes(I, 1) = I ! JointID replaced by index I - Init%Nodes(I, 2:JointsCol) = Init%Joints(I, 2:JointsCol) ! All the rest is copied - enddo - - ! --- Re-Initialize Reactions, pointing to index instead of JointID - do I = 1, p%nNodes_C - JointID=p%Nodes_C(I,1) - p%Nodes_C(I,1) = FINDLOCI(Init%Joints(:,1), JointID ) ! Replace JointID with Index - if (p%Nodes_C(I,1)<=0) then - CALL Fatal('Reaction joint table: line '//TRIM(Num2LStr(I))//' refers to JointID '//trim(Num2LStr(JointID))//' which is not in the joint list!') - return - endif - enddo - - ! --- Re-Initialize interface joints, pointing to index instead of JointID - do I = 1, p%nNodes_I - JointID=p%Nodes_I(I,1) - p%Nodes_I(I,1) = FINDLOCI(Init%Joints(:,1), JointID ) - if (p%Nodes_I(I,1)<=0) then - CALL Fatal('Interface joint table: line '//TRIM(Num2LStr(I))//' refers to JointID '//trim(Num2LStr(JointID))//' which is not in the joint list!') - return - endif - enddo - - ! Change numbering in concentrated mass matrix - do I = 1, Init%NCMass - JointID = Init%CMass(I,1) - Init%CMass(I,1) = FINDLOCI(Init%Joints(:,1), JointID ) - if (Init%CMass(I,1)<=0) then - CALL Fatal('Concentrated mass table: line '//TRIM(Num2LStr(I))//' refers to JointID '//trim(Num2LStr(JointID))//' which is not in the joint list!') - return - endif - enddo - - - ! --- Initialize Elems, starting with each member as an element (we'll take NDiv into account later) - p%Elems = 0 - ! --- Replacing "MemberID" "JointID", and "PropSetID" by simple index in this tables - DO iMem = 1, p%NMembers - ! Column 1 : member index (instead of MemberID) - p%Elems(iMem, 1) = iMem - mType = Init%Members(iMem, iMType) ! - ! Column 2-3: Joint index (instead of JointIDs) - p%Elems(iMem, 1) = iMem ! NOTE: element/member number (not MemberID) - do iNode=2,3 - p%Elems(iMem,iNode) = FINDLOCI(Init%Joints(:,1), Init%Members(iMem, iNode) ) - if (p%Elems(iMem,iNode)<=0) then - CALL Fatal(' MemberID '//TRIM(Num2LStr(Init%Members(iMem,1)))//' has JointID'//TRIM(Num2LStr(iNode-1))//' = '// TRIM(Num2LStr(Init%Members(iMem, iNode)))//' which is not in the joint list!') - return - endif - enddo - ! Column 4-5: PropIndex 1-2 (instead of PropSetID1&2) - ! NOTE: this index has different meaning depending on the member type ! - DO n=iMProp,iMProp+1 - - if (mType==idMemberBeam) then - sType='Member x-section property' - p%Elems(iMem,n) = FINDLOCI(Init%PropSetsB(:,1), Init%Members(iMem, n) ) - else if (mType==idMemberCable) then - sType='Cable property' - p%Elems(iMem,n) = FINDLOCI(Init%PropSetsC(:,1), Init%Members(iMem, n) ) - else if (mType==idMemberRigid) then - sType='Rigid property' - p%Elems(iMem,n) = FINDLOCI(Init%PropSetsR(:,1), Init%Members(iMem, n) ) - else - ! Should not happen - print*,'Element type unknown',mType - STOP - end if - ! Test that the two properties match for non-beam - if (mType/=idMemberBeam) then - if (Init%Members(iMem, iMProp)/=Init%Members(iMem, iMProp+1)) then - call Fatal('Properties should be the same at each node for non-beam members. Check member with ID: '//TRIM(Num2LStr(Init%Members(iMem,1)))) - return - endif - endif - if (p%Elems(iMem,n)<=0) then - CALL Fatal('For MemberID '//TRIM(Num2LStr(Init%Members(iMem,1)))//', the PropSetID'//TRIM(Num2LStr(n-3))//' is not in the'//trim(sType)//' table!') - return - endif - END DO !n, loop through property ids - ! Column 6: member type - p%Elems(iMem, iMType) = Init%Members(iMem, iMType) ! - END DO !iMem, loop through members - - ! TODO in theory, we shouldn't need these anymore - ! deallocate(Init%Members) - ! deallocate(Init%Joints) -CONTAINS - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_ReIndex_CreateNodesAndElems') - Failed = ErrStat >= AbortErrLev - END FUNCTION Failed - SUBROUTINE Fatal(ErrMsg_in) - CHARACTER(len=*), intent(in) :: ErrMsg_in - CALL SetErrStat(ErrID_Fatal, ErrMsg_in, ErrStat, ErrMsg, 'SD_ReIndex_CreateNodesAndElems'); - END SUBROUTINE Fatal -END SUBROUTINE SD_ReIndex_CreateNodesAndElems - -!---------------------------------------------------------------------------- -SUBROUTINE SD_Discrt(Init,p, ErrStat, ErrMsg) - TYPE(SD_InitType), INTENT(INOUT) ::Init - TYPE(SD_ParameterType), INTENT(INOUT) ::p - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variable - INTEGER :: I, J, Node1, Node2, Prop1, Prop2 - INTEGER :: NNE ! number of nodes per element - INTEGER :: MaxNProp - REAL(ReKi), ALLOCATABLE :: TempProps(:, :) - INTEGER, ALLOCATABLE :: TempMembers(:, :) - INTEGER :: knode, kelem, kprop, nprop - REAL(ReKi) :: x1, y1, z1, x2, y2, z2, dx, dy, dz, dd, dt, d1, d2, t1, t2 - LOGICAL :: CreateNewProp - INTEGER(IntKi) :: nMemberCable, nMemberRigid, nMemberBeam !< Number of memebers per type - INTEGER(IntKi) :: eType !< Element Type - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - ErrStat = ErrID_None - ErrMsg = "" - - ! number of nodes per element - IF( ( Init%FEMMod >= 0 ) .and. (Init%FEMMod <= 3) ) THEN - NNE = 2 - ELSE - CALL Fatal('FEMMod '//TRIM(Num2LStr(Init%FEMMod))//' not implemented.'); return - ENDIF - - ! --- Total number of element - nMemberBeam = count(Init%Members(:,iMType) == idMemberBeam) - nMemberCable = count(Init%Members(:,iMType) == idMemberCable) - nMemberRigid = count(Init%Members(:,iMType) == idMemberRigid) - Init%NElem = nMemberBeam*Init%NDiv + nMemberCable + nMemberRigid ! NOTE: only Beams are divided - IF ( (nMemberBeam+nMemberRigid+nMemberCable) /= size(Init%Members,1)) then - CALL Fatal(' Member list contains an element which is not a beam, a cable or a rigid link'); return - ENDIF - - ! Total number of nodes - Depends on division and number of nodes per element - p%nNodes = Init%NJoints + ( Init%NDiv - 1 )*nMemberBeam - - ! check the number of interior modes - IF ( p%nDOFM > 6*(p%nNodes - p%nNodes_I - p%nNodes_C) ) THEN - CALL Fatal(' NModes must be less than or equal to '//TRIM(Num2LStr( 6*(p%nNodes - p%nNodes_I - p%nNodes_C) ))); return - ENDIF - - ! TODO replace this with an integer list! - CALL AllocAry(Init%MemberNodes,p%NMembers, Init%NDiv+1,'Init%MemberNodes',ErrStat2, ErrMsg2); if(Failed()) return ! for two-node element only, otherwise the number of nodes in one element is different - - ! --- Reindexing JointsID and MembersID into Nodes and Elems arrays - ! NOTE: need NNode and NElem - CALL SD_ReIndex_CreateNodesAndElems(Init, p, ErrStat2, ErrMsg2); if(Failed()) return - - - Init%MemberNodes = 0 - ! --- Setting up MemberNodes (And Elems, Props, Nodes if divisions) - if (Init%NDiv==1) then - ! NDiv = 1 - Init%MemberNodes(1:p%NMembers, 1:2) = p%Elems(1:Init%NElem, 2:3) - Init%NPropB = Init%NPropSetsB - - else if (Init%NDiv > 1) then - - ! Discretize structure according to NDiv - ! - Elems is fully reinitialized, connectivity needs to be done again using SetNewElem - ! - Nodes are not reinitialized, but appended to NNodes - ! - - ! Initialize Temp arrays that will contain user inputs + input from the subdivided members - ! We don't know how many properties will be needed, so allocated to size MaxNProp - MaxNProp = Init%NPropSetsB + Init%NElem*NNE ! Maximum possible number of property sets (temp): This is property set per element node, for all elements (bjj, added Init%NPropSets to account for possibility of entering many unused prop sets) - CALL AllocAry(TempMembers, p%NMembers, MembersCol , 'TempMembers', ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(TempProps, MaxNProp, PropSetsBCol,'TempProps', ErrStat2, ErrMsg2); if(Failed()) return - TempProps = -9999. - TempMembers = p%Elems(1:p%NMembers,:) - TempProps(1:Init%NPropSetsB, :) = Init%PropSetsB - p%Elems(:,:) = -9999. ! Reinitialized. Elements will be ordered by member subdivisions (see setNewElem) - - kelem = 0 - knode = Init%NJoints - kprop = Init%NPropSetsB - DO I = 1, p%NMembers !the first p%NMembers rows of p%Elems contain the element information - ! Member data - Node1 = TempMembers(I, 2) - Node2 = TempMembers(I, 3) - Prop1 = TempMembers(I, iMProp ) - Prop2 = TempMembers(I, iMProp+1) - eType = TempMembers(I, iMType ) - - IF ( Node1==Node2 ) THEN - CALL Fatal(' Same starting and ending node in the member.') - RETURN - ENDIF - - if (eType/=idMemberBeam) then - ! --- Cables and rigid links are not subdivided and have same prop at nodes - ! No need to create new properties or new nodes - Init%MemberNodes(I, 1) = Node1 - Init%MemberNodes(I, 2) = Node2 - kelem = kelem + 1 - CALL SetNewElem(kelem, Node1, Node2, eType, Prop1, Prop1, p) - cycle - endif - - ! --- Subdivision of beams - Init%MemberNodes(I, 1) = Node1 - Init%MemberNodes(I, Init%NDiv+1) = Node2 - - IF ( ( .not. EqualRealNos(TempProps(Prop1, 2),TempProps(Prop2, 2) ) ) & - .OR. ( .not. EqualRealNos(TempProps(Prop1, 3),TempProps(Prop2, 3) ) ) & - .OR. ( .not. EqualRealNos(TempProps(Prop1, 4),TempProps(Prop2, 4) ) ) ) THEN - - CALL Fatal(' Material E,G and rho in a member must be the same') - RETURN - ENDIF - - x1 = Init%Nodes(Node1, 2) - y1 = Init%Nodes(Node1, 3) - z1 = Init%Nodes(Node1, 4) - - x2 = Init%Nodes(Node2, 2) - y2 = Init%Nodes(Node2, 3) - z2 = Init%Nodes(Node2, 4) - - dx = ( x2 - x1 )/Init%NDiv - dy = ( y2 - y1 )/Init%NDiv - dz = ( z2 - z1 )/Init%NDiv - - d1 = TempProps(Prop1, 5) - t1 = TempProps(Prop1, 6) - - d2 = TempProps(Prop2, 5) - t2 = TempProps(Prop2, 6) - - dd = ( d2 - d1 )/Init%NDiv - dt = ( t2 - t1 )/Init%NDiv - - ! If both dd and dt are 0, no interpolation is needed, and we can use the same property set for new nodes/elements. otherwise we'll have to create new properties for each new node - CreateNewProp = .NOT. ( EqualRealNos( dd , 0.0_ReKi ) .AND. EqualRealNos( dt , 0.0_ReKi ) ) - - ! node connect to Node1 - knode = knode + 1 - Init%MemberNodes(I, 2) = knode - CALL SetNewNode(knode, x1+dx, y1+dy, z1+dz, Init); if (ErrStat>ErrID_None) return; - - IF ( CreateNewProp ) THEN - ! create a new property set - ! k, E, G, rho, d, t, Init - kprop = kprop + 1 - CALL SetNewProp(kprop, TempProps(Prop1, 2), TempProps(Prop1, 3), TempProps(Prop1, 4), d1+dd, t1+dt, TempProps) - kelem = kelem + 1 - CALL SetNewElem(kelem, Node1, knode, eType, Prop1, kprop, p); if (ErrStat>ErrID_None) return; - nprop = kprop - ELSE - kelem = kelem + 1 - CALL SetNewElem(kelem, Node1, knode, eType, Prop1, Prop1, p); if (ErrStat>ErrID_None) return; - nprop = Prop1 - ENDIF - - ! interior nodes - DO J = 2, (Init%NDiv-1) - knode = knode + 1 - Init%MemberNodes(I, J+1) = knode - - CALL SetNewNode(knode, x1 + J*dx, y1 + J*dy, z1 + J*dz, Init) ! Set Init%Nodes(knode,:) - - IF ( CreateNewProp ) THEN - ! create a new property set - ! k, E, G, rho, d, t, Init - kprop = kprop + 1 - CALL SetNewProp(kprop, TempProps(Prop1, 2), TempProps(Prop1, 3), Init%PropSetsB(Prop1, 4), d1 + J*dd, t1 + J*dt, TempProps) - kelem = kelem + 1 - CALL SetNewElem(kelem, knode-1, knode, eType, nprop, kprop, p); if (ErrStat>ErrID_None) return; - nprop = kprop - ELSE - kelem = kelem + 1 - CALL SetNewElem(kelem, knode-1, knode, eType, nprop, nprop, p); if (ErrStat>ErrID_None) return; - ENDIF - ENDDO - - ! the element connect to Node2 - kelem = kelem + 1 - CALL SetNewElem(kelem, knode, Node2, eType, nprop, Prop2, p); if (ErrStat>ErrID_None) return; - ENDDO ! loop over all members - ! - Init%NPropB = kprop - if(knode/=size(Init%Nodes,1)) then - call Fatal('Implementation error. Number of nodes wrongly estimated.');return - endif - if(kelem/=size(p%Elems,1)) then - call Fatal('Implementation error. Number of elements wrongly estimated.');return - endif - - ENDIF ! if NDiv is greater than 1 - - ! set the props in Init - CALL AllocAry(Init%PropsB, Init%NPropB, PropSetsBCol, 'Init%PropsBeams', ErrStat2, ErrMsg2); if(Failed()) return - - if (Init%NDiv==1) then - Init%PropsB(1:Init%NPropB, 1:PropSetsBCol) = Init%PropSetsB(1:Init%NPropB, 1:PropSetsBCol) - else if (Init%NDiv>1) then - Init%PropsB(1:Init%NPropB, 1:PropSetsBCol) = TempProps(1:Init%NPropB, 1:PropSetsBCol) - endif - - ! --- Cables and rigid link properties (these cannot be subdivided, so direct copy of inputs) - Init%NPropC = Init%NPropSetsC - Init%NPropR = Init%NPropSetsR - CALL AllocAry(Init%PropsC, Init%NPropC, PropSetsCCol, 'Init%PropsCable', ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(Init%PropsR, Init%NPropR, PropSetsRCol, 'Init%PropsRigid', ErrStat2, ErrMsg2); if(Failed()) return - Init%PropsC(1:Init%NPropC, 1:PropSetsCCol) = Init%PropSetsC(1:Init%NPropC, 1:PropSetsCCol) - Init%PropsR(1:Init%NPropR, 1:PropSetsRCol) = Init%PropSetsR(1:Init%NPropR, 1:PropSetsRCol) - - CALL CleanUp_Discrt() - -CONTAINS - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_Discrt') - Failed = ErrStat >= AbortErrLev - if (Failed) CALL CleanUp_Discrt() - END FUNCTION Failed - - SUBROUTINE Fatal(ErrMsg_in) - CHARACTER(len=*), intent(in) :: ErrMsg_in - CALL SetErrStat(ErrID_Fatal, ErrMsg_in, ErrStat, ErrMsg, 'SD_Discrt'); - CALL CleanUp_Discrt() - END SUBROUTINE Fatal - - SUBROUTINE CleanUp_Discrt() - ! deallocate temp matrices - IF (ALLOCATED(TempProps)) DEALLOCATE(TempProps) - IF (ALLOCATED(TempMembers)) DEALLOCATE(TempMembers) - END SUBROUTINE CleanUp_Discrt - - !> Set properties of node k - SUBROUTINE SetNewNode(k, x, y, z, Init) - TYPE(SD_InitType), INTENT(INOUT) :: Init - INTEGER, INTENT(IN) :: k - REAL(ReKi), INTENT(IN) :: x, y, z - if (k>size(Init%Nodes,1)) then - call Fatal('Implementation Error. Attempt to add more node than space allocated.'); - return - endif - Init%Nodes(k, 1) = k - Init%Nodes(k, 2) = x - Init%Nodes(k, 3) = y - Init%Nodes(k, 4) = z - Init%Nodes(k, iJointType) = idJointCantilever ! Note: all added nodes are Cantilever - ! Properties below are for non-cantilever joints - Init%Nodes(k, iJointDir:iJointDir+2) = 0.0_ReKi ! NOTE: irrelevant for cantilever nodes - Init%Nodes(k, iJointStiff) = 0.0_ReKi ! NOTE: irrelevant for cantilever nodes - END SUBROUTINE SetNewNode - - !> Set properties of element k - SUBROUTINE SetNewElem(k, n1, n2, etype, p1, p2, p) - INTEGER, INTENT(IN ) :: k - INTEGER, INTENT(IN ) :: n1 - INTEGER, INTENT(IN ) :: n2 - INTEGER, INTENT(IN ) :: eType - INTEGER, INTENT(IN ) :: p1 - INTEGER, INTENT(IN ) :: p2 - TYPE(SD_ParameterType), INTENT(INOUT) :: p - if (k>size(p%Elems,1)) then - call Fatal('Implementation Error. Attempt to add more element than space allocated.'); - return - endif - p%Elems(k, 1) = k - p%Elems(k, 2) = n1 - p%Elems(k, 3) = n2 - p%Elems(k, iMProp ) = p1 - p%Elems(k, iMProp+1) = p2 - p%Elems(k, iMType) = eType - END SUBROUTINE SetNewElem - - !> Set material properties of element k, NOTE: this is only for a beam - SUBROUTINE SetNewProp(k, E, G, rho, d, t, TempProps) - INTEGER , INTENT(IN) :: k - REAL(ReKi), INTENT(IN) :: E, G, rho, d, t - REAL(ReKi), INTENT(INOUT):: TempProps(:, :) - if (k>size(TempProps,1)) then - call Fatal('Implementation Error. Attempt to add more properties than space allocated.'); - return - endif - TempProps(k, 1) = k - TempProps(k, 2) = E - TempProps(k, 3) = G - TempProps(k, 4) = rho - TempProps(k, 5) = d - TempProps(k, 6) = t - END SUBROUTINE SetNewProp - -END SUBROUTINE SD_Discrt - - -!> Store relative vector between nodes and TP point, to later compute Guyan rigid body motion -subroutine StoreNodesRelPos(Init, p, ErrStat, ErrMsg) - type(SD_InitType), intent(in ) :: Init - type(SD_ParameterType), intent(inout) :: p - integer(IntKi), intent(out) :: ErrStat ! Error status of the operation - character(*), intent(out) :: ErrMsg ! Error message if ErrStat /= ErrID_None - integer(Intki) :: i - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - ErrStat = ErrID_None - ErrMsg = "" - - ! NOTE: using efficient memory order - call AllocAry(p%DP0, 3, size(Init%Nodes,1), 'DP0', ErrStat2, ErrMsg2); if(Failed()) return - - do i = 1, size(Init%Nodes,1) - p%DP0(1, i) = Init%Nodes(i, 2) - Init%TP_RefPoint(1) - p%DP0(2, i) = Init%Nodes(i, 3) - Init%TP_RefPoint(2) - p%DP0(3, i) = Init%Nodes(i, 4) - Init%TP_RefPoint(3) - enddo - -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, Errstat, ErrMsg, 'StoreNodesRelPos') - failed = ErrStat >= AbortErrLev - end function Failed -end subroutine StoreNodesRelPos - - - -!------------------------------------------------------------------------------------------------------ -!> Set Element properties p%ElemProps, different properties are set depening on element type.. -SUBROUTINE SetElementProperties(Init, p, ErrStat, ErrMsg) - TYPE(SD_InitType), INTENT(IN ) :: Init - TYPE(SD_ParameterType), INTENT(INOUT) :: p - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! Local variables - INTEGER :: I - INTEGER :: N1, N2 ! starting node and ending node in the element - INTEGER :: P1, P2 ! property set numbers for starting and ending nodes - REAL(ReKi) :: D1, D2, t1, t2, E, G, rho ! properties of a section - REAL(FEKi) :: DirCos(3, 3) ! direction cosine matrices - REAL(ReKi) :: L ! length of the element - REAL(ReKi) :: r1, r2, t, Iyy, Jzz, Ixx, A, kappa, nu, ratioSq, D_inner, D_outer - LOGICAL :: shear - INTEGER(IntKi) :: eType !< Member type - REAL(ReKi) :: Point1(3), Point2(3) ! (x,y,z) positions of two nodes making up an element - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - ErrMsg = "" - ErrStat = ErrID_None - - ALLOCATE( p%ElemProps(Init%NElem), STAT=ErrStat2); ErrMsg2='Error allocating p%ElemProps' - if(Failed()) return - - ! Loop over all elements and set ElementProperties - do I = 1, Init%NElem - N1 = p%Elems(I, 2) - N2 = p%Elems(I, 3) - - P1 = p%Elems(I, iMProp ) - P2 = p%Elems(I, iMProp+1) - eType = p%Elems(I, iMType) - - ! --- Properties common to all element types: L, DirCos (and Area and rho) - Point1 = Init%Nodes(N1,2:4) - Point2 = Init%Nodes(N2,2:4) - CALL GetDirCos(Point1, Point2, DirCos, L, ErrStat2, ErrMsg2); if(Failed()) return ! L and DirCos - p%ElemProps(i)%eType = eType - p%ElemProps(i)%Length = L - p%ElemProps(i)%DirCos = DirCos - - ! Init to excessive values to detect any issue - p%ElemProps(i)%Ixx = -9.99e+36 - p%ElemProps(i)%Iyy = -9.99e+36 - p%ElemProps(i)%Jzz = -9.99e+36 - p%ElemProps(i)%Kappa = -9.99e+36 - p%ElemProps(i)%YoungE = -9.99e+36 - p%ElemProps(i)%ShearG = -9.99e+36 - p%ElemProps(i)%Area = -9.99e+36 - p%ElemProps(i)%Rho = -9.99e+36 - p%ElemProps(i)%T0 = -9.99e+36 - - ! --- Properties that are specific to some elements - if (eType==idMemberBeam) then - E = Init%PropsB(P1, 2) - G = Init%PropsB(P1, 3) - rho = Init%PropsB(P1, 4) - D1 = Init%PropsB(P1, 5) - t1 = Init%PropsB(P1, 6) - D2 = Init%PropsB(P2, 5) - t2 = Init%PropsB(P2, 6) - r1 = 0.25*(D1 + D2) - t = 0.5*(t1+t2) - if ( EqualRealNos(t, 0.0_ReKi) ) then - r2 = 0 - else - r2 = r1 - t - endif - A = Pi_D*(r1*r1-r2*r2) - Ixx = 0.25*Pi_D*(r1**4-r2**4) - Iyy = Ixx - Jzz = 2.0*Ixx - - if( Init%FEMMod == 1 ) then ! uniform Euler-Bernoulli - Shear = .false. - kappa = 0 - elseif( Init%FEMMod == 3 ) then ! uniform Timoshenko - Shear = .true. - ! kappa = 0.53 - ! equation 13 (Steinboeck et al) in SubDyn Theory Manual - nu = E / (2.0_ReKi*G) - 1.0_ReKi - D_outer = 2.0_ReKi * r1 ! average (outer) diameter - D_inner = D_outer - 2*t ! remove 2x thickness to get inner diameter - ratioSq = ( D_inner / D_outer)**2 - kappa = ( 6.0 * (1.0 + nu) **2 * (1.0 + ratioSq)**2 ) & - / ( ( 1.0 + ratioSq )**2 * ( 7.0 + 14.0*nu + 8.0*nu**2 ) + 4.0 * ratioSq * ( 5.0 + 10.0*nu + 4.0 *nu**2 ) ) - endif - ! Storing Beam specific properties - p%ElemProps(i)%Ixx = Ixx - p%ElemProps(i)%Iyy = Iyy - p%ElemProps(i)%Jzz = Jzz - p%ElemProps(i)%Shear = Shear - p%ElemProps(i)%kappa = kappa - p%ElemProps(i)%YoungE = E - p%ElemProps(i)%ShearG = G - p%ElemProps(i)%Area = A - p%ElemProps(i)%Rho = rho - - else if (eType==idMemberCable) then - if (DEV_VERSION) then - print*,'Member',I,'is a cable' - endif - p%ElemProps(i)%Area = 1 ! Arbitrary set to 1 - p%ElemProps(i)%YoungE = Init%PropsC(P1, 2)/1 ! Young's modulus, E=EA/A [N/m^2] - p%ElemProps(i)%Rho = Init%PropsC(P1, 3) ! Material density [kg/m3] - p%ElemProps(i)%T0 = Init%PropsC(P1, 4) ! Pretension force [N] - - else if (eType==idMemberRigid) then - if (DEV_VERSION) then - print*,'Member',I,'is a rigid link' - endif - p%ElemProps(i)%Area = 1 ! Arbitrary set to 1 - p%ElemProps(i)%Rho = Init%PropsR(P1, 2) - - else - ! Should not happen - print*,'Element type unknown',eType - STOP - end if - enddo ! I end loop over elements -CONTAINS - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SetElementProperties') - Failed = ErrStat >= AbortErrLev - END FUNCTION Failed -END SUBROUTINE SetElementProperties - - -!> Distribute global DOF indices corresponding to Nodes, Elements, BCs, Reactions -!! For Cantilever Joint -> Condensation into 3 translational and 3 rotational DOFs -!! For other joint type -> Condensation of the 3 translational DOF -!! -> Keeping 3 rotational DOF for each memeber connected to the joint -SUBROUTINE DistributeDOF(Init, p, ErrStat, ErrMsg) - use IntegerList, only: init_list, len - TYPE(SD_InitType), INTENT(INOUT) :: Init - TYPE(SD_ParameterType), INTENT(INOUT) :: p - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - integer(IntKi) :: iNode, k - integer(IntKi) :: iPrev ! Cumulative counter over the global DOF - integer(IntKi) :: iElem ! - integer(IntKi) :: idElem - integer(IntKi) :: nRot ! Number of rotational DOFs (multiple of 3) to be used at the joint - integer(IntKi) :: iOff ! Offset, 0 or 6, depending if node 1 or node 2 - integer(IntKi), dimension(6) :: DOFNode_Old - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - ErrMsg = "" - ErrStat = ErrID_None - - allocate(p%NodesDOF(1:p%nNodes), stat=ErrStat2) - ErrMsg2="Error allocating NodesDOF" - if(Failed()) return - - call AllocAry(p%ElemsDOF, 12, Init%NElem, 'ElemsDOF', ErrStat2, ErrMsg2); if(Failed()) return; - p%ElemsDOF=-9999 - - iPrev =0 - do iNode = 1, p%nNodes - ! --- Distribute to joints iPrev + 1:6, or, iPrev + 1:(3+3m) - if (int(Init%Nodes(iNode,iJointType)) == idJointCantilever ) then - nRot=3 - else - nRot= 3*Init%NodesConnE(iNode,1) ! Col1: number of elements connected to this joint - endif - call init_list(p%NodesDOF(iNode), 3+nRot, iPrev, ErrStat2, ErrMsg2) - p%NodesDOF(iNode)%List(1:(3+nRot)) = (/ ((iElem+iPrev), iElem=1,3+nRot) /) - - ! --- Distribute to members - do iElem = 1, Init%NodesConnE(iNode,1) ! members connected to joint iJ - idElem = Init%NodesConnE(iNode,iElem+1) - if (iNode == p%Elems(idElem, 2)) then ! Current joint is Elem node 1 - iOff = 0 - else ! Current joint is Elem node 2 - iOff = 6 - endif - p%ElemsDOF(iOff+1:iOff+3, idElem) = p%NodesDOF(iNode)%List(1:3) - if (int(Init%Nodes(iNode,iJointType)) == idJointCantilever ) then - p%ElemsDOF(iOff+4:iOff+6, idElem) = p%NodesDOF(iNode)%List(4:6) - else - p%ElemsDOF(iOff+4:iOff+6, idElem) = p%NodesDOF(iNode)%List(3*iElem+1:3*iElem+3) - endif - enddo ! iElem, loop on members connect to joint - iPrev = iPrev + len(p%NodesDOF(iNode)) - enddo ! iNode, loop on joints - - ! --- Safety check - if (any(p%ElemsDOF<0)) then - ErrStat=ErrID_Fatal - ErrMsg ="Implementation error in Distribute DOF, some member DOF were not allocated" - endif - - ! --- Safety check (backward compatibility, only valid if all joints are Cantilever) - if (p%nNodes == count( Init%Nodes(:, iJointType) == idJointCantilever)) then - do idElem = 1, Init%NElem - iNode = p%Elems(idElem, 2) - DOFNode_Old= (/ ((iNode*6-5+k), k=0,5) /) - if ( any( (p%ElemsDOF(1:6, idElem) /= DOFNode_Old)) ) then - ErrStat=ErrID_Fatal - ErrMsg ="Implementation error in Distribute DOF, DOF indices have changed for iElem="//trim(Num2LStr(idElem)) - return - endif - enddo - else - ! Safety check does not apply if some joints are non-cantilever - endif - -CONTAINS - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SetElementProperties') - Failed = ErrStat >= AbortErrLev - END FUNCTION Failed - -END SUBROUTINE DistributeDOF - - -!> Checks reaction BC, adn remap 0s and 1s -SUBROUTINE CheckBCs(p, ErrStat, ErrMsg) - TYPE(SD_ParameterType),INTENT(INOUT) :: p - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - INTEGER(IntKi) :: I, J, iNode - ErrMsg = "" - ErrStat = ErrID_None - DO I = 1, p%nNodes_C - iNode = p%Nodes_C(I,1) ! Node index - DO J = 1, 6 - if (p%Nodes_C(I,J+1)==1) then ! User input 1=Constrained/Fixed (should be eliminated) - p%Nodes_C(I, J+1) = idBC_Fixed - else if (p%Nodes_C(I,J+1)==0) then ! User input 0=Free, fill be part of Internal DOF - p%Nodes_C(I, J+1) = idBC_Internal - else if (p%Nodes_C(I,J+1)==2) then ! User input 2=Leader DOF - p%Nodes_C(I, J+1) = idBC_Leader - ErrStat=ErrID_Fatal - ErrMsg='BC 2 not allowed for now, node '//trim(Num2LStr(iNode)) - else - ErrStat=ErrID_Fatal - ErrMsg='Wrong boundary condition input for reaction node '//trim(Num2LStr(iNode)) - endif - ENDDO - ENDDO -END SUBROUTINE CheckBCs - -!> Check interface inputs, and remap 0s and 1s -SUBROUTINE CheckIntf(p, ErrStat, ErrMsg) - TYPE(SD_ParameterType),INTENT(INOUT) :: p - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - INTEGER(IntKi) :: I, J, iNode - ErrMsg = "" - ErrStat = ErrID_None - DO I = 1, p%nNodes_I - iNode = p%Nodes_I(I,1) ! Node index - DO J = 1, 6 ! ItfTDXss ItfTDYss ItfTDZss ItfRDXss ItfRDYss ItfRDZss - if (p%Nodes_I(I,J+1)==1) then ! User input 1=Leader DOF - p%Nodes_I(I,J+1) = idBC_Leader - elseif (p%Nodes_I(I,J+1)==0) then ! User input 0=Fixed DOF - p%Nodes_I(I,J+1) = idBC_Fixed - ErrStat = ErrID_Fatal - ErrMsg = 'Fixed boundary condition not yet supported for interface nodes, node:'//trim(Num2LStr(iNode)) - else - ErrStat = ErrID_Fatal - ErrMsg = 'Wrong boundary condition input for interface node'//trim(Num2LStr(iNode)) - endif - ENDDO - ENDDO -END SUBROUTINE CheckIntf - - -!------------------------------------------------------------------------------------------------------ -!> Assemble stiffness and mass matrix, and gravity force vector -SUBROUTINE AssembleKM(Init, p, ErrStat, ErrMsg) - TYPE(SD_InitType), INTENT(INOUT) :: Init - TYPE(SD_ParameterType), INTENT(INOUT) :: p - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! Local variables - INTEGER :: I, J, K - INTEGER :: iGlob - REAL(FEKi) :: Ke(12,12), Me(12, 12), FGe(12) ! element stiffness and mass matrices gravity force vector - REAL(FEKi) :: FCe(12) ! Pretension force from cable element - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - INTEGER(IntKi) :: iNode !< Node index - integer(IntKi), dimension(12) :: IDOF ! 12 DOF indices in global unconstrained system - real(ReKi), dimension(6,6) :: M66 ! Mass matrix of an element node - real(ReKi) :: m, x, y, z, Jxx, Jyy, Jzz, Jxy, Jxz, Jyz - INTEGER :: jGlob, kGlob - ErrMsg = "" - ErrStat = ErrID_None - - ! total unconstrained degrees of freedom of the system - p%nDOF = nDOF_Unconstrained() - if (DEV_VERSION) then - print*,'nDOF_unconstrained:',p%nDOF, ' (if all Cantilever, it would be: ',6*p%nNodes,')' - endif - - CALL AllocAry( Init%K, p%nDOF, p%nDOF , 'Init%K', ErrStat2, ErrMsg2); if(Failed()) return; ! system stiffness matrix - CALL AllocAry( Init%M, p%nDOF, p%nDOF , 'Init%M', ErrStat2, ErrMsg2); if(Failed()) return; ! system mass matrix - CALL AllocAry( p%FG, p%nDOF, 'p%FG' , ErrStat2, ErrMsg2); if(Failed()) return; ! system gravity force vector - Init%K = 0.0_FEKi - Init%M = 0.0_FEKi - p%FG = 0.0_FEKi - - ! loop over all elements, compute element matrices and assemble into global matrices - DO i = 1, Init%NElem - ! --- Element Me,Ke,Fg, Fce - CALL ElemM(p%ElemProps(i), Me) - CALL ElemK(p%ElemProps(i), Ke) - CALL ElemF(p%ElemProps(i), Init%g, FGe, FCe) - - ! --- Assembly in global unconstrained system - IDOF = p%ElemsDOF(1:12, i) - p%FG ( IDOF ) = p%FG( IDOF ) + FGe(1:12)+ FCe(1:12) ! Note: gravity and pretension cable forces - Init%K(IDOF, IDOF) = Init%K( IDOF, IDOF) + Ke(1:12,1:12) - Init%M(IDOF, IDOF) = Init%M( IDOF, IDOF) + Me(1:12,1:12) - ENDDO - - ! Add concentrated mass to mass matrix - DO I = 1, Init%nCMass - iNode = NINT(Init%CMass(I, 1)) ! Note index where concentrated mass is to be added - ! Safety check (otherwise we might have more than 6 DOF) - if (Init%Nodes(iNode,iJointType) /= idJointCantilever) then - ErrMsg2='Concentrated mass is only for cantilever joints. Problematic node: '//trim(Num2LStr(iNode)); ErrStat2=ErrID_Fatal; - if(Failed()) return - endif - ! Mass matrix of a rigid body - M66 = 0.0_ReKi - m = Init%CMass(I,2) - Jxx = Init%CMass(I,3 ); Jxy = Init%CMass(I,6 ); x = Init%CMass(I,9 ); - Jyy = Init%CMass(I,4 ); Jxz = Init%CMass(I,7 ); y = Init%CMass(I,10); - Jzz = Init%CMass(I,5 ); Jyz = Init%CMass(I,8 ); z = Init%CMass(I,11); - M66(1 , :)=(/ m , 0._ReKi , 0._ReKi , 0._ReKi , z*m , -y*m /) - M66(2 , :)=(/ 0._ReKi , m , 0._ReKi , -z*m , 0._ReKi , x*m /) - M66(3 , :)=(/ 0._ReKi , 0._ReKi , m , y*m , -x*m , 0._ReKi /) - M66(4 , :)=(/ 0._ReKi , -z*m , y*m , Jxx + m*(y**2+z**2) , Jxy - m*x*y , Jxz - m*x*z /) - M66(5 , :)=(/ z*m , 0._ReKi , -x*m , Jxy - m*x*y , Jyy + m*(x**2+z**2) , Jyz - m*y*z /) - M66(6 , :)=(/ -y*m , x*m , 0._ReKi , Jxz - m*x*z , Jyz - m*y*z , Jzz + m*(x**2+y**2) /) - ! Adding - DO J = 1, 6 - jGlob = p%NodesDOF(iNode)%List(J) - DO K = 1, 6 - kGlob = p%NodesDOF(iNode)%List(K) - Init%M(jGlob, kGlob) = Init%M(jGlob, kGlob) + M66(J,K) - ENDDO - ENDDO - ENDDO ! Loop on concentrated mass - - ! Add concentrated mass induced gravity force - DO I = 1, Init%nCMass - iNode = NINT(Init%CMass(I, 1)) ! Note index where concentrated mass is to be added - iGlob = p%NodesDOF(iNode)%List(3) ! uz - p%FG(iGlob) = p%FG(iGlob) - Init%CMass(I, 2)*Init%g - ENDDO - - CALL CleanUp_AssembleKM() - -CONTAINS - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AssembleKM') - Failed = ErrStat >= AbortErrLev - if (Failed) call Cleanup_AssembleKM() - END FUNCTION Failed - - SUBROUTINE Fatal(ErrMsg_in) - character(len=*), intent(in) :: ErrMsg_in - CALL SetErrStat(ErrID_Fatal, ErrMsg_in, ErrStat, ErrMsg, 'AssembleKM'); - CALL CleanUp_AssembleKM() - END SUBROUTINE Fatal - - SUBROUTINE CleanUp_AssembleKM() - !pass - END SUBROUTINE CleanUp_AssembleKM - - INTEGER(IntKi) FUNCTION nDOF_Unconstrained() - integer(IntKi) :: i - integer(IntKi) :: m - nDOF_Unconstrained=0 - do i = 1,p%nNodes - if (int(Init%Nodes(i,iJointType)) == idJointCantilever ) then - nDOF_Unconstrained = nDOF_Unconstrained + 6 - else - m = Init%NodesConnE(i,1) ! Col1: number of elements connected to this joint - nDOF_Unconstrained = nDOF_Unconstrained + 3 + 3*m - endif - end do - END FUNCTION - -END SUBROUTINE AssembleKM - -!> Map control cable index to control channel index -subroutine ControlCableMapping(Init, uInit, p, ErrStat, ErrMsg) - type(SD_InitType), intent(in ) :: Init !< init - type(SD_InputType), intent(inout) :: uInit !< init input guess - type(SD_ParameterType), intent(inout) :: p !< param - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - ! Local variables - integer(IntKi) :: i, nCC, idCProp, iElem !< index, number of controlable cables, id of Cable Prop - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - ErrMsg = "" - ErrStat = ErrID_None - - ! --- Count number of Controllable cables - nCC = 0 - do i = 1, size(p%ElemProps) - if (p%ElemProps(i)%eType==idMemberCable) then - idCProp= p%Elems(i,iMProp) - if (Init%PropsC(idCProp, 5 )>0) then - !print*,'Cable Element',i,'controllable with channel',Init%PropsC(idCProp, 5 ) - nCC=nCC+1 - endif - endif - enddo - if (nCC>0) then - call WrScr('Number of controllable cables: '//trim(num2lstr(nCC))) - endif - call AllocAry( p%CtrlElem2Channel, nCC, 2, 'p%CtrlElem2Channel', ErrStat2, ErrMsg2); if(Failed()) return; ! Constant cable force - - ! --- Store mapping - nCC = 0 - do i = 1, size(p%ElemProps) - if (p%ElemProps(i)%eType==idMemberCable) then - idCProp= p%Elems(i,iMProp) - if (Init%PropsC(idCProp, 5 )>0) then - nCC=nCC+1 - p%CtrlElem2Channel(nCC, 1) = i ! Element index (in p%Elems and p%ElemProps) - p%CtrlElem2Channel(nCC, 2) = Init%PropsC(idCProp,5) ! Control channel - endif - endif - enddo - - ! --- DeltaL Guess for inputs - if (allocated(uInit%CableDeltaL)) deallocate(uInit%CableDeltaL) - call AllocAry(uInit%CableDeltaL, nCC, 'uInit%CableDeltaL', ErrStat2, ErrMsg2); if(Failed()) return; - do i = 1, nCC - iElem = p%CtrlElem2Channel(i,1) - ! DeltaL 0 = - Le T0 / (EA + T0) = - Le eps0 / (1+eps0) - uInit%CableDeltaL(i) = - p%ElemProps(iElem)%Length * p%ElemProps(iElem)%T0 / (p%ElemProps(iElem)%YoungE*p%ElemProps(iElem)%Area + p%ElemProps(iElem)%T0) - enddo - -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'ControlCableMapping') - Failed = ErrStat >= AbortErrLev - end function Failed -end subroutine ControlCableMapping - -!> Init for control Cable force -!! The change of cable forces due to the control is linear, so we just store a "unit" force vector -!! We will just scale this vector at each time step based on the control input (Tcontrol): -!! Fcontrol = (Tcontrol-T0) * Funit -!! We store it in "non-reduced" system since it will added to the external forces -SUBROUTINE ControlCableForceInit(p, m, ErrStat, ErrMsg) - TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! Local variables - INTEGER :: iCC, iElem - REAL(FEKi) :: FCe(12) ! Pretension force from cable element - integer(IntKi), dimension(12) :: IDOF ! 12 DOF indices in global unconstrained system - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - ErrMsg = "" - ErrStat = ErrID_None - - ! Allocating necessary arrays - CALL AllocAry( m%FC_unit , p%nDOF, 'm%FC0' , ErrStat2, ErrMsg2); if(Failed()) return; ! Control cable force - m%FC_unit = 0.0_ReKi - - ! loop over all elements, compute element matrices and assemble into global matrices - DO iCC = 1, size(p%CtrlElem2Channel,1) - iElem = p%CtrlElem2Channel(iCC,1) - CALL ElemF_Cable(1.0_ReKi, p%ElemProps(iElem)%DirCos, FCe) !< NOTE: using unitary load T0=1.0_ReKi - ! --- Assembly in global unconstrained system - IDOF = p%ElemsDOF(1:12, iElem) - m%FC_unit( IDOF ) = m%FC_unit( IDOF ) + FCe(1:12) - ENDDO - ! Transforming the vector into reduced, direct elimination system: - !FC_red = matmul(transpose(p%T_red), FC) - !if(allocated(FC)) deallocate(FC) - -CONTAINS - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'ControlCableForceInit') - Failed = ErrStat >= AbortErrLev - END FUNCTION Failed -END SUBROUTINE ControlCableForceInit - -!> Add soil stiffness and mass to global system matrices -!! Soil stiffness can come from two sources: -!! - "SSI" matrices (specified at reaction nodes) -!! - "Soil" matrices (specified at Initalization) -SUBROUTINE InsertSoilMatrices(M, K, NodesDOF, Init, p, ErrStat, ErrMsg, Substract) - real(FEKi), dimension(:,:), intent(inout) :: M - real(FEKi), dimension(:,:), intent(inout) :: K - type(IList),dimension(:), intent(in ) :: NodesDOF !< Map from Node Index to DOF lists - type(SD_InitType), intent(inout) :: Init ! TODO look for closest indices elsewhere - type(SD_ParameterType), intent(in ) :: p - integer(IntKi), intent( out) :: ErrStat ! Error status of the operation - character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None - logical, optional, intent(in ) :: SubStract ! If present, and if true, substract instead of adding - integer :: I, J, iiNode, nDOF - integer :: iDOF, jDOF, iNode !< DOF and node indices - real(FEKi), dimension(6,6) :: K_soil, M_soil ! Auxiliary matrices for soil - real(ReKi) :: Dist - ErrMsg = "" - ErrStat = ErrID_None - ! --- SSI matrices - ! TODO consider doing the 21 -> 6x6 conversion while reading - ! 6x6 matrix goes to one node of one element only - do iiNode = 1, p%nNodes_C ! loop on constrained nodes - iNode = p%Nodes_C(iiNode,1) - nDOF=size(NodesDOF(iNode)%List) - if (nDOF/=6) then - ErrMsg='SSI soil matrix is to be inserted at SubDyn node '//Num2LStr(iNode)//', but this node has '//num2lstr(nDOF)//' DOFs'; - ErrStat=ErrID_Fatal; return - endif - call Array21_to_6by6(Init%SSIK(:,iiNode), K_soil) - call Array21_to_6by6(Init%SSIM(:,iiNode), M_soil) - if (present(Substract)) then - if (Substract) then - K_soil = - K_soil - M_soil = - M_soil - endif - endif - do I = 1, 6 - iDOF = NodesDOF(iNode)%List(I) ! DOF index - do J = 1, 6 - jDOF = NodesDOF(iNode)%List(J) ! DOF index - K(iDOF, jDOF) = K(iDOF, jDOF) + K_soil(I,J) - M(iDOF, jDOF) = M(iDOF, jDOF) + M_soil(I,J) - enddo - enddo - enddo - ! --- "Soil" matrices - if (allocated(Init%Soil_K)) then - do iiNode = 1,size(Init%Soil_Points,2) - ! --- Find closest node - call FindClosestNodes(Init%Soil_Points(1:3,iiNode), Init%Nodes, iNode, Dist); - if (Dist>0.1_ReKi) then - ErrMsg='Closest SubDyn Node is node '//Num2LStr(iNode)//', which is more than 0.1m away from soildyn point '//num2lstr(iiNode); - ErrStat=ErrID_Fatal; return - endif - Init%Soil_Nodes(iiNode) = iNode - ! --- Insert/remove from matrices - nDOF=size(NodesDOF(iNode)%List) - if (nDOF/=6) then - ErrMsg='Soil matrix is to be inserted at SubDyn node '//Num2LStr(iNode)//', but this node has '//num2lstr(nDOF)//' DOFs'; - ErrStat=ErrID_Fatal; return - endif - K_soil = Init%Soil_K(1:6,1:6,iiNode) - if (present(Substract)) then - if (Substract) then - K_soil = - K_soil - endif - endif - do I = 1, 6 - iDOF = NodesDOF(iNode)%List(I) ! DOF index - do J = 1, 6 - jDOF = NodesDOF(iNode)%List(J) ! DOF index - K(iDOF, jDOF) = K(iDOF, jDOF) + K_soil(I,J) - enddo - enddo - if (.not.present(Substract)) then - CALL WrScr(' Soil stiffness inserted at SubDyn node '//trim(Num2LStr(iNode))) - print*,' ',K_Soil(1,1:6) - print*,' ',K_Soil(2,1:6) - print*,' ',K_Soil(3,1:6) - print*,' ',K_Soil(4,1:6) - print*,' ',K_Soil(5,1:6) - print*,' ',K_Soil(6,1:6) - endif - enddo - endif -contains - !> Convert a flatten array of 21 values into a symmetric 6x6 matrix - SUBROUTINE Array21_to_6by6(A21, M66) - use NWTC_LAPACK, only: LAPACK_TPTTR - real(FEKi), dimension(21) , intent(in) :: A21 - real(FEKi), dimension(6,6), intent(out) :: M66 - integer :: j - M66 = 0.0_ReKi - ! Reconstruct from sparse elements - CALL LAPACK_TPTTR('U',6,A21,M66,6, ErrStat, ErrMsg) - ! Ensuring symmetry - do j=1,6 - M66(j,j) = M66(j,j)/2 - enddo - M66=M66+TRANSPOSE(M66) - END SUBROUTINE Array21_to_6by6 -END SUBROUTINE InsertSoilMatrices - -!------------------------------------------------------------------------------------------------------ -!> Find closest node index to a point, returns distance as well -SUBROUTINE FindClosestNodes(Point, Nodes, iNode, Dist) - real(ReKi), dimension(3), intent(IN ) :: Point !< Point coordinates - real(ReKi), dimension(:,:), intent(IN ) :: Nodes !< List of nodes, Positions are in columns 2-4... - integer(IntKi), intent( OUT) :: iNode !< Index of closest node - real(ReKi), intent( OUT) :: Dist !< Distance from Point to node iNode - integer(IntKi) :: I - real(ReKi) :: min_dist, loc_dist - ! - min_dist=999999._ReKi - iNode=-1 - do i = 1, size(Nodes,1) - loc_dist = sqrt((Point(1) - Nodes(i,2))**2 + (Point(2) - Nodes(i,3))**2+ (Point(3) - Nodes(i,4))**2) - if (loc_dist Build transformation matrix T, such that x= T.x~ where x~ is the reduced vector of DOF -SUBROUTINE BuildTMatrix(Init, p, RA, RAm1, Tred, ErrStat, ErrMsg) - use IntegerList, only: init_list, find, pop, destroy_list, len - use IntegerList, only: print_list - TYPE(SD_InitType), INTENT(INOUT) :: Init - TYPE(SD_ParameterType),target,INTENT(INOUT) :: p - type(IList), dimension(:), INTENT(IN ) :: RA !< RA(a) = [e1,..,en] list of elements forming a rigid link assembly - integer(IntKi), dimension(:), INTENT(IN ) :: RAm1 !< RA^-1(e) = a , for a given element give the index of a rigid assembly - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - real(FEKi), dimension(:,:), allocatable :: Tred !< Transformation matrix for DOF elimination - ! Local - real(ReKi), dimension(:,:), allocatable :: Tc - integer(IntKi), dimension(:), allocatable :: INodesID !< List of unique nodes involved in Elements - integer(IntKi), dimension(:), allocatable :: IDOFOld !< - integer(IntKi), dimension(:), pointer :: IDOFNew !< - real(ReKi), dimension(6,6) :: I6 !< Identity matrix of size 6 - integer(IntKi) :: iPrev - type(IList) :: IRA !< list of rigid assembly indices to process - integer(IntKi) :: aID, ia ! assembly ID, and index in IRA - integer(IntKi) :: iNode - integer(IntKi) :: er !< Index of one rigid element belong to a rigid assembly - integer(IntKi) :: JType - integer(IntKi) :: I - integer(IntKi) :: nc !< Number of DOF after constraints applied - integer(IntKi) :: nj - real(ReKi) :: phat(3) !< Directional vector of the joint - type(IList), dimension(:), allocatable :: RA_DOFred ! DOF indices for each rigid assembly, in reduced system - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - ErrStat = ErrID_None - ErrMsg = "" - - ! --- Misc inits - nullify(IDOFNew) - I6(1:6,1:6)=0; do i = 1,6 ; I6(i,i)=1_ReKi; enddo ! I6 = eye(6) - allocate(p%NodesDOFred(1:p%nNodes), stat=ErrStat2); if(Failed()) return; ! Indices of DOF for each joint, in reduced system - allocate(RA_DOFred(1:size(RA)), stat=ErrStat2); if(Failed()) return; ! Indices of DOF for each rigid assmbly, in reduced system - - p%nDOF_red = nDOF_ConstraintReduced() - p%reduced = reductionNeeded() ! True if reduction needed, allow for optimization if not needed - - if (DEV_VERSION) then - print*,'nDOF constraint elim', p%nDOF_red , '/' , p%nDOF - endif - CALL AllocAry( Tred, p%nDOF, p%nDOF_red, 'p%T_red', ErrStat2, ErrMsg2); if(Failed()) return; ! system stiffness matrix - Tred=0 - call init_list(IRA, size(RA), 0, ErrStat2, ErrMsg2); if(Failed()) return; - IRA%List(1:size(RA)) = (/(ia , ia = 1,size(RA))/) - if (DEV_VERSION) then - call print_list(IRA, 'List of RA indices') - endif - - ! --- For each node: - ! - create list of indices I in the assembled vector of DOF - ! - create list of indices Itilde in the reduced vector of DOF - ! - increment iPrev by the number of DOF of Itilde - iPrev =0 - do iNode = 1, p%nNodes - if (allocated(Tc)) deallocate(Tc) - if (allocated(IDOFOld)) deallocate(IDOFOld) - JType = int(Init%Nodes(iNode,iJointType)) - if(JType == idJointCantilever ) then - if ( NodeHasRigidElem(iNode, Init, p, er)) then - ! --- Joint involved in a rigid link assembly - aID = RAm1(er) - if (aID<0) then - call Fatal('No rigid assembly attributed to node'//trim(Num2LStr(iNode))//'. RAm1 wrong'); return - endif - ia = find(IRA, aID, ErrStat2, ErrMsg2); if(Failed()) return - if (DEV_VERSION) then - print*,'Node',iNode, 'is involved in RA:', aID, '. Index in list of RA to process', ia - endif - if ( ia <= 0) then - ! This rigid assembly has already been processed - ! OLD: The DOF list is taken from the stored RA DOF list - ! call init_list(p%NodesDOFred(iNode), RA_DOFred(aID)%List, ErrStat2, ErrMsg2) - ! NEW: this node has no DOFs - call init_list(p%NodesDOFred(iNode), 0, 0, ErrStat2, ErrMsg2) - if (DEV_VERSION) then - print*,'The RA',aID,', has already been processed!' - print*,'N',iNode,'I ',p%NodesDOF(iNode)%List(1:6) - print*,'N',iNode,'It',RA_DOFred(aID)%List - endif - cycle ! We pass to the next joint - else - call RAElimination( RA(aID)%List, Tc, INodesID, Init, p, ErrStat2, ErrMsg2); if(Failed()) return; - aID = pop(IRA, ia, ErrStat2, ErrMsg2) ! this assembly has been processed - nj = size(INodesID) - allocate(IDOFOld(1:6*nj)) - do I=1, nj - IDOFOld( (I-1)*6+1 : I*6 ) = p%NodesDOF(INodesID(I))%List(1:6) - enddo - - ! Storing DOF list for this RA (Note: same as NodesDOFred below) - nc=size(Tc,2) - call init_list(RA_DOFred(aID), (/ (iprev + i, i=1,nc) /), ErrStat2, ErrMsg2); - - endif - else - ! --- Regular cantilever joint - ! TODO/NOTE: We could apply fixed constraint/BC here, returning Tc as a 6xn matrix with n<6 - ! Extreme case would be Tc: 6*0, in which case NodesDOFred would be empty ([]) - allocate(Tc(1:6,1:6)) - allocate(IDOFOld(1:6)) - Tc=I6 - IDOFOld = p%NodesDOF(iNode)%List(1:6) - endif - else - ! --- Ball/Pin/Universal joint - allocate(IDOFOld(1:len(p%NodesDOF(iNode)))) - IDOFOld(:) = p%NodesDOF(iNode)%List(:) - phat = Init%Nodes(iNode, iJointDir:iJointDir+2) - call JointElimination(Init%NodesConnE(iNode,:), JType, phat, p, Tc, ErrStat2, ErrMsg2); if(Failed()) return - endif - nc=size(Tc,2) - call init_list(p%NodesDOFred(iNode), nc, 0, ErrStat2, ErrMsg2) - p%NodesDOFred(iNode)%List(1:nc) = (/ (iprev + i, i=1,nc) /) - IDOFNew => p%NodesDOFred(iNode)%List(1:nc) ! alias to shorten notations - !print*,'N',iNode,'I ',IDOFOld - !print*,'N',iNode,'It',IDOFNew - Tred(IDOFOld, IDOFNew) = Tc - iPrev = iPrev + nc - enddo - ! --- Safety checks - if (len(IRA)>0) then - call Fatal('Not all rigid assemblies were processed'); return - endif - if (iPrev /= p%nDOF_red) then - call Fatal('Inconsistency in number of reduced DOF'); return - endif - call CleanUp_BuildTMatrix() -contains - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'BuildTMatrix') - Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp_BuildTMatrix() - END FUNCTION Failed - - SUBROUTINE Fatal(ErrMsg_in) - CHARACTER(len=*), intent(in) :: ErrMsg_in - CALL SetErrStat(ErrID_Fatal, ErrMsg_in, ErrStat, ErrMsg, 'BuildTMatrix'); - END SUBROUTINE Fatal - - SUBROUTINE CleanUp_BuildTMatrix() - nullify(IDOFNew) - call destroy_list(IRA, ErrStat2, ErrMsg2) - if (allocated(Tc) ) deallocate(Tc) - if (allocated(IDOFOld)) deallocate(IDOFOld) - if (allocated(INodesID)) deallocate(INodesID) - if (allocated(RA_DOFred)) deallocate(RA_DOFred) - END SUBROUTINE CleanUp_BuildTMatrix - - !> Returns number of DOF after constraint reduction (via the matrix T) - INTEGER(IntKi) FUNCTION nDOF_ConstraintReduced() - integer(IntKi) :: iNode - integer(IntKi) :: ia ! Index on rigid link assembly - integer(IntKi) :: m ! Number of elements connected to a joint - integer(IntKi) :: NodeType - nDOF_ConstraintReduced = 0 - - ! Rigid assemblies contribution - nDOF_ConstraintReduced = nDOF_ConstraintReduced + 6*size(RA) - - ! Contribution from all the other joints - do iNode = 1, p%nNodes - m = Init%NodesConnE(iNode,1) ! Col1: number of elements connected to this joint - NodeType = Init%Nodes(iNode,iJointType) - - if (NodeType == idJointPin ) then - nDOF_ConstraintReduced = nDOF_ConstraintReduced + 5 + 1*m - print*,'Node',iNode, 'is a pin joint, number of members involved: ', m - - elseif(NodeType == idJointUniversal ) then - nDOF_ConstraintReduced = nDOF_ConstraintReduced + 4 + 2*m - print*,'Node',iNode, 'is an universal joint, number of members involved: ', m - - elseif(NodeType == idJointBall ) then - nDOF_ConstraintReduced = nDOF_ConstraintReduced + 3 + 3*m - print*,'Node',iNode, 'is a ball joint, number of members involved: ', m - - elseif(NodeType == idJointCantilever ) then - if ( NodeHasRigidElem(iNode, Init, p, er)) then - ! This joint is involved in a rigid link assembly, we skip it (accounted for above) - print*,'Node',iNode, 'is involved in a Rigid assembly' - else - ! That's a regular Cantilever joint - nDOF_ConstraintReduced = nDOF_ConstraintReduced + 6 - !print*,'Node',iNode, 'is a regular cantilever' - endif - else - ErrMsg='Wrong joint type'; ErrStat=ErrID_Fatal - endif - end do - END FUNCTION nDOF_ConstraintReduced - - !> return true if reduction needed (i.e. special joints, special elements) - logical FUNCTION reductionNeeded() - integer(IntKi) :: i - integer(IntKi) :: myType - reductionNeeded=.false. - ! Rigid or cable links - do i =1,size(p%Elems,1) - myType = p%Elems(i, iMType) - if (any((/idMemberCable, idMemberRigid/)==myType)) then - reductionNeeded=.true. - return - endif - enddo - ! Special joints - do i = 1, p%nNodes - myType = Init%Nodes(i,iJointType) - if (any((/idJointPin, idJointUniversal, idJointBall/)==myType)) then - reductionNeeded=.true. - return - endif - enddo - end FUNCTION reductionNeeded - -END SUBROUTINE BuildTMatrix -!------------------------------------------------------------------------------------------------------ -!> Assemble stiffness and mass matrix, and gravity force vector -SUBROUTINE DirectElimination(Init, p, ErrStat, ErrMsg) - use NWTC_LAPACK, only: LAPACK_GEMM - use IntegerList, only: len - TYPE(SD_InitType), INTENT(INOUT) :: Init - TYPE(SD_ParameterType),target,INTENT(INOUT) :: p - 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 - CHARACTER(ErrMsgLen) :: ErrMsg2 - ! Varaibles for rigid assembly - type(IList), dimension(:), allocatable :: RA !< RA(a) = [e1,..,en] list of elements forming a rigid link assembly - integer(IntKi), dimension(:), allocatable :: RAm1 !< RA^-1(e) = a , for a given element give the index of a rigid assembly - real(FEKi), dimension(:,:), allocatable :: MM, KK - real(FEKi), dimension(:,:), allocatable :: Temp - integer(IntKi) :: nDOF, iDOF, nDOFPerNode, iNode, iiDOF, i,j - ErrStat = ErrID_None - ErrMsg = "" - - ! Setup list of rigid link assemblies (RA) and the inverse function RA^{-1} - call RigidLinkAssemblies(Init, p, RA, RAm1, ErrStat2, ErrMsg2); if(Failed()) return - call BuildTMatrix(Init, p, RA, RAm1, p%T_red, ErrStat2, ErrMsg2); if (Failed()) return - if (allocated(RAm1)) deallocate(RAm1) - if (allocated(RA )) deallocate(RA ) - - ! --- DOF elimination for system matrices and RHS vector - nDOF = p%nDOF_red - if (p%reduced) then - ! Temporary backup of M and K of full system - call move_alloc(Init%M, MM) - call move_alloc(Init%K, KK) - ! Reallocating - CALL AllocAry( Init%K, nDOF, nDOF, 'Init%K' , ErrStat2, ErrMsg2); if(Failed()) return; ! system stiffness matrix - CALL AllocAry( Init%M, nDOF, nDOF, 'Init%M' , ErrStat2, ErrMsg2); if(Failed()) return; ! system mass matrix - CALL AllocAry( Temp ,size(MM,1), nDOF, 'Temp' , ErrStat2, ErrMsg2); if(Failed()) return; - CALL AllocAry( p%T_red_T,nDOF , size(MM,1), 'T_red_T' , ErrStat2, ErrMsg2); if(Failed()) return; - ! --- Elimination (stack expensive) - !Init%M = matmul(transpose(p%T_red), matmul(MM, p%T_red)) - !Init%K = matmul(transpose(p%T_red), matmul(KK, p%T_red)) - !p%T_red_T = transpose(p%T_red) - do i = 1, size(p%T_red,1) - do j = 1, size(p%T_red,2) - p%T_red_T(j,i) = p%T_red(i,j) - enddo - enddo - !Temp = matmul(MM, p%T_red) - CALL LAPACK_gemm( 'N', 'N', 1.0_FeKi, MM , p%T_red, 0.0_FeKi, Temp , ErrStat2, ErrMsg2); if(Failed()) return - !Init%M = matmul(p%T_red_T, Temp) - CALL LAPACK_gemm( 'T', 'N', 1.0_FeKi, p%T_red, Temp , 0.0_FeKi, Init%M, ErrStat2, ErrMsg2); if(Failed()) return - !Temp = matmul(KK, p%T_red) - CALL LAPACK_gemm( 'N', 'N', 1.0_FeKi, KK , p%T_red, 0.0_FeKi, Temp , ErrStat2, ErrMsg2); if(Failed()) return - !Init%K = matmul(p%T_red_T, Temp) - CALL LAPACK_gemm( 'T', 'N', 1.0_FeKi, p%T_red, Temp , 0.0_FeKi, Init%K, ErrStat2, ErrMsg2); if(Failed()) return - if (allocated(Temp)) deallocate(Temp) - endif - !CALL AllocAry( Init%D, nDOF, nDOF, 'Init%D' , ErrStat2, ErrMsg2); if(Failed()) return; ! system damping matrix - !Init%D = 0 !< Used for additional damping - - ! --- Creating a convenient Map from DOF to Nodes - call AllocAry(p%DOFred2Nodes, p%nDOF_red, 3, 'DOFred2Nodes', ErrStat2, ErrMsg2); if(Failed()) return; - p%DOFred2Nodes=-999 - do iNode=1,p%nNodes - nDOFPerNode = len(p%NodesDOFred(iNode)) - do iiDOF = 1, nDOFPerNode - iDOF = p%NodesDOFred(iNode)%List(iiDOF) - p%DOFred2Nodes(iDOF,1) = iNode ! First column is Node index - p%DOFred2Nodes(iDOF,2) = nDOFPerNode ! Second column is number of DOF per node - p%DOFred2Nodes(iDOF,3) = iiDOF ! Third column is number of DOF per node - enddo - enddo - - call CleanUp_DirectElimination() - -CONTAINS - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'DirectElimination') - Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp_DirectElimination() - END FUNCTION Failed - SUBROUTINE CleanUp_DirectElimination() - ! Cleaning up memory - if (allocated(MM )) deallocate(MM ) - if (allocated(KK )) deallocate(KK ) - if (allocated(RA )) deallocate(RA ) - if (allocated(RAm1)) deallocate(RAm1) - if (allocated(Temp)) deallocate(Temp) - END SUBROUTINE CleanUp_DirectElimination -END SUBROUTINE DirectElimination - -!------------------------------------------------------------------------------------------------------ -!> Returns constraint matrix Tc for a rigid assembly (RA) formed by a set of elements. -!! x_c = Tc.x_c_tilde -!! where x_c are all the DOF of the rigid assembly, and x_c_tilde are the 6 reduced DOF (leader DOF) -SUBROUTINE RAElimination(Elements, Tc, INodesID, Init, p, ErrStat, ErrMsg) - use IntegerList, only: init_list, len, append, print_list, pop, destroy_list, get, unique, find - integer(IntKi), dimension(:), INTENT(IN ) :: Elements !< List of elements - real(ReKi), dimension(:,:), allocatable :: Tc - integer(IntKi), dimension(:), allocatable :: INodesID !< List of unique nodes involved in Elements - TYPE(SD_InitType), INTENT(IN ) :: Init - TYPE(SD_ParameterType), INTENT(IN ) :: p - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - ! Local variables - type(IList) :: LNodesID !< List of nodes id involved in element - type(IList) :: LNodesInterf !< List of nodes id involved in interface - integer(IntKi) :: NodeID !< NodeID - integer(IntKi) :: iTmp !< Temporary index - integer(IntKi) :: iNodeID !< Loop index on node ID list - integer(IntKi) :: iiMainNode !< Index of main node selected for rigid assembly within INodesID list - integer(IntKi) :: iMainNode !< Main node index - integer(IntKi) :: nNodes !< Number of Nodes involved in RA - integer(IntKi) :: iFound !< Loop index on node ID list - integer(IntKi) :: i !< Loop index - real(ReKi) :: TRigid(6,6) ! Transformation matrix such that xi = T.x1 - real(ReKi) :: P1(3), Pi(3) ! Nodal points - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - ErrStat = ErrID_None - ErrMsg = "" - - ! --- List of nodes stored first in LINodes than moved to INodes - LNodesID = NodesList(p, Elements) - if (DEV_VERSION) then - print*,'Nodes involved in assembly (bfr1) ',LNodesID%List - endif - call unique(LNodesID, ErrStat2, ErrMsg2); - if (DEV_VERSION) then - print*,'Nodes involved in assembly (bfr2) ',LNodesID%List - endif - - !--- Look for potential interface node - call init_list(LNodesInterf, 0, 0, ErrStat2, ErrMsg2); - do iNodeID = 1, len(LNodesID) - NodeID = LNodesID%List(iNodeID) - iFound = FINDLOCI( p%Nodes_I(:,1), NodeID) - if (iFound>0) then - call append(LNodesInterf, NodeID, ErrStat2, ErrMsg2) - ! This node is an interface node - print*,'Node',NodeID, 'is an interface node, selecting it for the rigid assembly' - endif - enddo - - ! --- Decide which node will be the main node of the rigid assembly - if (len(LNodesInterf)==0) then - iiMainNode = 1 ! By default we select the first node - else if (len(LNodesInterf)==1) then - ! Finding the index of the interface node - iMainNode = pop(LNodesInterf, ErrStat2, ErrMsg2) - iiMainNode = find(LNodesID, iMainNode, ErrStat2, ErrMsg2); - else - ErrStat=ErrID_Fatal - ErrMsg='Cannot have several interface nodes linked within a same rigid assembly' - return - endif - call destroy_list(LNodesInterf, ErrStat2, ErrMsg2) - - ! --- Extracting index array from list - if (allocated(INodesID)) deallocate(INodesID) - call move_alloc(LNodesID%List, INodesID) - call destroy_list(LNodesID, ErrStat2, ErrMsg2) - - ! --- Order list of joints with main node first (swapping iMainNode with INodes(1)) - iTmp = INodesID(1) - INodesID(1) = INodesID(iiMainNode) - INodesID(iiMainNode) = iTmp - if (DEV_VERSION) then - print*,'Nodes involved in assembly (after)',INodesID - endif - - ! --- Building Transformation matrix - nNodes =size(INodesID) - allocate(Tc(6*nNodes,6)) - Tc(:,:)=0 - ! I6 for first node - do i = 1,6 ; Tc(i,i)=1_ReKi; enddo ! I6 = eye(6) - ! Rigid transformation matrix for the other nodes - P1 = Init%Nodes(INodesID(1), 2:4) ! reference node coordinates - do i = 2, nNodes - Pi = Init%Nodes(INodesID(i), 2:4) ! follower node coordinates - call GetRigidTransformation(P1, Pi, TRigid, ErrStat2, ErrMsg2) - Tc( ((i-1)*6)+1:6*i, 1:6) = TRigid(1:6,1:6) - enddo -END SUBROUTINE RAElimination -!------------------------------------------------------------------------------------------------------ -!> Returns constraint matrix Tc for a joint involving several Elements -!! x_c = Tc.x_c_tilde -!! where -! x_c are all the DOF of the joint (3 translation + 3*m, m the number of elements) -! x_c_tilde are the nc reduced DOF -SUBROUTINE JointElimination(Elements, JType, phat, p, Tc, ErrStat, ErrMsg) - use IntegerList, only: init_list, len, append, print_list, pop, destroy_list, get - integer(IntKi), dimension(:), INTENT(IN ) :: Elements !< List of elements involved at a joint - integer(IntKi), INTENT(IN ) :: JType !< Joint type - real(ReKi), INTENT(IN ) :: phat(3) !< Directional vector of the joint - TYPE(SD_ParameterType), INTENT(IN ) :: p - real(ReKi), dimension(:,:), allocatable :: Tc !< Transformation matrix from eliminated to full - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - ! Local variables - !type(IList) :: I !< List of indices for Nodes involved in interface - integer(IntKi) :: i, j, ie, ne !< Loop index - integer(IntKi) :: nDOFr !< Number of reduced DOF - integer(IntKi) :: nDOFt !< Number of total DOF *nreduced) - real(ReKi) :: e1(3), e2(3), e3(3) ! forming orthonormal basis with phat - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - real(FEKi), dimension(:,:), allocatable :: Tc_rot !< Part of Tc just for rotational DOF - real(FEKi), dimension(:,:), allocatable :: Tc_rot_m1 !< Inverse of Tc_rot - real(ReKi) :: ColMean - ErrStat = ErrID_None - ErrMsg = "" - - ne = Elements(1) ! TODO TODO - nDOFt = 3 + 3*ne - - ! The elements already share the same translational DOF - - if (JType == idJointPin ) then - nDOFr = 5 + 1*ne - allocate(Tc (nDOFt, nDOFr)); - allocate(Tc_rot_m1(nDOFr-3, nDOFt-3)); - Tc(:,:)=0 - Tc_rot_m1(:,:)=0 - - ! Normalizing - e3= phat/sqrt(phat(1)**2 + phat(2)**2 + phat(3)**2) - call GetOrthVectors(e3, e1, e2, ErrStat2, ErrMsg2); - ! Forming Tcm1, inverse of Tc - do ie=1,ne - Tc_rot_m1(1 , (ie-1)*3+1:ie*3 ) = e1(1:3)/ne - Tc_rot_m1(2 , (ie-1)*3+1:ie*3 ) = e2(1:3)/ne - Tc_rot_m1(ie+2, (ie-1)*3+1:ie*3 ) = e3(1:3) - enddo - ! Pseudo inverse: - call PseudoInverse(Tc_rot_m1, Tc_rot, ErrStat2, ErrMsg2) - ! --- Forming Tc - do i = 1,3 ; Tc(i,i)=1_ReKi; enddo ! I3 for translational DOF - Tc(4:nDOFt,4:nDOFr)=Tc_rot(1:nDOFt-3, 1:nDOFr-3) - do i = 1,size(Tc,1); do ie = 1,size(Tc,2) - if (abs(Tc(i,ie))<1e-13) then - Tc(i,ie)=0.0_ReKi - endif; enddo; - enddo; - deallocate(Tc_rot) - deallocate(Tc_rot_m1) - - elseif(JType == idJointUniversal ) then - if (ne/=2) then - ErrMsg='JointElimination: universal joints should only connect two elements.'; ErrStat=ErrID_Fatal - return - endif - nDOFr = 4 + 2*ne - allocate(Tc(nDOFt, nDOFr)); - allocate(Tc_rot_m1(nDOFr-3, nDOFt-3)); - Tc(:,:)=0 - Tc_rot_m1(:,:)=0 ! Important init - ! Forming the inverse of Tc_rot - Tc_rot_m1(1,1:3) = p%ElemProps(Elements(1))%DirCos(:,3)/2._ReKi - Tc_rot_m1(1,4:6) = p%ElemProps(Elements(2))%DirCos(:,3)/2._ReKi - Tc_rot_m1(2,1:3) = p%ElemProps(Elements(1))%DirCos(:,1) - Tc_rot_m1(3,1:3) = p%ElemProps(Elements(1))%DirCos(:,2) - Tc_rot_m1(4,4:6) = p%ElemProps(Elements(2))%DirCos(:,1) - Tc_rot_m1(5,4:6) = p%ElemProps(Elements(2))%DirCos(:,2) - ! Pseudo inverse - call PseudoInverse(Tc_rot_m1, Tc_rot, ErrStat2, ErrMsg2) - ! --- Forming Tc - do i = 1,3 ; Tc(i,i)=1_ReKi; enddo ! I3 for translational DOF - Tc(4:nDOFt,4:nDOFr)=Tc_rot(1:nDOFt-3, 1:nDOFr-3) - deallocate(Tc_rot) - deallocate(Tc_rot_m1) - - elseif(JType == idJointBall ) then - nDOFr = 3 + 3*ne - allocate(Tc(nDOFt, nDOFr)); - Tc(:,:)=0 - do i = 1,3 ; Tc(i,i)=1_ReKi; enddo ! I3 for translational DOF - do i = 3,nDOFr; Tc(i,i)=1_ReKi; enddo ! Identity for other DOF as well - - else - ErrMsg='JointElimination: Wrong joint type'; ErrStat=ErrID_Fatal - endif - !do i=1,nDOFt - ! print*,'Tc',Tc(i,:) - !enddo - ! --- Safety check - do j =1, size(Tc,2) - ColMean=0; do i=1,size(Tc,1) ; ColMean = ColMean + abs(Tc(i,j)); enddo - ColMean = ColMean/size(Tc,1) - if (ColMean<1e-6) then - ErrMsg='JointElimination: a reduced degree of freedom has a singular mapping.'; ErrStat=ErrID_Fatal - return - endif - enddo - -END SUBROUTINE JointElimination - -!------------------------------------------------------------------------------------------------------ -!> Setup a list of rigid link assemblies (RA) -!! RA(a) = [e1,..,en] : list of elements that form the rigid assembly of index "a" -SUBROUTINE RigidLinkAssemblies(Init, p, RA, RAm1, ErrStat, ErrMsg) - use IntegerList, only: init_list, len, append, print_list, pop, destroy_list, get - TYPE(SD_InitType), INTENT(INOUT) :: Init - TYPE(SD_ParameterType), INTENT(INOUT) :: p - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - type(IList), dimension(:), allocatable :: RA !< RA(a) = [e1,..,en] list of elements forming a rigid link assembly - integer(IntKi), dimension(:), allocatable :: RAm1 !< RA^-1(e) = a , for a given element give the index of a rigid assembly - ! Local variables - type(IList) :: Er !< List of rigid elements - type(IList) :: Ea !< List of elements in a rigid assembly - integer(IntKi) :: nRA !< Number of rigid assemblies - integer(IntKi) :: ie !< Index on elements - integer(IntKi) :: ia !< Index on assemblies - integer(IntKi) :: e0 !< Index of an element - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - ErrStat = ErrID_None - ErrMsg = "" - allocate(RAm1(1:Init%NElem)) - RAm1(1:Init%NElem) = -1 - - ! --- Establish a list of rigid link elements - Er = RigidLinkElements(Init, p, ErrStat2, ErrMsg2) - nRA=0 - do while (len(Er)>0) - nRA=nRA+1 - ! Creating List Ea of elements of a given assembly - call init_list(Ea, 0, 0, ErrStat2, ErrMsg2); - e0 = pop(Er, ErrStat2, ErrMsg2); - call append(Ea, e0, ErrStat2, ErrMsg2); - call AddNeighbors(e0, Er, Ea) - if (DEV_VERSION) then - call print_list(Ea,'Rigid assembly (loop 1)') - endif - do ie = 1, len(Ea) - e0 = get(Ea, ie, ErrStat2, ErrMsg2) - RAm1(e0) = nRA ! Index of rigid assembly that this element belongs to - enddo - call destroy_list(Ea, ErrStat2, ErrMsg2) - enddo - call destroy_list(Er, ErrStat2, ErrMsg2) - - ! --- Creating RA, array of lists of assembly elements. - ! Note: exactly the same as all the Ea created above, but we didn't know the total number of RA - allocate(RA(1:nRA)) - do ia = 1, nRA - call init_list(RA(ia), 0, 0, ErrStat2, ErrMsg2) - enddo - do ie = 1, Init%NElem - ia = RAm1(ie) ! Index of the assembly the element belongs to: RA^{-1}(ie) = ia - if (ia>0) then - call append(RA(ia), ie, ErrStat2, ErrMsg2) - endif - enddo - if (DEV_VERSION) then - do ia = 1, nRA - call print_list(RA(ia),'Rigid assembly (loop 2)') - enddo - endif -CONTAINS - !> The neighbor-elements of element e0 (that are found within the list Er) are added to the list Ea - RECURSIVE SUBROUTINE AddNeighbors(e0, Er, Ea) - integer(IntKi), intent(in) :: e0 !< Index of an element - type(IList), intent(inout) :: Er !< List of rigid elements - type(IList), intent(inout) :: Ea !< List of elements in a rigid assembly - type(IList) :: En !< List of neighbors of e0 - integer (IntKi) :: ik - integer (IntKi) :: ek, ek2 - integer (IntKi) :: iWhichNode_e0, iWhichNode_ek - call init_list(En, 0, 0, ErrStat2, ErrMsg2) - ! Loop through all elements, setup list of e0-neighbors, add them to Ea, remove them from Er - ik=0 - do while (ik< len(Er)) - ik=ik+1 - ek = Er%List(ik) - if (ElementsConnected(p, e0, ek, iWhichNode_e0, iWhichNode_ek)) then - if (DEV_VERSION) then - print*,'Element ',ek,'is connected to element',e0,'via its node',iWhichNode_ek - endif - ! Remove element from Er (a rigid element can belong to only one assembly) - ek2 = pop(Er, ik, ErrStat2, ErrMsg2) ! same as ek before - ik=ik-1 - if (ek/=ek2) then - print*,'Problem in popping',ek,ek2 - STOP - endif - call append(En, ek, ErrStat2, ErrMsg2) - call append(Ea, ek, ErrStat2, ErrMsg2) - endif - enddo - ! Loop through neighbors and recursively add neighbors of neighbors - do ik = 1, len(En) - ek = En%List(ik) - call AddNeighbors(ek, Er, Ea) - enddo - call destroy_list(En, ErrStat2, ErrMsg2) - END SUBROUTINE AddNeighbors - -END SUBROUTINE RigidLinkAssemblies - - -!------------------------------------------------------------------------------------------------------ -!> Add stiffness and damping to some joints -!! NOTE: damping was removed around 13/07/2020 -SUBROUTINE InsertJointStiffDamp(p, Init, ErrStat, ErrMsg) - TYPE(SD_ParameterType),target,INTENT(IN ) :: p - TYPE(SD_InitType), INTENT(INOUT) :: Init - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! Local variables - integer(IntKi) :: iNode, JType, iStart, i - integer(IntKi) :: nFreeRot ! Number of free rot DOF - integer(IntKi) :: nMembers ! Number of members attached to this node - integer(IntKi) :: nSpace ! Number of spaces between diagonal "bands" (0:pin, 1:univ, 2:ball) - real(ReKi) :: StifAdd - real(ReKi), dimension(:,:), allocatable :: K_Add ! Stiffness matrix added to global system - integer(IntKi), dimension(:), pointer :: Ifreerot - ErrStat = ErrID_None - ErrMsg = "" - do iNode = 1, p%nNodes - JType = int(Init%Nodes(iNode,iJointType)) - StifAdd = Init%Nodes(iNode, iJointStiff) - if(JType == idJointCantilever ) then - ! Cantilever joints should not have damping or stiffness - if(StifAdd>0) then - ErrMsg='InsertJointStiffDamp: Additional stiffness should be 0 for cantilever joints. Index of problematic node: '//trim(Num2LStr(iNode)); ErrStat=ErrID_Fatal; - return - endif - else - ! Ball/Univ/Pin joints have damping/stiffness inserted at indices of "free rotation" - nMembers = Init%NodesConnE(iNode,1) ! Col1: number of elements connected to this joint - if ( JType == idJointBall ) then; iStart=4; nSpace=2; - else if ( JType == idJointUniversal ) then; iStart=5; nSpace=1; - else if ( JType == idJointPin ) then; iStart=6; nSpace=0; - endif - Ifreerot=>p%NodesDOFred(iNode)%List(iStart:) - nFreeRot = size(Ifreerot) - ! Creating matrices of 0, and -K and nK on diagonals - allocate(K_Add(1:nFreeRot,1:nFreeRot)); - call ChessBoard(K_Add, -StifAdd, 0._ReKi, nSpace=nSpace, diagVal=(nMembers-1)*StifAdd) - ! Ball/Pin/Universal joints - if(StifAdd>0) then - !print*,'Stiffness Add, Node:',iNode,'DOF:', Ifreerot - !do i=1,nFreeRot - ! print*,'K Add',K_Add(i,:) - !enddo - Init%K(Ifreerot,Ifreerot) = Init%K(Ifreerot,Ifreerot) + K_Add - endif - if(allocated(K_Add)) deallocate(K_Add) - endif - enddo -END SUBROUTINE InsertJointStiffDamp - -!> Returns true if the substructure can be considered "fixed bottom" -LOGICAL FUNCTION isFixedBottom(Init, p) - TYPE(SD_InitType), INTENT(IN ) :: Init - TYPE(SD_ParameterType),INTENT(IN ) :: p - isFixedBottom=.not.isFloating(Init,p) - !INTEGER(IntKi) :: i, nFixed - !nFixed=0 - !do i =1,size(p%Nodes_C,1) - ! if (ALL(p%Nodes_C(I,2:7)==idBC_Fixed)) then - ! nFixed=nFixed+1 - ! elseif (Init%SSIfile(I)/='') then - ! nFixed=nFixed+1 - ! endif - !enddo - !bFixed = nFixed >=1 -END FUNCTION isFixedBottom - -!> True if a structure is floating, no fixed BC at the bottom -logical function isFloating(Init, p) - type(SD_InitType), intent(in ):: Init - type(SD_ParameterType),intent(in ) :: p - integer(IntKi) :: i - !isFloating=size(p%Nodes_C)>0 - isFloating=.True. - do i =1,size(p%Nodes_C,1) - if ((all(p%Nodes_C(I,2:7)==idBC_Internal)) .and. (Init%SSIfile(i)=='')) then - continue - else - isFloating=.False. - return - endif - enddo -end function isFloating - -SUBROUTINE ElemM(ep, Me) - TYPE(ElemPropType), INTENT(IN) :: eP !< Element Property - REAL(FEKi), INTENT(OUT) :: Me(12, 12) - REAL(FEKi) :: L0, Eps0 - if (ep%eType==idMemberBeam) then - !Calculate Ke, Me to be used for output - CALL ElemM_Beam(eP%Area, eP%Length, eP%Ixx, eP%Iyy, eP%Jzz, eP%rho, eP%DirCos, Me) - - else if (ep%eType==idMemberCable) then - Eps0 = ep%T0/(ep%YoungE*ep%Area) - L0 = ep%Length/(1+Eps0) ! "rest length" for which pretension would be 0 - CALL ElemM_Cable(ep%Area, L0, ep%rho, ep%DirCos, Me) - - else if (ep%eType==idMemberRigid) then - if ( EqualRealNos(eP%rho, 0.0_ReKi) ) then - Me=0.0_FEKi - else - CALL ElemM_Cable(ep%Area, real(ep%Length,FEKi), ep%rho, ep%DirCos, Me) - !CALL ElemM_(A, L, rho, DirCos, Me) - endif - endif -END SUBROUTINE ElemM - -SUBROUTINE ElemK(ep, Ke) - TYPE(ElemPropType), INTENT(IN) :: eP !< Element Property - REAL(FEKi), INTENT(OUT) :: Ke(12, 12) - - if (ep%eType==idMemberBeam) then - CALL ElemK_Beam( eP%Area, eP%Length, eP%Ixx, eP%Iyy, eP%Jzz, eP%Shear, eP%kappa, eP%YoungE, eP%ShearG, eP%DirCos, Ke) - - else if (ep%eType==idMemberCable) then - CALL ElemK_Cable(ep%Area, ep%Length, ep%YoungE, ep%T0, eP%DirCos, Ke) - - else if (ep%eType==idMemberRigid) then - Ke = 0.0_FEKi - endif -END SUBROUTINE ElemK - -SUBROUTINE ElemF(ep, gravity, Fg, Fo) - TYPE(ElemPropType), INTENT(IN) :: eP !< Element Property - REAL(ReKi), INTENT(IN) :: gravity !< acceleration of gravity - REAL(FEKi), INTENT(OUT) :: Fg(12) - REAL(FEKi), INTENT(OUT) :: Fo(12) - if (ep%eType==idMemberBeam) then - Fo(1:12)=0.0_FEKi - else if (ep%eType==idMemberCable) then - CALL ElemF_Cable(ep%T0, ep%DirCos, Fo) - else if (ep%eType==idMemberRigid) then - Fo(1:12)=0.0_FEKi - endif - CALL ElemG( eP%Area, eP%Length, eP%rho, eP%DirCos, Fg, gravity ) -END SUBROUTINE ElemF - -END MODULE SD_FEM diff --git a/OpenFAST/modules/subdyn/src/SubDyn.f90 b/OpenFAST/modules/subdyn/src/SubDyn.f90 deleted file mode 100644 index 1c545885b..000000000 --- a/OpenFAST/modules/subdyn/src/SubDyn.f90 +++ /dev/null @@ -1,3799 +0,0 @@ -!.................................................................................................................................. -! LICENSING -! Copyright (C) 2013-2016 National Renewable Energy Laboratory -! -! This file is part of SubDyn. -! -! 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. -! -!********************************************************************************************************************************** -!> SubDyn is a time-domain structural-dynamics module for multi-member fixed-bottom substructures. -!! SubDyn relies on two main engineering schematizations: (1) a linear frame finite-element beam model (LFEB), and -!! (2) a dynamics system reduction via Craig-Bampton's (C-B) method, together with a Static-Improvement method, greatly reducing -!! the number of modes needed to obtain an accurate solution. -Module SubDyn - - USE NWTC_Library - USE SubDyn_Types - USE SubDyn_Output - USE SubDyn_Tests - USE SD_FEM - - IMPLICIT NONE - - PRIVATE - - TYPE(ProgDesc), PARAMETER :: SD_ProgDesc = ProgDesc( 'SubDyn', '', '' ) - - ! ..... Public Subroutines ................................................................................................... - PUBLIC :: SD_Init ! Initialization routine - PUBLIC :: SD_End ! Ending routine (includes clean up) - PUBLIC :: SD_UpdateStates ! Loose coupling routine for solving for constraint states, integrating - PUBLIC :: SD_CalcOutput ! Routine for computing outputs - PUBLIC :: SD_CalcContStateDeriv ! Tight coupling routine for computing derivatives of continuous states - PUBLIC :: SD_JacobianPContState ! - PUBLIC :: SD_JacobianPInput ! - PUBLIC :: SD_JacobianPDiscState ! - PUBLIC :: SD_JacobianPConstrState ! - PUBLIC :: SD_GetOP ! - -CONTAINS - -SUBROUTINE CreateTPMeshes( TP_RefPoint, inputMesh, outputMesh, ErrStat, ErrMsg ) - REAL(ReKi), INTENT( IN ) :: TP_RefPoint(3) - TYPE(MeshType), INTENT( INOUT ) :: inputMesh ! u%TPMesh - TYPE(MeshType), INTENT( INOUT ) :: outputMesh ! y%Y1Mesh - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - ! NOTE: The initialization of the fields for these meshes is to be handled by FAST/Driver - CALL MeshCreate( BlankMesh = inputMesh & - ,IOS = COMPONENT_INPUT & - ,Nnodes = 1 & - ,ErrStat = ErrStat & - ,ErrMess = ErrMsg & - ,TranslationDisp = .TRUE. & - ,Orientation = .TRUE. & - ,TranslationVel = .TRUE. & - ,RotationVel = .TRUE. & - ,TranslationAcc = .TRUE. & - ,RotationAcc = .TRUE. ) - ! Create the node and mesh element, note: assumes identiy matrix as reference orientation - CALL MeshPositionNode (inputMesh, 1, TP_RefPoint, ErrStat, ErrMsg); IF(ErrStat>=AbortErrLev) return - CALL MeshConstructElement(inputMesh, ELEMENT_POINT, ErrStat, ErrMsg, 1) - CALL MeshCommit( inputMesh, ErrStat, ErrMsg); if(ErrStat >= AbortErrLev) return - - ! Create the Transition Piece reference point output mesh as a sibling copy of the input mesh - CALL MeshCopy ( SrcMesh = inputMesh & - ,DestMesh = outputMesh & - ,CtrlCode = MESH_SIBLING & - ,IOS = COMPONENT_OUTPUT & - ,ErrStat = ErrStat & - ,ErrMess = ErrMsg & - ,Force = .TRUE. & - ,Moment = .TRUE. ) -END SUBROUTINE CreateTPMeshes -!--------------------------------------------------------------------------- -!> Create output (Y2, for motion) and input (u, for forces)meshes, based on SubDyn nodes -!! Ordering of nodes is the same as SubDyn (used to be : I L C) -SUBROUTINE CreateInputOutputMeshes( NNode, Nodes, inputMesh, outputMesh, ErrStat, ErrMsg ) - INTEGER(IntKi), INTENT( IN ) :: NNode !total number of nodes in the structure, used to size the array Nodes, i.e. its rows - REAL(ReKi), INTENT( IN ) :: Nodes(NNode, JointsCol) - TYPE(MeshType), INTENT( INOUT ) :: inputMesh ! u%LMesh - TYPE(MeshType), INTENT( INOUT ) :: outputMesh ! y%Y2Mesh - INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! Local variables - REAL(ReKi), dimension(3) :: Point - INTEGER :: I ! generic counter variable - INTEGER :: nodeIndx - - CALL MeshCreate( BlankMesh = inputMesh & - ,IOS = COMPONENT_INPUT & - ,Nnodes = size(Nodes,1) & - ,ErrStat = ErrStat & - ,ErrMess = ErrMsg & - ,Force = .TRUE. & - ,Moment = .TRUE. ) - - DO I = 1,size(Nodes,1) - Point = Nodes(I, 2:4) - CALL MeshPositionNode(inputMesh, I, Point, ErrStat, ErrMsg); IF(ErrStat/=ErrID_None) RETURN - CALL MeshConstructElement(inputMesh, ELEMENT_POINT, ErrStat, ErrMsg, I) - ENDDO - CALL MeshCommit ( inputMesh, ErrStat, ErrMsg); IF(ErrStat/=ErrID_None) RETURN - - ! Create the Interior Points output mesh as a sibling copy of the input mesh - CALL MeshCopy ( SrcMesh = inputMesh & - ,DestMesh = outputMesh & - ,CtrlCode = MESH_SIBLING & - ,IOS = COMPONENT_OUTPUT & - ,ErrStat = ErrStat & - ,ErrMess = ErrMsg & - ,TranslationDisp = .TRUE. & - ,Orientation = .TRUE. & - ,TranslationVel = .TRUE. & - ,RotationVel = .TRUE. & - ,TranslationAcc = .TRUE. & - ,RotationAcc = .TRUE. ) - - ! Set the Orientation (rotational) field for the nodes based on assumed 0 (rotational) deflections - !Identity should mean no rotation, which is our first guess at the output -RRD - CALL Eye( outputMesh%Orientation, ErrStat, ErrMsg ) - -END SUBROUTINE CreateInputOutputMeshes -!--------------------------------------------------------------------------- -!> 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 SD_Init( InitInput, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) - TYPE(SD_InitInputType), INTENT(IN ) :: InitInput !< Input data for initialization routine - TYPE(SD_InputType), INTENT( OUT) :: u !< An initial guess for the input; input mesh must be defined - TYPE(SD_ParameterType), INTENT( OUT) :: p !< Parameters - TYPE(SD_ContinuousStateType), INTENT( OUT) :: x !< Initial continuous states - TYPE(SD_DiscreteStateType), INTENT( OUT) :: xd !< Initial discrete states - TYPE(SD_ConstraintStateType), INTENT( OUT) :: z !< Initial guess of the constraint states - TYPE(SD_OtherStateType), INTENT( OUT) :: OtherState !< Initial other states - TYPE(SD_OutputType), INTENT( OUT) :: y !< Initial system outputs (outputs are not calculated; - !! only the output mesh is initialized) - REAL(DbKi), INTENT(INOUT) :: Interval !< Coupling interval in seconds: the rate that - !! (1) Mod1_UpdateStates() is called in loose coupling & - !! (2) Mod1_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. - TYPE(SD_MiscVarType), INTENT( OUT) :: m !< Initial misc/optimization variables - TYPE(SD_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 - TYPE(SD_InitType) :: Init - TYPE(CB_MatArrays) :: CBparams ! CB parameters to be stored and written to summary file - INTEGER(IntKi) :: ErrStat2 ! Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None - - ! Initialize variables - ErrStat = ErrID_None - ErrMsg = "" - - ! Initialize the NWTC Subroutine Library - CALL NWTC_Init( ) - - ! Display the module information - CALL DispNVD( SD_ProgDesc ) - InitOut%Ver = SD_ProgDesc - - ! --- Test TODO remove me in the future - if (DEV_VERSION) then - CALL SD_Tests(ErrStat2, ErrMsg2); if(Failed()) return - endif - - ! transfer glue-code information to data structure for SubDyn initialization: - Init%g = InitInput%g - Init%TP_RefPoint = InitInput%TP_RefPoint - Init%SubRotateZ = InitInput%SubRotateZ - if ((allocated(InitInput%SoilStiffness)) .and. (InitInput%SoilMesh%Initialized)) then - ! Soil Mesh and Stiffness - ! SoilMesh has N points. Correspond in order to the SoilStiffness matrices passed in - ! %RefOrientation is the identity matrix (3,3,N) - ! %Position is the reference position (3,N) - ! Maybe some logic to make sure these points correspond roughly to nodes -- though this may not be true for a long pile into the soil with multiple connection points - ! Note: F = -kx whre k is the relevant 6x6 matrix from SoilStiffness - call AllocAry(Init%Soil_K, 6,6, size(InitInput%SoilStiffness,3), 'Soil_K', ErrStat2, ErrMsg2); - call AllocAry(Init%Soil_Points, 3, InitInput%SoilMesh%NNodes, 'Soil_Points', ErrStat2, ErrMsg2); - call AllocAry(Init%Soil_Nodes, InitInput%SoilMesh%NNodes, 'Soil_Nodes' , ErrStat2, ErrMsg2); - Init%Soil_K = InitInput%SoilStiffness ! SoilStiffness is dimensioned (6,6,N) - Init%Soil_Points = InitInput%SoilMesh%Position ! SoilStiffness is dimensioned (6,6,N) - Init%Soil_Nodes = -1 ! Will be determined in InsertSoilMatrices, Nodes not known yet - if (size(Init%Soil_K,3) /= size(Init%Soil_Points,2)) then - ErrStat2=ErrID_Fatal; ErrMsg2='Number of soil points inconsistent with number of soil stiffness matrix' - endif - if (Failed()) return - endif - - !bjj added this ugly check (mostly for checking SubDyn driver). not sure if anyone would want to play with different values of gravity so I don't return an error. - IF (Init%g < 0.0_ReKi ) CALL ProgWarn( ' SubDyn calculations use gravity assuming it is input as a positive number; the input value is negative.' ) - - ! Establish the GLUECODE requested/suggested time step. This may be overridden by SubDyn based on the SDdeltaT parameter of the SubDyn input file. - Init%DT = Interval - IF ( LEN_TRIM(Init%RootName) == 0 ) THEN - CALL GetRoot( InitInput%SDInputFile, Init%RootName ) - ELSE - Init%RootName = TRIM(InitInput%RootName)//'.SD' - END IF - - ! Parse the SubDyn inputs - CALL SD_Input(InitInput%SDInputFile, Init, p, ErrStat2, ErrMsg2); if(Failed()) return - if (p%Floating) then - call WrScr(' Floating case detected, Guyan modes will be rigid body modes') - else - call WrScr(' Fixed bottom case detected') - endif - - ! -------------------------------------------------------------------------------- - ! --- Manipulation of Init and parameters - ! -------------------------------------------------------------------------------- - ! Discretize the structure according to the division size - ! sets p%nNodes, Init%NElm - CALL SD_Discrt(Init, p, ErrStat2, ErrMsg2); if(Failed()) return - - ! Store relative distance to TP node, for floating rigid body motion - CALL StoreNodesRelPos(Init, p, ErrStat2, ErrMsg2); if(Failed()) return - - ! Set element properties (p%ElemProps) - CALL SetElementProperties(Init, p, ErrStat2, ErrMsg2); if(Failed()) return - - !Store mapping between nodes and elements - CALL NodeCon(Init, p, ErrStat2, ErrMsg2); if(Failed()) return - - !Store mapping between controllable elements and control channels, and return guess input - CALL ControlCableMapping(Init, u, p, ErrStat2, ErrMsg2); if(Failed()) return - - ! --- Allocate DOF indices to joints and members - call DistributeDOF(Init, p ,ErrStat2, ErrMsg2); if(Failed()) return; - - ! Assemble Stiffness and mass matrix - CALL AssembleKM(Init, p, ErrStat2, ErrMsg2); if(Failed()) return - - ! Insert soil stiffness and mass matrix (NOTE: using NodesDOF, unreduced matrix) - CALL InsertSoilMatrices(Init%M, Init%K, p%NodesDOF, Init, p, ErrStat2, ErrMsg2); if(Failed()) return - - ! --- Elimination of constraints (reset M, K, D, to lower size, and BCs IntFc ) - CALL DirectElimination(Init, p, ErrStat2, ErrMsg2); if(Failed()) return - - ! --- Additional Damping and stiffness at pin/ball/universal joints - CALL InsertJointStiffDamp(p, Init, ErrStat2, ErrMsg2); if(Failed()) return - - ! --- Prepare for control cable load, RHS - if (size(p%CtrlElem2Channel,1)>0) then - CALL ControlCableForceInit(p, m, ErrStat2, ErrMsg2); if(Failed()) return - print*,'Controlable cables are present, this feature is not ready at the glue code level.' - STOP - endif - - ! -------------------------------------------------------------------------------- - ! --- CB, Misc - ! -------------------------------------------------------------------------------- - ! --- Partitioning - ! Nodes into (I,C,L,R): I=Interface ,C=Boundary (bottom), R=(I+C), L=Interior - ! DOFs into (B,F,L): B=Leader (i.e. Rbar) ,F=Fixed, L=Interior - call PartitionDOFNodes(Init, m, p, ErrStat2, ErrMsg2) ; if(Failed()) return - if (p%GuyanLoadCorrection) then - if (p%Floating) then - call WrScr(' Guyan extra moment and rotated CB-frame will be used (floating case detected)') - else - call WrScr(' Guyan extra moment will be included in loads (fixed-bottom case detected)') - endif - endif - - ! --- Craig-Bampton reduction (sets many parameters) - CALL SD_Craig_Bampton(Init, p, CBparams, ErrStat2, ErrMsg2); if(Failed()) return - - ! --- Initial system states - IF ( p%nDOFM > 0 ) THEN - CALL AllocAry(x%qm, p%nDOFM, 'x%qm', ErrStat2, ErrMsg2 ); if(Failed()) return - CALL AllocAry(x%qmdot, p%nDOFM, 'x%qmdot', ErrStat2, ErrMsg2 ); if(Failed()) return - CALL AllocAry(m%qmdotdot, p%nDOFM, 'm%qmdotdot', ErrStat2, ErrMsg2 ); if(Failed()) return - x%qm = 0.0_ReKi - x%qmdot = 0.0_ReKi - m%qmdotdot= 0.0_ReKi - END IF - - xd%DummyDiscState = 0.0_ReKi - z%DummyConstrState = 0.0_ReKi - - ! Allocate OtherState%xdot if using multi-step method; initialize n - IF ( ( p%IntMethod .eq. 2) .OR. ( p%IntMethod .eq. 3)) THEN - !bjj: note that the way SD_UpdateStates is implemented, "n" doesn't need to be initialized here - Allocate( OtherState%xdot(4), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat ( ErrID_Fatal, 'Error allocating OtherState%xdot', ErrStat, ErrMsg, 'SD_Init' ) - CALL CleanUp() - RETURN - END IF - ENDIF - - ! Allocate miscellaneous variables, used only to avoid temporary copies of variables allocated/deallocated and sometimes recomputed each time - CALL AllocMiscVars(p, m, ErrStat2, ErrMsg2); if(Failed()) return - - ! -------------------------------------------------------------------------------- - ! --- Initialize Inputs and Outputs - ! -------------------------------------------------------------------------------- - ! Create the input and output meshes associated with Transition Piece reference point - CALL CreateTPMeshes( InitInput%TP_RefPoint, u%TPMesh, y%Y1Mesh, ErrStat2, ErrMsg2 ); if(Failed()) return - - ! Construct the input mesh (u%LMesh, force on nodes) and output mesh (y%Y2Mesh, displacements) - CALL CreateInputOutputMeshes( p%nNodes, Init%Nodes, u%LMesh, y%Y2Mesh, ErrStat2, ErrMsg2 ); if(Failed()) return - - ! --- Write the summary file - IF ( Init%SSSum ) THEN - ! note p%KBB/MBB are KBBt/MBBt - ! Write a summary of the SubDyn Initialization - CALL OutSummary(Init, p, m, InitInput, CBparams, ErrStat2, ErrMsg2); if(Failed()) return - ENDIF - - ! Initialize the outputs & Store mapping between nodes and elements - CALL SDOUT_Init( Init, y, p, m, InitOut, InitInput%WtrDpth, ErrStat2, ErrMsg2 ); if(Failed()) return - - ! Determine if we need to perform output file handling - IF ( p%OutSwtch == 1 .OR. p%OutSwtch == 3 ) THEN - CALL SDOUT_OpenOutput( SD_ProgDesc, Init%RootName, p, InitOut, ErrStat2, ErrMsg2 ); if(Failed()) return - END IF - - if (InitInput%Linearize) then - call SD_Init_Jacobian(Init, p, u, y, InitOut, ErrStat2, ErrMsg2); if(Failed()) return - endif - - ! Tell GLUECODE the SubDyn timestep interval - Interval = p%SDdeltaT - CALL CleanUp() - -CONTAINS - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_Init') - Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() - END FUNCTION Failed - - SUBROUTINE CleanUp() - CALL SD_DestroyInitType(Init, ErrStat2, ErrMsg2) - CALL SD_DestroyCB_MatArrays( CBparams, ErrStat2, ErrMsg2 ) ! local variables - END SUBROUTINE CleanUp - -END SUBROUTINE SD_Init - -!---------------------------------------------------------------------------------------------------------------------------------- -!> Loose coupling routine for solving for constraint states, integrating continuous states, and updating discrete and other states. -!! Continuous, discrete, constraint, and other states are updated for t + Interval. -SUBROUTINE SD_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval - TYPE(SD_InputType), INTENT(INOUT) :: Inputs(:) !< Inputs at Times - REAL(DbKi), INTENT(IN ) :: InputTimes(:) !< Times in seconds associated with Inputs - TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SD_ContinuousStateType), INTENT(INOUT) :: x !< Input: Continuous states at t; - !! Output: Continuous states at t + Interval - TYPE(SD_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t; - !! Output: Discrete states at t + Interval - TYPE(SD_ConstraintStateType), INTENT(INOUT) :: z !< Input: Constraint states at t; - !! Output: Constraint states at t + Interval - TYPE(SD_OtherStateType), INTENT(INOUT) :: OtherState !< Input: Other states at t; - !! Output: Other states at t + Interval - TYPE(SD_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 variables - ErrStat = ErrID_None ! no error has occurred - ErrMsg = "" - - IF ( p%nDOFM == 0) RETURN ! no retained modes = no states - - IF (p%IntMethod .eq. 1) THEN - CALL SD_RK4( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) - ELSEIF (p%IntMethod .eq. 2) THEN - CALL SD_AB4( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) - ELSEIF (p%IntMethod .eq. 3) THEN - CALL SD_ABM4( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) - ELSE - CALL SD_AM2( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) - END IF - -END SUBROUTINE SD_UpdateStates - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine for computing outputs, used in both loose and tight coupling. -SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(SD_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(SD_ParameterType),target,INTENT(IN ) :: p !< Parameters - TYPE(SD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(SD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(SD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t - TYPE(SD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(SD_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- - !! nectivity information does not have to be recalculated) - TYPE(SD_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 - !locals - INTEGER(IntKi) :: I ! Counters - INTEGER(IntKi) :: iSDNode - REAL(ReKi) :: AllOuts(0:MaxOutPts+p%OutAllInt*p%OutAllDims) - REAL(ReKi) :: rotations(3) - REAL(ReKi) :: ULS(p%nDOF__L), UL0m(p%nDOF__L), FLt(p%nDOF__L) ! Temporary values in static improvement method - REAL(ReKi) :: Y1(6) - REAL(ReKi) :: Y1_CB(6) - REAL(ReKi) :: Y1_CB_L(6) - REAL(ReKi) :: Y1_Guy_R(6) - REAL(ReKi) :: Y1_Guy_L(6) - REAL(ReKi) :: Y1_Utp(6) - REAL(ReKi) :: Y1_GuyanLoadCorrection(3) ! Lever arm moment contributions due to interface displacement - REAL(ReKi) :: udotdot_TP(6) - INTEGER(IntKi), pointer :: DOFList(:) - REAL(ReKi) :: DCM(3,3) - REAL(ReKi) :: F_I(6*p%nNodes_I) ! !Forces from all interface nodes listed in one big array ( those translated to TP ref point HydroTP(6) are implicitly calculated in the equations) - TYPE(SD_ContinuousStateType) :: dxdt ! Continuous state derivatives at t- for output file qmdotdot purposes only - ! Variables for Guayn rigid body motion - real(ReKi), dimension(3) :: Om, OmD ! Omega, OmegaDot (body rotational speed and acceleration) - real(ReKi), dimension(3) :: rIP ! Vector from TP to rotated Node - real(ReKi), dimension(3) :: rIP0 ! Vector from TP to Node (undeflected) - real(ReKi), dimension(3) :: Om_X_r ! Crossproduct of Omega and r - real(ReKi), dimension(3) :: duP ! Displacement of node due to rigid rotation - real(ReKi), dimension(3) :: vP ! Rigid-body velocity of node - real(ReKi), dimension(3) :: aP ! Rigid-body acceleration of node - real(R8Ki), dimension(3,3) :: Rg2b ! Rotation matrix global 2 body coordinates - real(R8Ki), dimension(3,3) :: Rb2g ! Rotation matrix body 2 global coordinates - real(R8Ki), dimension(6,6) :: RRb2g ! Rotation matrix global 2 body coordinates, acts on a 6-vector - INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (occurs after initial error) - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - - ! --- Convert inputs to FEM DOFs and convenient 6-vector storage - ! Compute the small rotation angles given the input direction cosine matrix - rotations = GetSmllRotAngs(u%TPMesh%Orientation(:,:,1), ErrStat2, Errmsg2); if(Failed()) return - m%u_TP = (/REAL(u%TPMesh%TranslationDisp(:,1),ReKi), rotations/) - m%udot_TP = (/u%TPMesh%TranslationVel( :,1), u%TPMesh%RotationVel(:,1)/) - m%udotdot_TP = (/u%TPMesh%TranslationAcc( :,1), u%TPMesh%RotationAcc(:,1)/) - Rg2b(1:3,1:3) = u%TPMesh%Orientation(:,:,1) ! global 2 body coordinates - Rb2g(1:3,1:3) = transpose(u%TPMesh%Orientation(:,:,1)) - RRb2g(:,:) = 0.0_ReKi - RRb2g(1:3,1:3) = Rb2g - RRb2g(4:6,4:6) = Rb2g - - ! -------------------------------------------------------------------------------- - ! --- Output 2, Y2Mesh: motions on all FEM nodes (R, and L DOFs, then full DOF vector) - ! -------------------------------------------------------------------------------- - ! External force on internal nodes (F_L) - call GetExtForceOnInternalDOF(u, p, x, m, m%F_L, ErrStat2, ErrMsg2, GuyanLoadCorrection=(p%GuyanLoadCorrection.and..not.p%Floating), RotateLoads=(p%GuyanLoadCorrection.and.p%Floating)); if(Failed()) return - m%UR_bar = 0.0_ReKi - m%UR_bar_dot = 0.0_ReKi - m%UR_bar_dotdot = 0.0_ReKi - m%UL = 0.0_ReKi - m%UL_dot = 0.0_ReKi - m%UL_dotdot = 0.0_ReKi - ! --- CB modes contribution to motion (L-DOF only) - if ( p%nDOFM > 0) then - if (p%GuyanLoadCorrection.and.p%Floating) then ! >>> Rotate All - udotdot_TP(1:3) = matmul(Rg2b, u%TPMesh%TranslationAcc( :,1)) - udotdot_TP(4:6) = matmul(Rg2b, u%TPMesh%RotationAcc(:,1) ) - else - udotdot_TP = (/u%TPMesh%TranslationAcc( :,1), u%TPMesh%RotationAcc(:,1)/) - endif - m%UL = matmul( p%PhiM, x%qm ) - m%UL_dot = matmul( p%PhiM, x%qmdot ) - m%UL_dotdot = matmul( p%C2_61, x%qm ) + matmul( p%C2_62 , x%qmdot ) & - + matmul( p%D2_63, udotdot_TP ) + matmul( p%D2_64, m%F_L ) - end if - ! Static improvement (modify UL) - if (p%SttcSolve/=idSIM_None) then - FLt = MATMUL(p%PhiL_T , m%F_L) ! NOTE: Gravity in F_L - ULS = MATMUL(p%PhiLInvOmgL2, FLt ) - if ( p%nDOFM > 0) then - UL0M = MATMUL(p%PhiLInvOmgL2(:,1:p%nDOFM), FLt(1:p%nDOFM) ) - ULS = ULS-UL0M - end if - m%UL = m%UL + ULS - endif - ! --- Adding Guyan contribution to R and L DOFs - if (.not.p%Floating) then - ! Then we add the Guyan motion here - m%UR_bar = matmul( p%TI , m%u_TP ) - m%UR_bar_dot = matmul( p%TI , m%udot_TP ) - m%UR_bar_dotdot = matmul( p%TI , m%udotdot_TP ) - m%UL = m%UL + matmul( p%PhiRb_TI, m%u_TP ) - m%UL_dot = m%UL_dot + matmul( p%PhiRb_TI, m%udot_TP ) - m%UL_dotdot = m%UL_dotdot + matmul( p%PhiRb_TI, m%udotdot_TP ) - else - ! We know that the Guyan modes are rigid body modes. - ! We will add them in the "Full system" later - endif - ! --- Build original DOF vectors (DOF before the CB reduction) - m%U_red (p%IDI__) = m%UR_bar - m%U_red (p%ID__L) = m%UL - m%U_red (p%IDC_Rb)= 0 ! NOTE: for now we don't have leader DOF at "C" (bottom) - m%U_red (p%ID__F) = 0 - m%U_red_dot (p%IDI__) = m%UR_bar_dot - m%U_red_dot (p%ID__L) = m%UL_dot - m%U_red_dot (p%IDC_Rb)= 0 ! NOTE: for now we don't have leader DOF at "C" (bottom) - m%U_red_dot (p%ID__F) = 0 - m%U_red_dotdot(p%IDI__) = m%UR_bar_dotdot - m%U_red_dotdot(p%ID__L) = m%UL_dotdot - m%U_red_dotdot(p%IDC_Rb)= 0 ! NOTE: for now we don't have leader DOF at "C" (bottom) - m%U_red_dotdot(p%ID__F) = 0 - - if (p%reduced) then - m%U_full = matmul(p%T_red, m%U_red) - m%U_full_dot = matmul(p%T_red, m%U_red_dot) - m%U_full_dotdot = matmul(p%T_red, m%U_red_dotdot) - else - m%U_full = m%U_red - m%U_full_dot = m%U_red_dot - m%U_full_dotdot = m%U_red_dotdot - endif - - ! Storing elastic motion (full motion for fixed bottom, CB motion only for floating) - m%U_full_elast = m%U_full - - ! --- Place displacement/velocity/acceleration into Y2 output mesh - if (p%Floating) then - ! For floating, we compute the Guyan motion directly (rigid body motion with TP as origin) - ! This introduce non-linear "rotations" effects, where the bottom node should "go up", and not just translate horizontally - Om(1:3) = u%TPMesh%RotationVel(1:3,1) - OmD(1:3) = u%TPMesh%RotationAcc(1:3,1) - do iSDNode = 1,p%nNodes - DOFList => p%NodesDOF(iSDNode)%List ! Alias to shorten notations - ! --- Guyan (rigid body) motion in global coordinates - rIP0(1:3) = p%DP0(1:3, iSDNode) - rIP(1:3) = matmul(Rb2g, rIP0) - duP(1:3) = rIP - rIP0 + m%u_TP(1:3) - Om_X_r(1:3) = cross_product(Om, rIP) - vP(1:3) = u%TPMesh%TranslationVel(1:3,1) + Om_X_r - aP(1:3) = u%TPMesh%TranslationAcc(1:3,1) + cross_product(OmD, rIP) + cross_product(Om, Om_X_r) - - ! Full displacements CB-rotated + Guyan (KEEP ME) >>> Rotate All - if (p%GuyanLoadCorrection) then - m%U_full (DOFList(1:3)) = matmul(Rb2g, m%U_full (DOFList(1:3))) + duP(1:3) - m%U_full (DOFList(4:6)) = matmul(Rb2g, m%U_full (DOFList(4:6))) + rotations(1:3) - m%U_full_dot (DOFList(1:3)) = matmul(Rb2g, m%U_full_dot (DOFList(1:3))) + vP(1:3) - m%U_full_dot (DOFList(4:6)) = matmul(Rb2g, m%U_full_dot (DOFList(4:6))) + Om(1:3) - m%U_full_dotdot(DOFList(1:3)) = matmul(Rb2g, m%U_full_dotdot(DOFList(1:3))) + aP(1:3) - m%U_full_dotdot(DOFList(4:6)) = matmul(Rb2g, m%U_full_dotdot(DOFList(4:6))) + OmD(1:3) - else - m%U_full (DOFList(1:3)) = m%U_full (DOFList(1:3)) + duP(1:3) - m%U_full (DOFList(4:6)) = m%U_full (DOFList(4:6)) + rotations(1:3) - m%U_full_dot (DOFList(1:3)) = m%U_full_dot (DOFList(1:3)) + vP(1:3) - m%U_full_dot (DOFList(4:6)) = m%U_full_dot (DOFList(4:6)) + Om(1:3) - m%U_full_dotdot(DOFList(1:3)) = m%U_full_dotdot(DOFList(1:3)) + aP(1:3) - m%U_full_dotdot(DOFList(4:6)) = m%U_full_dotdot(DOFList(4:6)) + OmD(1:3) - endif - - ! NOTE: For now, displacements passed to HydroDyn are Guyan only! - ! Construct the direction cosine matrix given the output angles - !call SmllRotTrans( 'UR_bar input angles', m%U_full(DOFList(4)), m%U_full(DOFList(5)), m%U_full(DOFList(6)), DCM, '', ErrStat2, ErrMsg2) - call SmllRotTrans( 'UR_bar input angles', rotations(1), rotations(2), rotations(3), DCM, '', ErrStat2, ErrMsg2) ! NOTE: using only Guyan rotations - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_CalcOutput') - y%Y2mesh%Orientation (:,:,iSDNode) = DCM - !y%Y2mesh%TranslationDisp (:,iSDNode) = m%U_full (DOFList(1:3)) - y%Y2mesh%TranslationDisp (:,iSDNode) = duP(1:3) ! NOTE: using only the Guyan Displacements - y%Y2mesh%TranslationVel (:,iSDNode) = m%U_full_dot (DOFList(1:3)) - y%Y2mesh%TranslationAcc (:,iSDNode) = m%U_full_dotdot (DOFList(1:3)) - y%Y2mesh%RotationVel (:,iSDNode) = m%U_full_dot (DOFList(4:6)) - y%Y2mesh%RotationAcc (:,iSDNode) = m%U_full_dotdot (DOFList(4:6)) - enddo - else - ! --- Fixed bottom - do iSDNode = 1,p%nNodes - DOFList => p%NodesDOF(iSDNode)%List ! Alias to shorten notations - ! TODO TODO which orientation to give for joints with more than 6 dofs? - ! Construct the direction cosine matrix given the output angles - CALL SmllRotTrans( 'UR_bar input angles', m%U_full(DOFList(4)), m%U_full(DOFList(5)), m%U_full(DOFList(6)), DCM, '', ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_CalcOutput') - y%Y2mesh%Orientation (:,:,iSDNode) = DCM - y%Y2mesh%TranslationDisp (:,iSDNode) = m%U_full (DOFList(1:3)) - y%Y2mesh%TranslationVel (:,iSDNode) = m%U_full_dot (DOFList(1:3)) - y%Y2mesh%TranslationAcc (:,iSDNode) = m%U_full_dotdot (DOFList(1:3)) - y%Y2mesh%RotationVel (:,iSDNode) = m%U_full_dot (DOFList(4:6)) - y%Y2mesh%RotationAcc (:,iSDNode) = m%U_full_dotdot (DOFList(4:6)) - enddo - endif - - ! -------------------------------------------------------------------------------- - ! --- Outputs 1, Y1=-F_TP, reaction force from SubDyn to ElastoDyn (stored in y%Y1Mesh) - ! -------------------------------------------------------------------------------- - ! --- Special case for floating with extramoment - if (p%GuyanLoadCorrection.and.p%Floating) then - Y1_CB_L = - (matmul(p%D1_141, m%F_L)) ! Uses rotated loads - endif - - ! Compute external force on internal (F_L) and interface nodes (F_I) - call GetExtForceOnInternalDOF(u, p, x, m, m%F_L, ErrStat2, ErrMsg2, GuyanLoadCorrection=(p%GuyanLoadCorrection), RotateLoads=.False.); if(Failed()) return - call GetExtForceOnInterfaceDOF(p, m%Fext, F_I) - - ! Compute reaction/coupling force at TP - Y1_Utp = - (matmul(p%KBB, m%u_TP) + matmul(p%CBB, m%udot_TP) + matmul(p%MBB, m%udotdot_TP) ) - if (p%nDOFM>0) then - !>>> Rotate All - ! NOTE: this introduces some hysteresis - !if (p%Floating) then - ! udotdot_TP(1:3) = matmul(Rg2b, u%TPMesh%TranslationAcc( :,1)) - ! udotdot_TP(4:6) = matmul(Rg2b, u%TPMesh%RotationAcc(:,1) ) - ! Y1_Utp = Y1_Utp + matmul(RRb2g, matmul(p%MBmmB, udotdot_TP)) - !else - Y1_Utp = Y1_Utp + matmul(p%MBmmB, m%udotdot_TP) - !endif - endif - if ( p%nDOFM > 0) then - Y1_CB = -( matmul(p%C1_11, x%qm) + matmul(p%C1_12, x%qmdot) ) - if (p%GuyanLoadCorrection.and.p%Floating) then - Y1_CB = matmul(RRb2g, Y1_CB) !>>> Rotate All - endif - else - Y1_CB = 0.0_ReKi - endif - Y1_Guy_R = matmul( F_I, p%TI ) - Y1_Guy_L = - matmul(p%D1_142, m%F_L) ! non rotated loads - if (.not.(p%GuyanLoadCorrection.and.p%Floating)) then - Y1_CB_L = - (matmul(p%D1_141, m%F_L)) ! Uses non rotated loads - endif - if (p%GuyanLoadCorrection.and.p%Floating) then - Y1_CB_L = matmul(RRb2g, Y1_CB_L) !>>> Rotate All - endif - - Y1 = Y1_CB + Y1_Utp + Y1_CB_L+ Y1_Guy_L + Y1_Guy_R - ! KEEP ME - !if ( p%nDOFM > 0) then - ! Y1 = -( matmul(p%C1_11, x%qm) + matmul(p%C1_12,x%qmdot) & - ! + matmul(p%KBB, m%u_TP) + matmul(p%CBB, m%udot_TP) + matmul(p%MBB - p%MBmmB, m%udotdot_TP) & - ! + matmul(p%D1_141, m%F_L) + matmul(p%D1_142, m%F_L) - matmul( F_I, p%TI ) ) - !else ! No retained modes, so there are no states - ! Y1 = -( matmul(p%KBB, m%u_TP) + matmul(p%CBB, m%udot_TP) + matmul(p%MBB - p%MBmmB, m%udotdot_TP) & - ! + matmul(p%D1_141, m%F_L) + matmul(p%D1_142, m%F_L) - matmul( F_I, p%TI ) ) - !end if - - ! Computing extra moments due to lever arm introduced by interface displacement - ! Y1_MExtra = - MExtra = -u_TP x Y1(1:3) ! NOTE: double cancellation of signs - if (p%GuyanLoadCorrection) then - if (.not.p%floating) then ! if Fixed, transfer from non deflected TP to u_TP - Y1_GuyanLoadCorrection(1) = - m%u_TP(2) * Y1(3) + m%u_TP(3) * Y1(2) - Y1_GuyanLoadCorrection(2) = - m%u_TP(3) * Y1(1) + m%u_TP(1) * Y1(3) - Y1_GuyanLoadCorrection(3) = - m%u_TP(1) * Y1(2) + m%u_TP(2) * Y1(1) - Y1(4:6) = Y1(4:6) + Y1_GuyanLoadCorrection - endif - endif - ! values on the interface mesh are Y1 (SubDyn forces) + Hydrodynamic forces - y%Y1Mesh%Force (:,1) = Y1(1:3) - y%Y1Mesh%Moment(:,1) = Y1(4:6) - - !________________________________________ - ! CALCULATE OUTPUT TO BE WRITTEN TO FILE - !________________________________________ - ! OutSwtch determines whether or not to actually output results via the WriteOutput array - ! 0 = No one needs the SubDyn outputs provided via the WriteOutput array. - ! 1 = SubDyn will generate an output file of its own. - ! 2 = the caller will handle the outputs, but SubDyn needs to provide them. - ! 3 = Both 1 and 2 - IF ( p%OutSwtch > 0 ) THEN - ! call CalcContStateDeriv one more time to store these qmdotdot for debugging purposes in the output file - !find xdot at t - IF ( p%nDOFM > 0 ) THEN - ! note that this re-sets m%udotdot_TP and m%F_L, but they are the same values as earlier in this routine so it doesn't change results in SDOut_MapOutputs() - CALL SD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2 ); if(Failed()) return - !Assign the acceleration to the x variable since it will be used for output file purposes for SSqmdd01-99, and dxdt will disappear - m%qmdotdot=dxdt%qmdot - ! Destroy dxdt because it is not necessary for the rest of the subroutine - CALL SD_DestroyContState( dxdt, ErrStat2, ErrMsg2); if(Failed()) return - END IF - ! 6-vectors (making sure they are up to date for outputs - m%udot_TP = (/u%TPMesh%TranslationVel( :,1),u%TPMesh%RotationVel(:,1)/) - m%udotdot_TP = (/u%TPMesh%TranslationAcc(:,1), u%TPMesh%RotationAcc(:,1)/) - - ! Write the previous output data into the output file - IF ( ( p%OutSwtch == 1 .OR. p%OutSwtch == 3 ) .AND. ( t > m%LastOutTime ) ) THEN - IF ((m%Decimat .EQ. p%OutDec) .OR. (m%Decimat .EQ. 0)) THEN - m%Decimat=1 !reset counter - CALL SDOut_WriteOutputs( p%UnJckF, m%LastOutTime, m%SDWrOutput, p, ErrStat2, ErrMsg2 ); if(Failed()) return - ELSE - m%Decimat=m%Decimat+1 - ENDIF - END IF - - ! Map calculated results into the AllOuts Array + perform averaging and all necessary extra calculations - CALL SDOut_MapOutputs(u, p, x, y, m, AllOuts, ErrStat2, ErrMsg2); if(Failed()) return - - ! Put the output data in the WriteOutput array - DO I = 1,p%NumOuts+p%OutAllInt*p%OutAllDims - y%WriteOutput(I) = p%OutParam(I)%SignM * AllOuts( p%OutParam(I)%Indx ) - IF ( p%OutSwtch == 1 .OR. p%OutSwtch == 3 ) THEN - m%SDWrOutput(I) = y%WriteOutput(I) - END IF - END DO - m%LastOutTime = t - ENDIF - -CONTAINS - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_CalcOutput') - Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() - END FUNCTION Failed - - SUBROUTINE CleanUp - CALL SD_DestroyContState( dxdt, ErrStat2, ErrMsg2) - END SUBROUTINE CleanUp - -END SUBROUTINE SD_CalcOutput - -!---------------------------------------------------------------------------------------------------------------------------------- -!> Tight coupling routine for computing derivatives of continuous states -!! note that this also sets m%F_L and m%udotdot_TP -SUBROUTINE SD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(SD_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SD_ContinuousStateType), INTENT(IN) :: x !< Continuous states at t -WHY IS THIS INOUT and not JUST IN? RRD, changed to IN on2/19/14 check with Greg - TYPE(SD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(SD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t - TYPE(SD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - TYPE(SD_ContinuousStateType), INTENT( OUT) :: dxdt !< Continuous state derivatives at t - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi) :: udotdot_TP(6) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - - ! INTENT(OUT) automatically deallocates the arrays on entry, we have to allocate them here - CALL AllocAry(dxdt%qm, p%nDOFM, 'dxdt%qm', ErrStat2, ErrMsg2 ); CALL SetErrStat ( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_CalcContStateDeriv' ) - CALL AllocAry(dxdt%qmdot, p%nDOFM, 'dxdt%qmdot', ErrStat2, ErrMsg2 ); CALL SetErrStat ( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_CalcContStateDeriv' ) - IF ( ErrStat >= AbortErrLev ) RETURN - IF ( p%nDOFM == 0 ) RETURN - - ! Compute F_L, force on internal DOF - CALL GetExtForceOnInternalDOF(u, p, x, m, m%F_L, ErrStat2, ErrMsg2, GuyanLoadCorrection=(p%GuyanLoadCorrection.and..not.p%Floating), RotateLoads=(p%GuyanLoadCorrection.and.p%Floating)) - - udotdot_TP = (/u%TPMesh%TranslationAcc(:,1), u%TPMesh%RotationAcc(:,1)/) - if (p%GuyanLoadCorrection.and.p%Floating) then - ! >>> Rotate All - udotdot_TP to body coordinates - udotdot_TP(1:3) = matmul( u%TPMesh%Orientation(:,:,1), udotdot_TP(1:3) ) - udotdot_TP(4:6) = matmul( u%TPMesh%Orientation(:,:,1), udotdot_TP(4:6) ) - endif - - ! State equation - dxdt%qm= x%qmdot - ! NOTE: matmul( TRANSPOSE(p%PhiM), m%F_L ) = matmul( m%F_L, p%PhiM ) because F_L is 1-D - dxdt%qmdot = -p%KMMDiag*x%qm - p%CMMDiag*x%qmdot - matmul(p%MMB,udotdot_TP) + matmul(m%F_L, p%PhiM) - -END SUBROUTINE SD_CalcContStateDeriv - -!----------------------------------------------------------------------------------------------------------------------- -SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) - CHARACTER(*), INTENT(IN) :: SDInputFile - TYPE(SD_InitType) , INTENT(INOUT) :: Init - TYPE(SD_ParameterType) , INTENT(INOUT) :: p - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None -! local variable for input and output -CHARACTER(1024) :: PriPath ! The path to the primary input file -CHARACTER(1024) :: Line, Dummy_Str ! String to temporarially hold value of read line -CHARACTER(64), ALLOCATABLE :: StrArray(:) ! Array of strings, for better control of table inputs -LOGICAL :: Echo -LOGICAL :: LegacyFormat -LOGICAL :: bNumeric -INTEGER(IntKi) :: UnIn -INTEGER(IntKi) :: nColumns, nColValid, nColNumeric -INTEGER(IntKi) :: IOS -INTEGER(IntKi) :: UnEc !Echo file ID -REAL(ReKi),PARAMETER :: WrongNo=-9999. ! Placeholder value for bad(old) values in JDampings -INTEGER(IntKi) :: I, J, flg, K -REAL(ReKi) :: Dummy_ReAry(SDMaxInpCols) , DummyFloat -INTEGER(IntKi) :: Dummy_IntAry(SDMaxInpCols) -LOGICAL :: Dummy_Bool -INTEGER(IntKi) :: Dummy_Int -INTEGER(IntKi) :: ErrStat2 -CHARACTER(ErrMsgLen) :: ErrMsg2 -! Initialize ErrStat -ErrStat = ErrID_None -ErrMsg = "" - -UnEc = -1 -Echo = .FALSE. - -CALL GetNewUnit( UnIn ) - -CALL OpenFInpfile(UnIn, TRIM(SDInputFile), ErrStat2, ErrMsg2) - -IF ( ErrStat2 /= ErrID_None ) THEN - Call Fatal('Could not open SubDyn input file') - return -END IF - -CALL GetPath( SDInputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - - -!-------------------------- HEADER --------------------------------------------- -CALL ReadCom( UnIn, SDInputFile, 'SubDyn input file header line 1', ErrStat2, ErrMsg2 ); if(Failed()) return -CALL ReadCom( UnIn, SDInputFile, 'SubDyn input file header line 2', ErrStat2, ErrMsg2 ); if(Failed()) return - -!-------------------------- SIMULATION CONTROL PARAMETERS ---------------------- -CALL ReadCom( UnIn, SDInputFile, ' SIMULATION CONTROL PARAMETERS ', ErrStat2, ErrMsg2 ); if(Failed()) return -CALL ReadVar(UnIn, SDInputFile, Echo, 'Echo', 'Echo Input File Logic Variable',ErrStat2, ErrMsg2); if(Failed()) return - -IF ( Echo ) THEN - CALL OpenEcho ( UnEc, TRIM(Init%RootName)//'.ech' ,ErrStat2, ErrMsg2) - IF ( ErrStat2 /= 0 ) THEN - CALL Fatal("Could not open SubDyn echo file") - return - END IF - REWIND(UnIn) - !bjj: note we don't need to do error checking here; it was already checked (this is just a repeat of above) - CALL ReadCom( UnIn, SDInputFile, 'SubDyn input file header line 1', ErrStat2, ErrMsg2 ) - CALL ReadCom( UnIn, SDInputFile, 'SubDyn input file header line 2', ErrStat2, ErrMsg2 ) - CALL ReadCom( UnIn, SDInputFile, 'SIMULATION CONTROL PARAMETERS' , ErrStat2, ErrMsg2, UnEc ) - CALL ReadVar( UnIn, SDInputFile, Echo, 'Echo', 'Echo Input File Logic Variable',ErrStat2, ErrMsg2, UnEc ) -ENDIF - -! Read time step ("default" means use the glue-code default) -CALL ReadVar( UnIn, SDInputFile, Line, 'SDdeltaT', 'Subdyn Time Step',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - -CALL Conv2UC( Line ) ! Convert Line to upper case. -IF ( TRIM(Line) == 'DEFAULT' ) THEN ! .TRUE. when one wants to use the default value timestep provided by the glue code. - p%SDdeltaT=Init%DT -ELSE ! The input must have been specified numerically. - READ (Line,*,IOSTAT=IOS) p%SDdeltaT - CALL CheckIOS ( IOS, SDInputFile, 'SDdeltaT', NumType, ErrStat2,ErrMsg2 ); if(Failed()) return - - IF ( ( p%SDdeltaT <= 0 ) ) THEN - call Fatal('SDdeltaT must be greater than or equal to 0.') - return - END IF -END IF - -CALL ReadVar ( UnIn, SDInputFile, p%IntMethod, 'IntMethod', 'Integration Method',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadVar (UnIn, SDInputFile, Dummy_Str, 'SttcSolve', 'Solve dynamics about static equilibrium point', ErrStat2, ErrMsg2, UnEc); if(Failed()) return -p%SttcSolve = idSIM_None -if (is_numeric(Dummy_Str, DummyFloat)) then - p%SttcSolve = int(DummyFloat) -else if (is_logical(Dummy_Str, Dummy_Bool)) then - if (Dummy_Bool) p%SttcSolve = idSIM_Full -else - call Fatal('SttcSolve should be an integer or a logical, received: '//trim(Dummy_Str)) - return -endif -IF (Check(.not.(any(idSIM_Valid==p%SttcSolve)), 'Invalid value entered for SttcSolve')) return - -! GuyanLoadCorrection - For legacy, allowing this line to be a comment -CALL ReadVar (UnIn, SDInputFile, Dummy_Str, 'GuyanLoadCorrection', 'Add extra lever arm contribution to interface loads', ErrStat2, ErrMsg2, UnEc); if(Failed()) return -if (is_logical(Dummy_Str, Dummy_Bool)) then ! the parameter was present - p%GuyanLoadCorrection=Dummy_Bool - ! We still need to read the comment on the next line - CALL ReadCom ( UnIn, SDInputFile, ' FEA and CRAIG-BAMPTON PARAMETERS ', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -else ! we have a actually read a comment line, we do nothing. - call LegacyWarning('ExtraMom line missing from input file. Assuming no extra moment.') - p%GuyanLoadCorrection=.False. ! For Legacy, GuyanLoadCorrection is False -endif - -!-------------------- FEA and CRAIG-BAMPTON PARAMETERS--------------------------- -CALL ReadIVar ( UnIn, SDInputFile, Init%FEMMod, 'FEMMod', 'FEM analysis mode' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return ! 0= Euler-Bernoulli(E-B); 1=Tapered E-B; 2= Timoshenko; 3= tapered Timoshenko -CALL ReadIVar ( UnIn, SDInputFile, Init%NDiv , 'NDiv' , 'Number of divisions per member',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadLVar ( UnIn, SDInputFile, Init%CBMod , 'CBMod' , 'C-B mod flag' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - -IF (Check( (p%IntMethod < 1) .OR.(p%IntMethod > 4) , 'IntMethod must be 1 through 4.')) return -IF (Check( (Init%FEMMod < 0 ) .OR. ( Init%FEMMod > 4 ) , 'FEMMod must be 0, 1, 2, or 3.')) return -IF (Check( Init%NDiv < 1 , 'NDiv must be a positive integer')) return -IF (Check( Init%FEMMod==2 , 'FEMMod = 2 (tapered Euler-Bernoulli) not implemented')) return -IF (Check( Init%FEMMod==4 , 'FEMMod = 4 (tapered Timoshenko) not implemented')) return - -IF (Init%CBMod) THEN - ! Nmodes - Number of interal modes to retain. - CALL ReadIVar ( UnIn, SDInputFile, p%nDOFM, 'Nmodes', 'Number of internal modes',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - - IF (Check( p%nDOFM < 0 , 'Nmodes must be a non-negative integer.')) return - - if ( p%nDOFM > 0 ) THEN - ! Damping ratios for retained modes - CALL AllocAry(Init%JDampings, p%nDOFM, 'JDamping', ErrStat2, ErrMsg2) ; if(Failed()) return - Init%JDampings=WrongNo !Initialize - - CALL ReadAry( UnIn, SDInputFile, Init%JDampings, p%nDOFM, 'JDamping', 'Damping ratio of the internal modes', ErrStat2, ErrMsg2, UnEc ); - ! note that we don't check the ErrStat2 here; if the user entered fewer than Nmodes values, we will use the - ! last entry to fill in remaining values. - !Check 1st value, we need at least one good value from user or throw error - DO I = 2, p%nDOFM - IF ( Init%JDampings(I) .EQ. WrongNo ) THEN - Init%Jdampings(I:p%nDOFM)=Init%JDampings(I-1) - IF (i /= 2) THEN ! display an informational message if we're repeating the last value (unless we only entered one value) - ErrStat = ErrID_Info - ErrMsg = 'Using damping ratio '//trim(num2lstr(Init%JDampings(I-1)))//' for modes '//trim(num2lstr(I))//' - '//trim(num2lstr(p%nDOFM))//'.' - END IF - EXIT - ENDIF - ENDDO - IF (ErrStat2 /= ErrID_None .AND. Echo) THEN ! ReadAry had an error because it couldn't read the entire array so it didn't write this to the echo file; we assume the last-read values are used for remaining JDampings - WRITE( UnEc, Ec_ReAryFrmt ) 'JDamping', 'Damping ratio of the internal modes', Init%Jdampings(1:MIN(p%nDOFM,NWTC_MaxAryLen)) - END IF - ELSE - CALL ReadCom( UnIn, SDInputFile, 'JDamping', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - END IF - -ELSE !CBMOD=FALSE : all modes are retained, not sure how many they are yet - !note at this stage I do not know nDOFL yet; Nmodes will be updated later for the FULL FEM CASE. - p%nDOFM = -1 - !Ignore next line - CALL ReadCom( UnIn, SDInputFile, 'Nmodes', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - !Read 1 damping value for all modes - CALL AllocAry(Init%JDampings, 1, 'JDamping', ErrStat2, ErrMsg2) ; if(Failed()) return - CALL ReadVar ( UnIn, SDInputFile, Init%JDampings(1), 'JDampings', 'Damping ratio',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -ENDIF - -IF ((p%nDOFM > 0) .OR. (.NOT.(Init%CBMod))) THEN !This if should not be at all, dampings should be divided by 100 regardless, also if CBmod=false p%nDOFM is undefined, but if Nmodes=0 then JDampings does not exist - Init%JDampings = Init%JDampings/100.0_ReKi !now the 20 is .20 as it should in all cases for 1 or Nmodes JDampings -END IF - -! --- Guyan damping -! For legacy, allowing these lines to be missing -CALL ReadVar (UnIn, SDInputFile, Dummy_Str, 'GuyanDampMod', 'Guyan damping', ErrStat2, ErrMsg2, UnEc); if(Failed()) return -if (is_numeric(Dummy_Str, DummyFloat)) then - Init%GuyanDampMod=int(DummyFloat) - CALL ReadAry( UnIn, SDInputFile, Init%RayleighDamp, 2, "RayleighDamp", "", ErrStat2, ErrMsg2, UnEc) - CALL ReadVar (UnIn, SDInputFile, Dummy_Int, 'GuyanDampSize', 'Guyan damping matrix size', ErrStat2, ErrMsg2, UnEc); if(Failed()) return - IF (Check(Dummy_Int/=6, 'Invalid value entered for GuyanDampSize, value should be 6 for now.')) return - CALL ReadAry( UnIn, SDInputFile, Init%GuyanDampMat(1,:), 6, "GuyanDampMat1", "Guyan Damping matrix ", ErrStat2, ErrMsg2, UnEc) - CALL ReadAry( UnIn, SDInputFile, Init%GuyanDampMat(2,:), 6, "GuyanDampMat2", "Guyan Damping matrix ", ErrStat2, ErrMsg2, UnEc) - CALL ReadAry( UnIn, SDInputFile, Init%GuyanDampMat(3,:), 6, "GuyanDampMat3", "Guyan Damping matrix ", ErrStat2, ErrMsg2, UnEc) - CALL ReadAry( UnIn, SDInputFile, Init%GuyanDampMat(4,:), 6, "GuyanDampMat4", "Guyan Damping matrix ", ErrStat2, ErrMsg2, UnEc) - CALL ReadAry( UnIn, SDInputFile, Init%GuyanDampMat(5,:), 6, "GuyanDampMat5", "Guyan Damping matrix ", ErrStat2, ErrMsg2, UnEc) - CALL ReadAry( UnIn, SDInputFile, Init%GuyanDampMat(6,:), 6, "GuyanDampMat6", "Guyan Damping matrix ", ErrStat2, ErrMsg2, UnEc) - CALL ReadCom ( UnIn, SDInputFile, 'STRUCTURE JOINTS' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -else - call LegacyWarning('GuyanDampMod and following lines missing from input file. Assuming 0 Guyan damping.') - Init%GuyanDampMod = idGuyanDamp_None - Init%RayleighDamp = 0.0_ReKi - Init%GuyanDampMat = 0.0_ReKi -endif -IF (Check(.not.(any(idGuyanDamp_Valid==Init%GuyanDampMod)), 'Invalid value entered for GuyanDampMod')) return - -!--------------------- STRUCTURE JOINTS: joints connect structure members ------------------------------- -CALL ReadIVar ( UnIn, SDInputFile, Init%NJoints, 'NJoints', 'Number of joints',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadCom ( UnIn, SDInputFile, 'Joint Coordinates Headers' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadCom ( UnIn, SDInputFile, 'Joint Coordinates Units' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL AllocAry(Init%Joints, Init%NJoints, JointsCol, 'Joints', ErrStat2, ErrMsg2 ); if(Failed()) return -IF (Check( Init%NJoints < 2, 'NJoints must be greater than 1')) return -! --- Reading first line to detect file format -READ(UnIn, FMT='(A)', IOSTAT=ErrStat2) Line ; ErrMsg2='First line of joints array'; if (Failed()) return -! --- Reading first line to detect file format based on number of columns -nColumns=JointsCol -CALL AllocAry(StrArray, nColumns, 'StrArray',ErrStat2,ErrMsg2); if (Failed()) return -CALL ReadCAryFromStr ( Line, StrArray, nColumns, 'Joints', 'First line of joints array', ErrStat2, ErrMsg2 ) -if (ErrStat2/=0) then - ! We try with 4 columns (legacy format) - nColumns = 4 - deallocate(StrArray) - CALL AllocAry(StrArray, nColumns, 'StrArray',ErrStat2,ErrMsg2); if (Failed()) return - CALL ReadCAryFromStr ( Line, StrArray, nColumns, 'Joints', 'First line of joints array', ErrStat2, ErrMsg2 ); if(Failed()) return - call LegacyWarning('Joint table contains 4 columns instead of 9. All joints will be assumed cantilever, all members regular beams.') - Init%Joints(:,iJointType) = idJointCantilever ! All joints assumed cantilever - Init%Joints(:,iJointType+1:JointsCol) = 0.0 ! remaining columns set to 0 - LegacyFormat=.True. ! Legacy format - Delete me in 2024 -else - ! New format - LegacyFormat=.False. -endif -! Extract fields from first line -DO I = 1, nColumns - bNumeric = is_numeric(StrArray(I), Init%Joints(1,I)) ! Convert from string to float - if (.not.bNumeric) then - CALL Fatal(' Error in file "'//TRIM(SDInputFile)//'": Non numeric character found in Joints line. Problematic line: "'//trim(Line)//'"') - return - endif -ENDDO -deallocate(StrArray) -! Read remaining lines -DO I = 2, Init%NJoints - CALL ReadAry( UnIn, SDInputFile, Dummy_ReAry, nColumns, 'Joints', 'Joint number and coordinates', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - Init%Joints(I,1:nColumns) = Dummy_ReAry(1:nColumns) -ENDDO -IF (Check( Init%NJoints < 2, 'NJoints must be greater than 1')) return - -!---------- GO AHEAD and ROTATE STRUCTURE IF DESIRED TO SIMULATE WINDS FROM OTHER DIRECTIONS ------------- -CALL SubRotate(Init%Joints,Init%NJoints,Init%SubRotateZ) - -!------------------- BASE REACTION JOINTS: T/F for Locked/Free DOF @ each Reaction Node --------------------- -! The joints should be all clamped for now -CALL ReadCom ( UnIn, SDInputFile, 'BASE REACTION JOINTS' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadIVar ( UnIn, SDInputFile, p%nNodes_C, 'NReact', 'Number of joints with reaction forces',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadCom ( UnIn, SDInputFile, 'Base reaction joints headers ' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadCom ( UnIn, SDInputFile, 'Base reaction joints units ' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - -CALL AllocAry(p%Nodes_C, p%nNodes_C, ReactCol , 'Reacts', ErrStat2, ErrMsg2 ); if(Failed()) return -p%Nodes_C(:,:) = 1 ! Important: By default all DOFs are contrained -p%Nodes_C(:,1) = -1 ! First column is node, initalize to wrong value for safety - -call AllocAry(Init%SSIfile, p%nNodes_C, 'SSIFile', ErrStat2, ErrMsg2); if(Failed()) return -call AllocAry(Init%SSIK, 21, p%nNodes_C, 'SSIK', ErrStat2, ErrMsg2); if(Failed()) return -call AllocAry(Init%SSIM, 21, p%nNodes_C, 'SSIM', ErrStat2, ErrMsg2); if(Failed()) return -Init%SSIfile(:) = '' -Init%SSIK = 0.0_ReKi ! Important init TODO: read these matrices on the fly in SD_FEM maybe? -Init%SSIM = 0.0_ReKi ! Important init -! Reading reaction lines one by one, allowing for 1, 7 or 8 columns, with col8 being a string for the SSIfile -do I = 1, p%nNodes_C - READ(UnIn, FMT='(A)', IOSTAT=ErrStat2) Line; ErrMsg2='Error reading reaction line'; if (Failed()) return - call ReadIAryFromStr(Line, p%Nodes_C(I,:), 8, nColValid, nColNumeric, Init%SSIfile(I:I)); - if (nColValid==1 .and. nColNumeric==1) then - ! Temporary allowing this - call LegacyWarning('SubDyn reaction line has only 1 column. Please use 7 or 8 values') - else if (nColNumeric==7 .and.(nColValid==7.or.nColValid==8)) then - ! This is fine. - else - call Fatal(' Error in file "'//TRIM(SDInputFile)//'": Reaction lines must consist of 7 numerical values, followed by an optional string. Problematic line: "'//trim(Line)//'"') - return - endif -enddo -IF (Check ( p%nNodes_C > Init%NJoints , 'NReact must be less than number of joints')) return -call CheckBCs(p, ErrStat2, ErrMsg2); if (Failed()) return - -! Trigger - Reading SSI matrices if present -DO I = 1, p%nNodes_C - if ( Init%SSIfile(I)/='' .and. (ANY(p%Nodes_C(I,2:ReactCol)==idBC_Internal))) then - Init%SSIfile(I) = trim(PriPath)//trim(Init%SSIfile(I)) - CALL ReadSSIfile( Init%SSIfile(I), p%Nodes_C(I,1), Init%SSIK(:,I),Init%SSIM(:,I), ErrStat, ErrMsg, UnEc ); if(Failed()) return - endif -enddo -! Trigger: determine if floating/fixed based on BCs and SSI file -p%Floating = isFloating(Init,p) - - -!------- INTERFACE JOINTS: T/F for Locked (to the TP)/Free DOF @each Interface Joint (only Locked-to-TP implemented thus far (=rigid TP)) --------- -! Joints with reaction forces, joint number and locked/free dof -CALL ReadCom ( UnIn, SDInputFile, 'INTERFACE JOINTS' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadIVar ( UnIn, SDInputFile, p%nNodes_I, 'NInterf', 'Number of joints fixed to TP',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadCom ( UnIn, SDInputFile, 'Interface joints headers',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadCom ( UnIn, SDInputFile, 'Interface joints units ',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - -CALL AllocAry(p%Nodes_I, p%nNodes_I, InterfCol, 'Interf', ErrStat2, ErrMsg2); if(Failed()) return -p%Nodes_I(:,:) = 1 ! Important: By default all DOFs are contrained -p%Nodes_I(:,1) = -1 ! First column is node, initalize to wrong value for safety -! Reading interface lines one by one, allowing for 1 or 7 columns (cannot use ReadIAry) -DO I = 1, p%nNodes_I - READ(UnIn, FMT='(A)', IOSTAT=ErrStat2) Line ; ErrMsg2='Error reading interface line'; if (Failed()) return - call ReadIAryFromStr(Line, p%Nodes_I(I,:), 7, nColValid, nColNumeric); - if ((nColValid/=nColNumeric).or.((nColNumeric/=1).and.(nColNumeric/=7)) ) then - CALL Fatal(' Error in file "'//TRIM(SDInputFile)//'": Interface line must consist of 1 or 7 numerical values. Problematic line: "'//trim(Line)//'"') - return - endif - if (any(p%Nodes_I(I,:)<=0)) then - CALL Fatal(' Error in file "'//TRIM(SDInputFile)//'": For now, all DOF must be activated for interface lines. Problematic line: "'//trim(Line)//'"') - return - endif -ENDDO -IF (Check( ( p%nNodes_I < 0 ) .OR. (p%nNodes_I > Init%NJoints), 'NInterf must be non-negative and less than number of joints.')) RETURN -call CheckIntf(p, ErrStat2, ErrMsg2); if (Failed()) return - -!----------------------------------- MEMBERS -------------------------------------- -! One day we will need to take care of COSMIDs for non-circular members -CALL ReadCom ( UnIn, SDInputFile, 'Members ' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadIVar ( UnIn, SDInputFile, p%NMembers, 'NMembers', 'Number of members',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadCom ( UnIn, SDInputFile, 'Members Headers' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadCom ( UnIn, SDInputFile, 'Members Units ' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL AllocAry(Init%Members, p%NMembers, MembersCol, 'Members', ErrStat2, ErrMsg2) -Init%Members(:,:) = 0.0_ReKi -if (LegacyFormat) then - nColumns = 5 - Init%Members(:,iMType) = idMemberBeam ! Important, in legacy all members are beams -else - nColumns = MembersCol -endif -DO I = 1, p%NMembers - CALL ReadAry( UnIn, SDInputFile, Dummy_IntAry, nColumns, 'Members line '//Num2LStr(I), 'Member number and connectivity ', ErrStat2,ErrMsg2, UnEc); if(Failed()) return - Init%Members(I,1:nColumns) = Dummy_IntAry(1:nColumns) -ENDDO -IF (Check( p%NMembers < 1 , 'NMembers must be > 0')) return - -!------------------ MEMBER X-SECTION PROPERTY data 1/2 [isotropic material for now: use this table if circular-tubular elements ------------------------ -CALL ReadCom ( UnIn, SDInputFile, ' Member X-Section Property Data 1/2 ',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadIVar ( UnIn, SDInputFile, Init%NPropSetsB, 'NPropSets', 'Number of property sets',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadCom ( UnIn, SDInputFile, 'Property Data 1/2 Header' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadCom ( UnIn, SDInputFile, 'Property Data 1/2 Units ' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL AllocAry(Init%PropSetsB, Init%NPropSetsB, PropSetsBCol, 'ProSets', ErrStat2, ErrMsg2) ; if(Failed()) return -DO I = 1, Init%NPropSetsB - CALL ReadAry( UnIn, SDInputFile, Dummy_ReAry, PropSetsBCol, 'PropSets', 'PropSets number and values ', ErrStat2 , ErrMsg2, UnEc); if(Failed()) return - Init%PropSetsB(I,:) = Dummy_ReAry(1:PropSetsBCol) -ENDDO -IF (Check( Init%NPropSetsB < 1 , 'NPropSets must be >0')) return - -!------------------ MEMBER X-SECTION PROPERTY data 2/2 [isotropic material for now: use this table if any section other than circular, however provide COSM(i,j) below) ------------------------ -CALL ReadCom ( UnIn, SDInputFile, 'Member X-Section Property Data 2/2 ' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadIVar ( UnIn, SDInputFile, Init%NPropSetsX, 'NXPropSets', 'Number of non-circular property sets',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadCom ( UnIn, SDInputFile, 'Property Data 2/2 Header' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadCom ( UnIn, SDInputFile, 'Property Data 2/2 Unit ' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL AllocAry(Init%PropSetsX, Init%NPropSetsX, PropSetsXCol, 'XPropSets', ErrStat2, ErrMsg2); if(Failed()) return -DO I = 1, Init%NPropSetsX - CALL ReadAry( UnIn, SDInputFile, Init%PropSetsX(I,:), PropSetsXCol, 'XPropSets', 'XPropSets ID and values ', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -ENDDO -IF (Check( Init%NPropSetsX < 0, 'NXPropSets must be >=0')) return - -if (.not. LegacyFormat) then - !-------------------------- CABLE PROPERTIES ------------------------------------- - CALL ReadCom ( UnIn, SDInputFile, 'Cable properties' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - CALL ReadIVar ( UnIn, SDInputFile, Init%NPropSetsC, 'NPropSetsC', 'Number of cable properties' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - CALL ReadCom ( UnIn, SDInputFile, 'Cable properties Header' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - CALL ReadCom ( UnIn, SDInputFile, 'Cable properties Unit ' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - IF (Check( Init%NPropSetsC < 0, 'NPropSetsCable must be >=0')) return - CALL AllocAry(Init%PropSetsC, Init%NPropSetsC, PropSetsCCol, 'PropSetsC', ErrStat2, ErrMsg2); if(Failed()) return - DO I = 1, Init%NPropSetsC - !CALL ReadAry( UnIn, SDInputFile, Init%PropSetsC(I,:), PropSetsCCol, 'PropSetsC', 'PropSetsC ID and values ', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - READ(UnIn, FMT='(A)', IOSTAT=ErrStat2) Line; ErrMsg2='Error reading cable property line'; if (Failed()) return - call ReadFAryFromStr(Line, Init%PropSetsC(I,:), PropSetsCCol, nColValid, nColNumeric); - if ((nColValid/=nColNumeric).or.((nColNumeric/=4).and.(nColNumeric/=PropSetsCCol)) ) then - CALL Fatal(' Error in file "'//TRIM(SDInputFile)//'": Cable property line must consist of 4 or 5 numerical values. Problematic line: "'//trim(Line)//'"') - return - endif - if (nColNumeric==4) then - call LegacyWarning('Using 4 values instead of 5 for cable properties. Cable will have constant properties and wont be controllable.') - Init%PropSetsC(:,5:PropSetsCCol)=0 ! No CtrlChannel - endif - ENDDO - !----------------------- RIGID LINK PROPERTIES ------------------------------------ - CALL ReadCom ( UnIn, SDInputFile, 'Rigid link properties' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - CALL ReadIVar ( UnIn, SDInputFile, Init%NPropSetsR, 'NPropSetsR', 'Number of rigid link properties' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - CALL ReadCom ( UnIn, SDInputFile, 'Rigid link properties Header' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - CALL ReadCom ( UnIn, SDInputFile, 'Rigid link properties Unit ' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - CALL AllocAry(Init%PropSetsR, Init%NPropSetsR, PropSetsRCol, 'RigidPropSets', ErrStat2, ErrMsg2); if(Failed()) return - DO I = 1, Init%NPropSetsR - CALL ReadAry( UnIn, SDInputFile, Init%PropSetsR(I,:), PropSetsRCol, 'RigidPropSets', 'RigidPropSets ID and values ', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - ENDDO - IF (Check( Init%NPropSetsR < 0, 'NPropSetsRigid must be >=0')) return -else - Init%NPropSetsC=0 - Init%NPropSetsR=0 - CALL AllocAry(Init%PropSetsC, Init%NPropSetsC, PropSetsCCol, 'PropSetsC', ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(Init%PropSetsR, Init%NPropSetsR, PropSetsRCol, 'RigidPropSets', ErrStat2, ErrMsg2); if(Failed()) return -endif - -!---------------------- MEMBER COSINE MATRICES COSM(i,j) ------------------------ -CALL ReadCom ( UnIn, SDInputFile, 'Member direction cosine matrices ' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadIVar ( UnIn, SDInputFile, Init%NCOSMs, 'NCOSMs', 'Number of unique direction cosine matrices',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadCom ( UnIn, SDInputFile, 'Cosine Matrices Headers' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadCom ( UnIn, SDInputFile, 'Cosine Matrices Units ' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL AllocAry(Init%COSMs, Init%NCOSMs, COSMsCol, 'COSMs', ErrStat2, ErrMsg2); if(Failed()) return -DO I = 1, Init%NCOSMs - CALL ReadAry( UnIn, SDInputFile, Init%COSMs(I,:), COSMsCol, 'CosM', 'Cosine Matrix IDs and Values ', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -ENDDO -IF (Check( Init%NCOSMs < 0 ,'NCOSMs must be >=0')) return - -!------------------------ JOINT ADDITIONAL CONCENTRATED MASSES-------------------------- -CALL ReadCom ( UnIn, SDInputFile, 'Additional concentrated masses at joints ' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadIVar ( UnIn, SDInputFile, Init%nCMass, 'nCMass', 'Number of joints that have concentrated masses',ErrStat2, ErrMsg2, UnEc); if(Failed()) return -CALL ReadCom ( UnIn, SDInputFile, 'Concentrated Mass Headers' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadCom ( UnIn, SDInputFile, 'Concentrated Mass Units' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL AllocAry(Init%CMass, Init%nCMass, CMassCol, 'CMass', ErrStat2, ErrMsg2); if(Failed()) return -Init%CMass = 0.0 ! Important init since we allow user to only provide diagonal terms -DO I = 1, Init%nCMass - ! CALL ReadAry( UnIn, SDInputFile, Init%CMass(I,:), CMassCol, 'CMass', 'Joint number and mass values ', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - READ(UnIn, FMT='(A)', IOSTAT=ErrStat2) Line; ErrMsg2='Error reading concentrated mass line'; if (Failed()) return - call ReadFAryFromStr(Line, Init%CMass(I,:), CMassCol, nColValid, nColNumeric); - if ((nColValid/=nColNumeric).or.((nColNumeric/=5).and.(nColNumeric/=11)) ) then - CALL Fatal(' Error in file "'//TRIM(SDInputFile)//'": Interface line must consist of 5 or 11 numerical values. Problematic line: "'//trim(Line)//'"') - return - endif - if (Init%CMass(I,1)<=0) then ! Further checks in JointIDs are done in SD_FEM - CALL Fatal(' Error in file "'//TRIM(SDInputFile)//'": Invalid concentrated mass JointID. Problematic line: "'//trim(Line)//'"') - return - endif - if (nColNumeric==5) then - call LegacyWarning('Using 5 values instead of 11 for concentrated mass. Off-diagonal terms will be assumed 0.') - endif -ENDDO -IF (Check( Init%nCMass < 0 , 'NCMass must be >=0')) return - -!---------------------------- OUTPUT: SUMMARY & OUTFILE ------------------------------ -CALL ReadCom (UnIn, SDInputFile, 'OUTPUT' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadLVar(UnIn, SDInputFile, Init%SSSum , 'SSSum' , 'Summary File Logic Variable' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadLVar(UnIn, SDInputFile, Init%OutCOSM, 'OutCOSM', 'Cosine Matrix Logic Variable' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return !bjj: TODO: OutCOSM isn't used anywhere else. -CALL ReadLVar(UnIn, SDInputFile, p%OutAll , 'OutAll' , 'Output all Member Forces Logic Variable',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -!Store an integer version of it -p%OutAllInt= 1 -IF ( .NOT. p%OutAll ) p%OutAllInt= 0 -CALL ReadIVar(UnIn, SDInputFile, p%OutSwtch, 'OutSwtch', 'Output to which file variable',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -IF (Check( ( p%OutSwtch < 1 ) .OR. ( p%OutSwtch > 3) ,'OutSwtch must be >0 and <4')) return - -Swtch: SELECT CASE (p%OutSwtch) - CASE (1, 3) Swtch - !p%OutJckF = TRIM(Init%RootName)//'.out' - CASE (2) Swtch - !pass to glue code - CASE DEFAULT Swtch - CALL Fatal(' Error in file "'//TRIM(SDInputFile)//'": OutSwtch must be >0 and <4') - return - END SELECT Swtch - -! TabDelim - Output format for tabular data. -CALL ReadLVar ( UnIn, SDInputFile, Init%TabDelim, 'TabDelim', 'Use Tab Delimitation for numerical outputs',ErrStat2, ErrMsg2, UnEc); if(Failed()) return -IF ( Init%TabDelim ) THEN - p%Delim = TAB -ELSE - p%Delim = ' ' -END IF - -CALL ReadIVar( UnIn, SDInputFile, p%OutDec , 'OutDec' , 'Output Decimation' , ErrStat2 , ErrMsg2 , UnEc ); if(Failed()) return -CALL ReadVar ( UnIn, SDInputFile, p%OutFmt , 'OutFmt' , 'Format for numerical outputs' , ErrStat2 , ErrMsg2 , UnEc ); if(Failed()) return -CALL ReadVar ( UnIn, SDInputFile, p%OutSFmt , 'OutSFmt' , 'Format for output column headers' , ErrStat2 , ErrMsg2 , UnEc ); if(Failed()) return -CALL ReadCom ( UnIn, SDInputFile, ' Member Output List SECTION ',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL ReadIVar( UnIn, SDInputFile, p%NMOutputs, 'NMOutputs', 'Number of Members whose output must go into OutJckF and/or FAST .out',ErrStat2, ErrMsg2, UnEc ) -if (Failed()) return -IF (Check ( (p%NMOutputs < 0) .OR. (p%NMOutputs > p%NMembers) .OR. (p%NMOutputs > 9), 'NMOutputs must be >=0 and <= minimim(NMembers,9)')) return - -CALL ReadCom( UnIn, SDInputFile, ' Output Member Headers',ErrStat2, ErrMsg2, UnEc) ; if(Failed()) return -CALL ReadCom( UnIn, SDInputFile, ' Output Member Units' ,ErrStat2, ErrMsg2, UnEc) ; if(Failed()) return - -IF ( p%NMOutputs > 0 ) THEN - ! Allocate memory for filled group arrays - ALLOCATE ( p%MOutLst(p%NMOutputs), STAT = ErrStat2 ) !this list contains different arrays for each of its elements - IF ( ErrStat2 /= ErrID_None ) THEN - CALL Fatal(' Error in file "'//TRIM(SDInputFile)//': Error allocating MOutLst arrays') - RETURN - END IF - - DO I = 1,p%NMOutputs - READ(UnIn,'(A)',IOSTAT=ErrStat2) Line !read into a line - IF (ErrStat2 == 0) THEN - READ(Line,*,IOSTAT=ErrStat2) p%MOutLst(I)%MemberID, p%MOutLst(I)%NOutCnt - IF ( ErrStat2 /= 0 .OR. p%MOutLst(I)%NOutCnt < 1 .OR. p%MOutLst(I)%NOutCnt > 9 .OR. p%MOutLst(I)%NOutCnt > Init%Ndiv+1) THEN - CALL Fatal(' Error in file "'//TRIM(SDInputFile)//'": NOutCnt must be >= 1 and <= minimim(Ndiv+1,9)') - RETURN - END IF - CALL AllocAry( p%MOutLst(I)%NodeCnt, p%MOutLst(I)%NOutCnt, 'NodeCnt', ErrStat2, ErrMsg2); if(Failed()) return - - READ(Line,*,IOSTAT=ErrStat2) p%MOutLst(I)%MemberID, p%MOutLst(I)%NOutCnt, p%MOutLst(I)%NodeCnt - IF ( Check( ErrStat2 /= 0 , 'Failed to read member output list properties.')) return - - ! Check if MemberID is in the member list and the NodeCnt is a valid number - flg = 0 - DO J = 1, p%NMembers - IF(p%MOutLst(I)%MemberID .EQ. Init%Members(j, 1)) THEN - flg = flg + 1 ! flg could be greater than 1, when there are more than 9 internal nodes of a member. - IF( (p%MOutLst(I)%NOutCnt < 10) .and. ((p%MOutLst(I)%NOutCnt > 0)) ) THEN - DO K = 1,p%MOutLst(I)%NOutCnt - ! node number should be less than NDiv + 1 - IF( (p%MOutLst(I)%NodeCnt(k) > (Init%NDiv+1)) .or. (p%MOutLst(I)%NodeCnt(k) < 1) ) THEN - CALL Fatal(' NodeCnt should be less than NDIV+1 and greater than 0. ') - RETURN - ENDIF - ENDDO - ELSE - CALL Fatal(' NOutCnt should be less than 10 and greater than 0. ') - RETURN - ENDIF - ENDIF - ENDDO - IF (Check (flg .EQ. 0 , ' MemberID '//trim(Num2LStr(p%MOutLst(I)%MemberID))//' requested for output is not in the list of Members. ')) return - - IF ( Echo ) THEN - WRITE( UnEc, '(A)' ) TRIM(Line) - END IF - END IF - END DO -END IF - -! OutList - list of requested parameters to output to a file -CALL ReadCom( UnIn, SDInputFile, 'SSOutList',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - -ALLOCATE(Init%SSOutList(MaxOutChs), STAT=ErrStat2) -If (Check( ErrStat2 /= ErrID_None ,'Error allocating SSOutList arrays')) return -CALL ReadOutputList ( UnIn, SDInputFile, Init%SSOutList, p%NumOuts, 'SSOutList', 'List of outputs requested', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return -CALL CleanUp() - -CONTAINS - - subroutine LegacyWarning(Message) - character(len=*), intent(in) :: Message - call WrScr('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!') - call WrScr('Warning: the SubDyn input file is not at the latest format!' ) - call WrScr(' Visit: https://openfast.readthedocs.io/en/dev/source/user/api_change.html') - call WrScr('> Issue: '//trim(Message)) - call WrScr('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!') - end subroutine LegacyWarning - - LOGICAL FUNCTION Check(Condition, ErrMsg_in) - logical, intent(in) :: Condition - character(len=*), intent(in) :: ErrMsg_in - Check=Condition - if (Check) call Fatal(' Error in file '//TRIM(SDInputFile)//': '//trim(ErrMsg_in)) - END FUNCTION Check - - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_Input') - Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() - END FUNCTION Failed - - SUBROUTINE Fatal(ErrMsg_in) - character(len=*), intent(in) :: ErrMsg_in - CALL SetErrStat(ErrID_Fatal, ErrMsg_in, ErrStat, ErrMsg, 'SD_Input'); - CALL CleanUp() - END SUBROUTINE Fatal - - SUBROUTINE CleanUp() - CLOSE( UnIn ) - if(allocated(StrArray)) deallocate(StrArray) - IF (Echo) CLOSE( UnEc ) - END SUBROUTINE -END SUBROUTINE SD_Input - -!> Extract integers from a string (space delimited substrings) -!! If StrArrayOut is present, non numeric strings are also returned -!! Example Str="1 2 not_a_int 3" -> IntArray = (/1,2,3/) StrArrayOut=(/"not_a_int"/) -!! No need for error handling, the caller will check how many valid inputs were on the line -!! TODO, place me in NWTC LIb -SUBROUTINE ReadIAryFromStr(Str, IntArray, nColMax, nColValid, nColNumeric, StrArrayOut) - character(len=*), intent(in) :: Str !< - integer(IntKi), dimension(:), intent(inout) :: IntArray !< NOTE: inout, to allow for init values - integer(IntKi), intent(in) :: nColMax - integer(IntKi), intent(out) :: nColValid, nColNumeric !< - character(len=*), dimension(:), intent(out), optional :: StrArrayOut(:) !< Array of strings that are non numeric - character(255), allocatable :: StrArray(:) ! Array of strings extracted from line - real(ReKi) :: DummyFloat - integer(IntKi) :: J, nColStr - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - nColValid = 0 ; - nColNumeric = 0 ; - nColStr = 0 ; - ! --- First extract the different sub strings - CALL AllocAry(StrArray, nColMax, 'StrArray', ErrStat2, ErrMsg2); - if (ErrStat2/=ErrID_None) then - return ! User should notice that there is 0 valid columns - endif - StrArray(:)=''; - CALL ReadCAryFromStr(Str, StrArray, nColMax, 'StrArray', 'StrArray', ErrStat2, ErrMsg2)! NOTE:No Error handling! - ! --- Then look for numerical values - do J = 1, nColMax - if (len(trim(StrArray(J)))>0) then - nColValid=nColValid+1 - if (is_numeric(StrArray(J), DummyFloat) ) then !< TODO we should check for int here! - nColNumeric=nColNumeric+1 - if (nColNumeric<=size(IntArray)) then - IntArray(nColNumeric) = int(DummyFloat) - endif - else - nColStr = nColStr+1 - if (present(StrArrayOut)) then - if (nColStr <=size(StrArrayOut) )then - StrArrayOut(nColStr) = StrArray(J) - endif - endif - endif - endif - enddo - if(allocated(StrArray)) deallocate(StrArray) -END SUBROUTINE ReadIAryFromStr - -!> See ReadIAryFromStr, same but for floats -SUBROUTINE ReadFAryFromStr(Str, FloatArray, nColMax, nColValid, nColNumeric, StrArrayOut) - character(len=*), intent(in) :: Str !< - real(ReKi), dimension(:), intent(inout) :: FloatArray !< NOTE: inout, to allow for init values - integer(IntKi), intent(in) :: nColMax - integer(IntKi), intent(out) :: nColValid, nColNumeric !< - character(len=*), dimension(:), intent(out), optional :: StrArrayOut(:) !< Array of strings that are non numeric - character(255), allocatable :: StrArray(:) ! Array of strings extracted from line - real(ReKi) :: DummyFloat - integer(IntKi) :: J, nColStr - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - nColValid = 0 ; - nColNumeric = 0 ; - nColStr = 0 ; - ! --- First extract the different sub strings - CALL AllocAry(StrArray, nColMax, 'StrArray', ErrStat2, ErrMsg2); - if (ErrStat2/=ErrID_None) then - return ! User should notice that there is 0 valid columns - endif - StrArray(:)=''; - CALL ReadCAryFromStr(Str, StrArray, nColMax, 'StrArray', 'StrArray', ErrStat2, ErrMsg2)! NOTE:No Error handling! - ! --- Then look for numerical values - do J = 1, nColMax - if (len(trim(StrArray(J)))>0) then - nColValid=nColValid+1 - if (is_numeric(StrArray(J), DummyFloat) ) then !< TODO we should check for int here! - nColNumeric=nColNumeric+1 - if (nColNumeric<=size(FloatArray)) then - FloatArray(nColNumeric) = DummyFloat - endif - else - nColStr = nColStr+1 - if (present(StrArrayOut)) then - if (nColStr <=size(StrArrayOut) )then - StrArrayOut(nColStr) = StrArray(J) - endif - endif - endif - endif - enddo - if(allocated(StrArray)) deallocate(StrArray) -END SUBROUTINE ReadFAryFromStr - - - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> Rotate the joint coordinates with respect to global z -SUBROUTINE SubRotate(Joints,NJoints,SubRotZ) - REAL(ReKi), INTENT(IN) :: SubRotZ ! Rotational angle in degrees - INTEGER(IntKi), INTENT(IN) :: NJOINTS ! Row size of Joints - REAL(ReKi), DIMENSION(NJOINTS,3), INTENT(INOUT) :: JOINTS ! Rotational angle in degrees (Njoints,4) - !locals - REAL(ReKi) :: rot !angle in rad - REAL(ReKi), DIMENSION(2,2) :: ROTM !rotational matrix (cos matrix with -theta) - - rot=pi*SubRotz/180. - ROTM=transpose(reshape([ COS(rot), -SIN(rot) , & - SIN(rot) , COS(rot)], [2,2] )) - Joints(:,2:3)= transpose(matmul(ROTM,transpose(Joints(:,2:3)))) - -END SUBROUTINE SubRotate - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is called at the end of the simulation. -SUBROUTINE SD_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) - TYPE(SD_InputType), INTENT(INOUT) :: u !< System inputs - TYPE(SD_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(SD_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states - TYPE(SD_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states - TYPE(SD_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states - TYPE(SD_OtherStateType), INTENT(INOUT) :: OtherState !< Other states - TYPE(SD_OutputType), INTENT(INOUT) :: y !< System outputs - TYPE(SD_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 - ErrStat = ErrID_None - ErrMsg = "" - - ! Determine if we need to close the output file - IF ( p%OutSwtch == 1 .OR. p%OutSwtch == 3 ) THEN - IF ((m%Decimat .EQ. p%OutDec) .OR. (m%Decimat .EQ. 0)) THEN - ! Write out the last stored set of outputs before closing - CALL SDOut_WriteOutputs( p%UnJckF, m%LastOutTime, m%SDWrOutput, p, ErrStat, ErrMsg ) - ENDIF - CALL SDOut_CloseOutput( p, ErrStat, ErrMsg ) - END IF - - ! Destroy data - CALL SD_DestroyInput( u, ErrStat, ErrMsg ) - CALL SD_DestroyParam( p, ErrStat, ErrMsg ) - CALL SD_DestroyContState( x, ErrStat, ErrMsg ) - CALL SD_DestroyDiscState( xd, ErrStat, ErrMsg ) - CALL SD_DestroyConstrState( z, ErrStat, ErrMsg ) - CALL SD_DestroyOtherState( OtherState, ErrStat, ErrMsg ) - CALL SD_DestroyMisc( m, ErrStat, ErrMsg ) - CALL SD_DestroyOutput( y, ErrStat, ErrMsg ) - -END SUBROUTINE SD_End - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine implements the fourth-order Adams-Bashforth Method (RK4) for numerically integrating ordinary differential -!! equations: -!! -!! Let f(t, x) = xdot denote the time (t) derivative of the continuous states (x). -!! -!! x(t+dt) = x(t) + (dt / 24.) * ( 55.*f(t,x) - 59.*f(t-dt,x) + 37.*f(t-2.*dt,x) - 9.*f(t-3.*dt,x) ) -!! -!! See, e.g., -!! - http://en.wikipedia.org/wiki/Linear_multistep_method -!! - K. E. Atkinson, "An Introduction to Numerical Analysis", 1989, John Wiley & Sons, Inc, Second Edition. -SUBROUTINE SD_AB4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - INTEGER(IntKi), INTENT(IN ) :: n !< time step number - TYPE(SD_InputType), INTENT(INOUT) :: u(:) !< Inputs at t - REAL(DbKi), INTENT(IN ) :: utimes(:) !< times of input - TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SD_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at t on input at t + dt on output - TYPE(SD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(SD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t (possibly a guess) - TYPE(SD_OtherStateType), INTENT(INOUT) :: OtherState !< Other states at t on input at t + dt on output - TYPE(SD_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 - ! local variables - TYPE(SD_ContinuousStateType) :: xdot ! Continuous state derivs at t - TYPE(SD_InputType) :: u_interp - - ErrStat = ErrID_None - ErrMsg = "" - - ! need xdot at t - CALL SD_CopyInput(u(1), u_interp, MESH_NEWCOPY, ErrStat, ErrMsg ) ! we need to allocate input arrays/meshes before calling ExtrapInterp... - CALL SD_Input_ExtrapInterp(u, utimes, u_interp, t, ErrStat, ErrMsg) - CALL SD_CalcContStateDeriv( t, u_interp, p, x, xd, z, OtherState, m, xdot, ErrStat, ErrMsg ) ! initializes xdot - CALL SD_DestroyInput( u_interp, ErrStat, ErrMsg) ! we don't need this local copy anymore - - if (n <= 2) then - OtherState%n = n - !OtherState%xdot ( 3 - n ) = xdot - CALL SD_CopyContState( xdot, OtherState%xdot ( 3 - n ), MESH_UPDATECOPY, ErrStat, ErrMsg ) - CALL SD_RK4(t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) - else - if (OtherState%n < n) then - OtherState%n = n - CALL SD_CopyContState( OtherState%xdot ( 3 ), OtherState%xdot ( 4 ), MESH_UPDATECOPY, ErrStat, ErrMsg ) - CALL SD_CopyContState( OtherState%xdot ( 2 ), OtherState%xdot ( 3 ), MESH_UPDATECOPY, ErrStat, ErrMsg ) - CALL SD_CopyContState( OtherState%xdot ( 1 ), OtherState%xdot ( 2 ), MESH_UPDATECOPY, ErrStat, ErrMsg ) - !OtherState%xdot(4) = OtherState%xdot(3) - !OtherState%xdot(3) = OtherState%xdot(2) - !OtherState%xdot(2) = OtherState%xdot(1) - elseif (OtherState%n > n) then - ErrStat = ErrID_Fatal - ErrMsg = ' Backing up in time is not supported with a multistep method ' - RETURN - endif - CALL SD_CopyContState( xdot, OtherState%xdot ( 1 ), MESH_UPDATECOPY, ErrStat, ErrMsg ) - !OtherState%xdot ( 1 ) = xdot ! make sure this is most up to date - x%qm = x%qm + (p%SDDeltaT / 24.) * ( 55.*OtherState%xdot(1)%qm - 59.*OtherState%xdot(2)%qm + 37.*OtherState%xdot(3)%qm & - - 9. * OtherState%xdot(4)%qm ) - x%qmdot = x%qmdot + (p%SDDeltaT / 24.) * ( 55.*OtherState%xdot(1)%qmdot - 59.*OtherState%xdot(2)%qmdot & - + 37.*OtherState%xdot(3)%qmdot - 9.*OtherState%xdot(4)%qmdot ) - endif - CALL SD_DestroyContState(xdot, ErrStat, ErrMsg) - CALL SD_DestroyInput(u_interp, ErrStat, ErrMsg) -END SUBROUTINE SD_AB4 - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine implements the fourth-order Adams-Bashforth-Moulton Method (RK4) for numerically integrating ordinary -!! differential equations: -!! -!! Let f(t, x) = xdot denote the time (t) derivative of the continuous states (x). -!! -!! Adams-Bashforth Predictor: -!! x^p(t+dt) = x(t) + (dt / 24.) * ( 55.*f(t,x) - 59.*f(t-dt,x) + 37.*f(t-2.*dt,x) - 9.*f(t-3.*dt,x) ) -!! -!! Adams-Moulton Corrector: -!! x(t+dt) = x(t) + (dt / 24.) * ( 9.*f(t+dt,x^p) + 19.*f(t,x) - 5.*f(t-dt,x) + 1.*f(t-2.*dt,x) ) -!! -!! See, e.g., -!! - http://en.wikipedia.org/wiki/Linear_multistep_method -!! - K. E. Atkinson, "An Introduction to Numerical Analysis", 1989, John Wiley & Sons, Inc, Second Edition. -SUBROUTINE SD_ABM4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - INTEGER(IntKi), INTENT(IN ) :: n !< time step number - TYPE(SD_InputType), INTENT(INOUT) :: u(:) !< Inputs at t - REAL(DbKi), INTENT(IN ) :: utimes(:) !< times of input - TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SD_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at t on input at t + dt on output - TYPE(SD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(SD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t (possibly a guess) - TYPE(SD_OtherStateType), INTENT(INOUT) :: OtherState !< Other states at t on input at t + dt on output - TYPE(SD_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 - ! local variables - TYPE(SD_InputType) :: u_interp ! Continuous states at t - TYPE(SD_ContinuousStateType) :: x_pred ! Continuous states at t - TYPE(SD_ContinuousStateType) :: xdot_pred ! Continuous states at t - - ErrStat = ErrID_None - ErrMsg = "" - - CALL SD_CopyContState(x, x_pred, MESH_NEWCOPY, ErrStat, ErrMsg) !initialize x_pred - CALL SD_AB4( t, n, u, utimes, p, x_pred, xd, z, OtherState, m, ErrStat, ErrMsg ) - - if (n > 2) then - CALL SD_CopyInput( u(1), u_interp, MESH_NEWCOPY, ErrStat, ErrMsg) ! make copy so that arrays/meshes get initialized/allocated for ExtrapInterp - CALL SD_Input_ExtrapInterp(u, utimes, u_interp, t + p%SDDeltaT, ErrStat, ErrMsg) - - CALL SD_CalcContStateDeriv(t + p%SDDeltaT, u_interp, p, x_pred, xd, z, OtherState, m, xdot_pred, ErrStat, ErrMsg ) ! initializes xdot_pred - CALL SD_DestroyInput( u_interp, ErrStat, ErrMsg) ! local copy no longer needed - - x%qm = x%qm + (p%SDDeltaT / 24.) * ( 9. * xdot_pred%qm + 19. * OtherState%xdot(1)%qm - 5. * OtherState%xdot(2)%qm & - + 1. * OtherState%xdot(3)%qm ) - - x%qmdot = x%qmdot + (p%SDDeltaT / 24.) * ( 9. * xdot_pred%qmdot + 19. * OtherState%xdot(1)%qmdot - 5. * OtherState%xdot(2)%qmdot & - + 1. * OtherState%xdot(3)%qmdot ) - CALL SD_DestroyContState( xdot_pred, ErrStat, ErrMsg) ! local copy no longer needed - else - x%qm = x_pred%qm - x%qmdot = x_pred%qmdot - endif - - CALL SD_DestroyContState( x_pred, ErrStat, ErrMsg) ! local copy no longer needed - -END SUBROUTINE SD_ABM4 - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine implements the fourth-order Runge-Kutta Method (RK4) for numerically integrating ordinary differential equations: -!! -!! Let f(t, x) = xdot denote the time (t) derivative of the continuous states (x). -!! Define constants k1, k2, k3, and k4 as -!! k1 = dt * f(t , x_t ) -!! k2 = dt * f(t + dt/2 , x_t + k1/2 ) -!! k3 = dt * f(t + dt/2 , x_t + k2/2 ), and -!! k4 = dt * f(t + dt , x_t + k3 ). -!! Then the continuous states at t = t + dt are -!! x_(t+dt) = x_t + k1/6 + k2/3 + k3/3 + k4/6 + O(dt^5) -!! -!! For details, see: -!! Press, W. H.; Flannery, B. P.; Teukolsky, S. A.; and Vetterling, W. T. "Runge-Kutta Method" and "Adaptive Step Size Control for -!! Runge-Kutta." sections 16.1 and 16.2 in Numerical Recipes in FORTRAN: The Art of Scientific Computing, 2nd ed. Cambridge, England: -!! Cambridge University Press, pp. 704-716, 1992. -SUBROUTINE SD_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - INTEGER(IntKi), INTENT(IN ) :: n !< time step number - TYPE(SD_InputType), INTENT(INOUT) :: u(:) !< Inputs at t - REAL(DbKi), INTENT(IN ) :: utimes(:) !< times of input - TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SD_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at t on input at t + dt on output - TYPE(SD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(SD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t (possibly a guess) - TYPE(SD_OtherStateType), INTENT(INOUT) :: OtherState !< Other states at t on input at t + dt on output - TYPE(SD_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 - ! local variables - TYPE(SD_ContinuousStateType) :: xdot ! time derivatives of continuous states - TYPE(SD_ContinuousStateType) :: k1 ! RK4 constant; see above - TYPE(SD_ContinuousStateType) :: k2 ! RK4 constant; see above - TYPE(SD_ContinuousStateType) :: k3 ! RK4 constant; see above - TYPE(SD_ContinuousStateType) :: k4 ! RK4 constant; see above - TYPE(SD_ContinuousStateType) :: x_tmp ! Holds temporary modification to x - TYPE(SD_InputType) :: u_interp ! interpolated value of inputs - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - - ! Initialize interim vars - !bjj: the state type contains allocatable arrays, so we must first allocate space: - CALL SD_CopyContState( x, k1, MESH_NEWCOPY, ErrStat, ErrMsg ) - CALL SD_CopyContState( x, k2, MESH_NEWCOPY, ErrStat, ErrMsg ) - CALL SD_CopyContState( x, k3, MESH_NEWCOPY, ErrStat, ErrMsg ) - CALL SD_CopyContState( x, k4, MESH_NEWCOPY, ErrStat, ErrMsg ) - CALL SD_CopyContState( x, x_tmp, MESH_NEWCOPY, ErrStat, ErrMsg ) - - ! interpolate u to find u_interp = u(t) - CALL SD_CopyInput(u(1), u_interp, MESH_NEWCOPY, ErrStat, ErrMsg ) ! we need to allocate input arrays/meshes before calling ExtrapInterp... - CALL SD_Input_ExtrapInterp( u, utimes, u_interp, t, ErrStat, ErrMsg ) - - ! find xdot at t - CALL SD_CalcContStateDeriv( t, u_interp, p, x, xd, z, OtherState, m, xdot, ErrStat, ErrMsg ) !initializes xdot - k1%qm = p%SDDeltaT * xdot%qm - k1%qmdot = p%SDDeltaT * xdot%qmdot - x_tmp%qm = x%qm + 0.5 * k1%qm - x_tmp%qmdot = x%qmdot + 0.5 * k1%qmdot - ! interpolate u to find u_interp = u(t + dt/2) - CALL SD_Input_ExtrapInterp(u, utimes, u_interp, t+0.5*p%SDDeltaT, ErrStat, ErrMsg) - - ! find xdot at t + dt/2 - CALL SD_CalcContStateDeriv( t + 0.5*p%SDDeltaT, u_interp, p, x_tmp, xd, z, OtherState, m, xdot, ErrStat, ErrMsg ) - k2%qm = p%SDDeltaT * xdot%qm - k2%qmdot = p%SDDeltaT * xdot%qmdot - x_tmp%qm = x%qm + 0.5 * k2%qm - x_tmp%qmdot = x%qmdot + 0.5 * k2%qmdot - - ! find xdot at t + dt/2 - CALL SD_CalcContStateDeriv( t + 0.5*p%SDDeltaT, u_interp, p, x_tmp, xd, z, OtherState, m, xdot, ErrStat, ErrMsg ) - k3%qm = p%SDDeltaT * xdot%qm - k3%qmdot = p%SDDeltaT * xdot%qmdot - x_tmp%qm = x%qm + k3%qm - x_tmp%qmdot = x%qmdot + k3%qmdot - ! interpolate u to find u_interp = u(t + dt) - CALL SD_Input_ExtrapInterp(u, utimes, u_interp, t + p%SDDeltaT, ErrStat, ErrMsg) - - ! find xdot at t + dt - CALL SD_CalcContStateDeriv( t + p%SDDeltaT, u_interp, p, x_tmp, xd, z, OtherState, m, xdot, ErrStat, ErrMsg ) - k4%qm = p%SDDeltaT * xdot%qm - k4%qmdot = p%SDDeltaT * xdot%qmdot - x%qm = x%qm + ( k1%qm + 2. * k2%qm + 2. * k3%qm + k4%qm ) / 6. - x%qmdot = x%qmdot + ( k1%qmdot + 2. * k2%qmdot + 2. * k3%qmdot + k4%qmdot ) / 6. - - CALL CleanUp() - -CONTAINS - - SUBROUTINE CleanUp() - INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) - CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) - CALL SD_DestroyContState( xdot, ErrStat3, ErrMsg3 ) - CALL SD_DestroyContState( k1, ErrStat3, ErrMsg3 ) - CALL SD_DestroyContState( k2, ErrStat3, ErrMsg3 ) - CALL SD_DestroyContState( k3, ErrStat3, ErrMsg3 ) - CALL SD_DestroyContState( k4, ErrStat3, ErrMsg3 ) - CALL SD_DestroyContState( x_tmp, ErrStat3, ErrMsg3 ) - CALL SD_DestroyInput( u_interp, ErrStat3, ErrMsg3 ) - END SUBROUTINE CleanUp - -END SUBROUTINE SD_RK4 - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine implements the 2nd-order Adams-Moulton Implicit Method (AM2,Trapezoidal rule) for numerically integrating ordinary differential equations: -!! -!! Let f(t, x) = xdot denote the time (t) derivative of the continuous states (x). -!! Define constants k1, k2, k3, and k4 as -!! k1 = f(t , x_t ) -!! k2 = f(t + dt , x_t+dt ) -!! Then the continuous states at t = t + dt are -!! x_(t+dt) =x_n+1 = x_t + deltat/2*(k1 + k2) + O(dt^3) -!! Now this can be re-written as: 0=Z(x_n+1) = x_n - x_n+1 +dt/2 *(f_n + f_n+1) = 0 -!! f_n= A*x_n + B*u_n + Fx from Eq. 1.12 of the manual -!! So to solve this linear system, I can just use x(k)=x(k-1) -J^-1 * Z(x(k-1)) (this is a simple root solver of the linear equation) -!! with J=dZ/dx_n+1 = -I +dt/2*A -!! -!! Thus x_n+1 = x_n - J^-1 *dt/2 * (2*A*x_n + B *(u_n + u_n+1) +2*Fx) -!! or J*( x_n - x_n+1 ) = dt * ( A*x_n + B *(u_n + u_n+1)/2 + Fx) -SUBROUTINE SD_AM2( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) - USE NWTC_LAPACK, only: LAPACK_getrs - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - INTEGER(IntKi), INTENT(IN ) :: n !< time step number - TYPE(SD_InputType), INTENT(INOUT) :: u(:) !< Inputs at t - REAL(DbKi), INTENT(IN ) :: utimes(:) !< times of input - TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SD_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at t on input at t + dt on output - TYPE(SD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(SD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t (possibly a guess) - TYPE(SD_OtherStateType), INTENT(INOUT) :: OtherState !< Other states at t on input at t + dt on output - TYPE(SD_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 - ! local variables - TYPE(SD_InputType) :: u_interp ! interpolated value of inputs - REAL(ReKi) :: xq(2*p%nDOFM) !temporary states (qm and qmdot only) - REAL(ReKi) :: udotdot_TP2(6) ! temporary copy of udotdot_TP - REAL(ReKi) :: F_L2(p%nDOF__L) ! temporary copy of F_L - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - - ErrStat = ErrID_None - ErrMsg = "" - - ! Initialize interim vars - CALL SD_CopyInput( u(1), u_interp, MESH_NEWCOPY, ErrStat2,ErrMsg2);CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SD_AM2') - - !Start by getting u_n and u_n+1 - ! interpolate u to find u_interp = u(t) = u_n - CALL SD_Input_ExtrapInterp( u, utimes, u_interp, t, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SD_AM2') - CALL GetExtForceOnInternalDOF(u_interp, p, x, m, m%F_L, ErrStat2, ErrMsg2, GuyanLoadCorrection=(p%GuyanLoadCorrection.and..not.p%Floating), RotateLoads=(p%GuyanLoadCorrection.and.p%Floating)) - m%udotdot_TP = (/u_interp%TPMesh%TranslationAcc(:,1), u_interp%TPMesh%RotationAcc(:,1)/) - if (p%GuyanLoadCorrection.and.p%Floating) then - ! >>> Rotate All - udotdot_TP to body coordinates - m%udotdot_TP(1:3) = matmul(u_interp%TPMesh%Orientation(:,:,1), m%udotdot_TP(1:3)) - m%udotdot_TP(4:6) = matmul(u_interp%TPMesh%Orientation(:,:,1), m%udotdot_TP(4:6)) - endif - - ! extrapolate u to find u_interp = u(t + dt)=u_n+1 - CALL SD_Input_ExtrapInterp(u, utimes, u_interp, t+p%SDDeltaT, ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SD_AM2') - CALL GetExtForceOnInternalDOF(u_interp, p, x, m, F_L2, ErrStat2, ErrMsg2, GuyanLoadCorrection=(p%GuyanLoadCorrection.and..not.p%Floating), RotateLoads=(p%GuyanLoadCorrection.and.p%Floating)) - udotdot_TP2 = (/u_interp%TPMesh%TranslationAcc(:,1), u_interp%TPMesh%RotationAcc(:,1)/) - if (p%GuyanLoadCorrection.and.p%Floating) then - ! >>> Rotate All - udotdot_TP to body coordinates - udotdot_TP2(1:3) = matmul(u_interp%TPMesh%Orientation(:,:,1), udotdot_TP2(1:3)) - udotdot_TP2(4:6) = matmul(u_interp%TPMesh%Orientation(:,:,1), udotdot_TP2(4:6)) - endif - - ! calculate (u_n + u_n+1)/2 - udotdot_TP2 = 0.5_ReKi * ( udotdot_TP2 + m%udotdot_TP ) - F_L2 = 0.5_ReKi * ( F_L2 + m%F_L ) - - ! set xq = dt * ( A*x_n + B *(u_n + u_n+1)/2 + Fx) - xq( 1: p%nDOFM)=p%SDDeltaT * x%qmdot !upper portion of array - xq(1+p%nDOFM:2*p%nDOFM)=p%SDDeltaT * (-p%KMMDiag*x%qm - p%CMMDiag*x%qmdot - matmul(p%MMB, udotdot_TP2) + matmul(F_L2,p%PhiM )) !lower portion of array - ! note: matmul(F_L2,p%PhiM ) = matmul(p%PhiM_T,F_L2) because F_L2 is 1-D - - !.................................................... - ! Solve for xq: (equivalent to xq= matmul(p%AM2InvJac,xq) - ! J*( x_n - x_n+1 ) = dt * ( A*x_n + B *(u_n + u_n+1)/2 + Fx) - !.................................................... - CALL LAPACK_getrs( TRANS='N',N=SIZE(p%AM2Jac,1),A=p%AM2Jac,IPIV=p%AM2JacPiv, B=xq, ErrStat=ErrStat2, ErrMsg=ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SD_AM2') - - ! after the LAPACK solve, xq = ( x_n - x_n+1 ); so now we can solve for x_n+1: - x%qm = x%qm - xq( 1: p%nDOFM) - x%qmdot = x%qmdot - xq(p%nDOFM+1:2*p%nDOFM) - - ! clean up temporary variable(s) - CALL SD_DestroyInput( u_interp, ErrStat, ErrMsg ) - -END SUBROUTINE SD_AM2 - -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -! ###### The following four routines are Jacobian routines for linearization capabilities ####### -! If the module does not implement them, set ErrStat = ErrID_Fatal in SD_Init() when InitInp%Linearize is .true. -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and DZ/du are returned. -SUBROUTINE SD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(SD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(SD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(SD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(SD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(SD_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); Output fields are not used by this routine, but type is available here so that mesh parameter information (i.e., connectivity) does not have to be recalculated for dYdu. - TYPE(SD_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 - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) wrt the inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) wrt the inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) wrt the inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) wrt the inputs (u) [intent in to avoid deallocation] - ! local variables - TYPE(SD_OutputType) :: y_m, y_p - TYPE(SD_ContinuousStateType) :: x_m, x_p - TYPE(SD_InputType) :: u_perturb - REAL(R8Ki) :: delta_p, delta_m ! delta change in input (plus, minus) - INTEGER(IntKi) :: i - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SD_JacobianPInput' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = '' - ! get OP values here: - call SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ); if(Failed()) return - ! make a copy of the inputs to perturb - call SD_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - IF ( PRESENT( dYdu ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: - if (.not. allocated(dYdu) ) then - call AllocAry(dYdu,p%Jac_ny, size(p%Jac_u_indx,1),'dYdu', ErrStat2, ErrMsg2); if(Failed()) return - end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call SD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - call SD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - do i=1,size(p%Jac_u_indx,1) - ! get u_op + delta_p u - call SD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_Perturb_u( p, i, 1, u_perturb, delta_p ) - ! compute y at u_op + delta_p u - call SD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get u_op - delta_m u - call SD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_Perturb_u( p, i, -1, u_perturb, delta_m ) - ! compute y at u_op - delta_m u - call SD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get central difference: - call SD_Compute_dY( p, y_p, y_m, delta_p, dYdu(:,i) ) - end do - if(Failed()) return - END IF - IF ( PRESENT( dXdu ) ) THEN - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: - ! TODO: dXdu should be constant, in theory we dont' need to recompute it - !if(ANALYTICAL_LIN) then - ! Analytical lin cannot be used anymore with extra mom - ! call StateMatrices(p, ErrStat2, ErrMsg2, BB=dXdu); if(Failed()) return ! Allocation occurs in function - !else - if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%Jac_nx * 2, size(p%Jac_u_indx,1), 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return - endif - do i=1,size(p%Jac_u_indx,1) - ! get u_op + delta u - call SD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_Perturb_u( p, i, 1, u_perturb, delta_p ) - ! compute x at u_op + delta u - call SD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get u_op - delta u - call SD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_Perturb_u( p, i, -1, u_perturb, delta_m ) - ! compute x at u_op - delta u - call SD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get central difference: - ! we may have had an error allocating memory, so we'll check - if(Failed()) return - ! get central difference: - call SD_Compute_dX( p, x_p, x_m, delta_p, dXdu(:,i) ) - end do - !endif ! analytical or numerical - END IF ! dXdu - IF ( PRESENT( dXddu ) ) THEN - if (allocated(dXddu)) deallocate(dXddu) - END IF - IF ( PRESENT( dZdu ) ) THEN - if (allocated(dZdu)) deallocate(dZdu) - 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() - call SD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call SD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - call SD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call SD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call SD_DestroyInput(u_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - -END SUBROUTINE SD_JacobianPInput -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. -SUBROUTINE SD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(SD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(SD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(SD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(SD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(SD_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); Output fields are not used by this routine, but type is available here so that mesh parameter information (i.e., connectivity) does not have to be recalculated for dYdx. - TYPE(SD_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 - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions wrt the continuous states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) wrt the continuous states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) wrt the continuous states (x) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) wrt the continuous states (x) [intent in to avoid deallocation] - ! local variables - TYPE(SD_OutputType) :: y_p, y_m - TYPE(SD_ContinuousStateType) :: x_p, x_m - TYPE(SD_ContinuousStateType) :: x_perturb - REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, k - INTEGER(IntKi) :: idx - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_JacobianPContState' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = '' - ! make a copy of the continuous states to perturb NOTE: MESH_NEWCOPY - call SD_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - IF ( PRESENT( dYdx ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: - if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Jac_ny, p%Jac_nx*2, 'dYdx', ErrStat2, ErrMsg2); if(Failed()) return - end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call SD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return - idx = 1 - do k=1,2 ! 1=disp, 2=veloc - do i=1,p%Jac_nx ! CB mode - ! get x_op + delta x - call SD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_perturb_x(p, k, i, 1, x_perturb, delta ) - ! compute y at x_op + delta x - call SD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get x_op - delta x - call SD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_perturb_x(p, k, i, -1, x_perturb, delta ) - ! compute y at x_op - delta x - call SD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get central difference: - call SD_Compute_dY( p, y_p, y_m, delta, dYdx(:,idx) ) - idx = idx+1 - end do - end do - if(Failed()) return - END IF - IF ( PRESENT( dXdx ) ) THEN - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: - ! TODO: dXdx should be constant, in theory we don't need to recompute it - if(ANALYTICAL_LIN) then - call StateMatrices(p, ErrStat2, ErrMsg2, AA=dXdx); if(Failed()) return ! Allocation occurs in function - else - if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%Jac_nx * 2, p%Jac_nx * 2, 'dXdx', ErrStat2, ErrMsg2); if(Failed()) return - end if - idx = 1 ! counter into dXdx - do k=1,2 ! 1=positions (x_perturb%q); 2=velocities (x_perturb%dqdt) - do i=1,p%Jac_nx - ! get x_op + delta x - call SD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_perturb_x(p, k, i, 1, x_perturb, delta ) - ! compute x at x_op + delta x - call SD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get x_op - delta x - call SD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SD_perturb_x(p, k, i, -1, x_perturb, delta ) - ! compute x at x_op - delta x - call SD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if(Failed()) return - ! get central difference: - call SD_Compute_dX( p, x_p, x_m, delta, dXdx(:,idx) ) - idx = idx+1 - end do - end do - endif ! analytical or numerical - END IF - IF ( PRESENT( dXddx ) ) THEN - if (allocated(dXddx)) deallocate(dXddx) - END IF - IF ( PRESENT( dZdx ) ) THEN - if (allocated(dZdx)) deallocate(dZdx) - END IF - call CleanUp() - -contains - - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_JacobianPContState') - Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() - end function Failed - - subroutine CleanUp() - call SD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call SD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call SD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) - call SD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) - call SD_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - -END SUBROUTINE SD_JacobianPContState - -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the discrete states (xd). The partial derivatives dY/dxd, dX/dxd, dXd/dxd, and DZ/dxd are returned. -SUBROUTINE SD_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(SD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(SD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(SD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(SD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(SD_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); Output fields are not used by this routine, but type is available here so that mesh parameter information (i.e., connectivity) does not have to be recalculated for dYdx. - TYPE(SD_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 - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdxd(:,:) !< Partial derivatives of output functions (Y) wrt the discrete states (xd) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdxd(:,:) !< Partial derivatives of continuous state functions (X) wrt the discrete states (xd) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddxd(:,:)!< Partial derivatives of discrete state functions (Xd) wrt the discrete states (xd) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdxd(:,:) !< Partial derivatives of constraint state functions (Z) wrt discrete states (xd) [intent in to avoid deallocation] - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = '' - IF ( PRESENT( dYdxd ) ) THEN - END IF - IF ( PRESENT( dXdxd ) ) THEN - END IF - IF ( PRESENT( dXddxd ) ) THEN - END IF - IF ( PRESENT( dZdxd ) ) THEN - END IF -END SUBROUTINE SD_JacobianPDiscState -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the constraint states (z). The partial derivatives dY/dz, dX/dz, dXd/dz, and DZ/dz are returned. -SUBROUTINE SD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(SD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(SD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(SD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(SD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(SD_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); Output fields are not used by this routine, but type is available here so that mesh parameter information (i.e., connectivity) does not have to be recalculated for dYdx. - TYPE(SD_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 - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdz(:,:) !< Partial derivatives of output functions (Y) with respect to the constraint states (z) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdz(:,:) !< Partial derivatives of continuous state functions (X) with respect to the constraint states (z) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddz(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the constraint states (z) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdz(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the constraint states (z) [intent in to avoid deallocation] - ! local variables - character(*), parameter :: RoutineName = 'SD_JacobianPConstrState' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = '' - IF ( PRESENT( dYdz ) ) THEN - END IF - IF ( PRESENT( dXdz ) ) THEN - if (allocated(dXdz)) deallocate(dXdz) - END IF - IF ( PRESENT( dXddz ) ) THEN - if (allocated(dXddz)) deallocate(dXddz) - END IF - IF ( PRESENT(dZdz) ) THEN - END IF -END SUBROUTINE SD_JacobianPConstrState -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE SD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(SD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(SD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(SD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(SD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(SD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(SD_OutputType), INTENT(IN ) :: y !< Output at operating point - TYPE(SD_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 - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - ! Local - INTEGER(IntKi) :: idx, i - INTEGER(IntKi) :: nu - INTEGER(IntKi) :: ny - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_GetOP' - LOGICAL :: FieldMask(FIELDMASK_SIZE) - TYPE(SD_ContinuousStateType) :: dx ! derivative of continuous states at operating point - ErrStat = ErrID_None - ErrMsg = '' - IF ( PRESENT( u_op ) ) THEN - nu = size(p%Jac_u_indx,1) + u%TPMesh%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) - if (.not. allocated(u_op)) then - call AllocAry(u_op, nu, 'u_op', ErrStat2, ErrMsg2); if(Failed()) return - end if - idx = 1 - FieldMask = .false. - FieldMask(MASKID_TranslationDisp) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TranslationVel) = .true. - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TranslationAcc) = .true. - FieldMask(MASKID_RotationAcc) = .true. - call PackMotionMesh(u%TPMesh, u_op, idx, FieldMask=FieldMask) - call PackLoadMesh(u%LMesh, u_op, idx) - END IF - IF ( PRESENT( y_op ) ) THEN - ny = p%Jac_ny + y%Y2Mesh%NNodes * 6 ! Jac_ny has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) - if (.not. allocated(y_op)) then - call AllocAry(y_op, ny, 'y_op', ErrStat2, ErrMsg2); if(Failed()) return - end if - idx = 1 - call PackLoadMesh(y%Y1Mesh, y_op, idx) - FieldMask = .false. - FieldMask(MASKID_TranslationDisp) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TranslationVel) = .true. - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TranslationAcc) = .true. - FieldMask(MASKID_RotationAcc) = .true. - call PackMotionMesh(y%Y2Mesh, y_op, idx, FieldMask=FieldMask) - idx = idx - 1 - do i=1,p%NumOuts - y_op(i+idx) = y%WriteOutput(i) - end do - END IF - IF ( PRESENT( x_op ) ) THEN - if (.not. allocated(x_op)) then - call AllocAry(x_op, p%Jac_nx*2,'x_op',ErrStat2,ErrMsg2); if (Failed()) return - end if - do i=1, p%Jac_nx - x_op(i) = x%qm(i) - end do - do i=1, p%Jac_nx - x_op(i+p%nDOFM) = x%qmdot(i) - end do - END IF - IF ( PRESENT( dx_op ) ) THEN - if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%Jac_nx * 2,'dx_op',ErrStat2,ErrMsg2); if(failed()) return - end if - call SD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2 ) ; if(Failed()) return - idx = 1 - do i=1, p%Jac_nx - dx_op(i) = dx%qm(i) - end do - do i=1, p%Jac_nx - dx_op(i+p%nDOFM) = dx%qmdot(i) - end do - END IF - IF ( PRESENT( xd_op ) ) THEN - ! pass - END IF - IF ( PRESENT( z_op ) ) THEN - ! pass - END IF - call CleanUp() -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'Craig_Bampton') - Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() - end function Failed - - subroutine CleanUp() - call SD_DestroyContState(dx, ErrStat2, ErrMsg2); - end subroutine -END SUBROUTINE SD_GetOP -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!------------------------------------------------------------------------------------------------------ -!> Perform Craig Bampton (CB) reduction and set parameters needed for States and Ouputs equations -!! Sets the following values, as documented in the SubDyn Theory Guide: -!! CB%OmegaL (omega) and CB%PhiL from Eq. 2 -!! p%PhiL_T and p%PhiLInvOmgL2 for static improvement -!! CB%PhiR from Eq. 3 -!! CB%MBB, CB%MBM, and CB%KBB from Eq. 4. -SUBROUTINE SD_Craig_Bampton(Init, p, CB, ErrStat, ErrMsg) - TYPE(SD_InitType), INTENT(INOUT) :: Init ! Input data for initialization routine - TYPE(SD_ParameterType),INTENT(INOUT),target::p ! Parameters - TYPE(CB_MatArrays), INTENT(INOUT) :: CB ! CB parameters that will be passed out for summary file use - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(FEKi), ALLOCATABLE :: PhiRb(:, :) ! Purely to avoid loosing these modes for output ! TODO, kept for backward compatibility of Summary file - REAL(ReKi) :: JDamping1 ! temporary storage for first element of JDamping array - INTEGER(IntKi) :: nR !< Dimension of R DOFs (to switch between __R and R__) - INTEGER(IntKi) :: nL, nM, nM_out - INTEGER(IntKi), pointer :: IDR(:) !< Alias to switch between IDR__ and ID__Rb - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SD_Craig_Bampton' - ErrStat = ErrID_None - ErrMsg = "" - - IF(Init%CBMod) THEN ! C-B reduction - ! check number of internal modes - IF(p%nDOFM > p%nDOFL_L) THEN - CALL Fatal('Number of internal modes is larger than number of internal DOFs.') - return - ENDIF - ELSE ! full FEM - p%nDOFM = p%nDOFL_L - !Jdampings need to be reallocated here because nDOFL not known during Init - !So assign value to one temporary variable - JDamping1=Init%Jdampings(1) - DEALLOCATE(Init%JDampings) - CALL AllocAry( Init%JDampings, p%nDOFL_L, 'Init%JDampings', ErrStat2, ErrMsg2 ) ; if(Failed()) return - Init%JDampings = JDamping1 ! set default values for all modes - ENDIF - - CALL AllocParameters(p, p%nDOFM, ErrStat2, ErrMsg2); ; if (Failed()) return - ! Switch between BC before or after CB, KEEP ME - if(BC_Before_CB) then - !print*,' > Boundary conditions will be applied before Craig-Bampton (New)' - nR = p%nDOF__Rb ! we remove the Fixed BC before performing the CB-reduction - IDR => p%ID__Rb - else - !print*,' > Craig-Bampton will be applied before boundary conditions (Legacy)' - nR = p%nDOFR__ ! Old way, applying CB on full unconstrained system - IDR => p%IDR__ - endif - - IF (p%SttcSolve/=idSIM_None) THEN ! STATIC TREATMENT IMPROVEMENT - nM_out=p%nDOF__L ! Selecting all CB modes for outputs to the function below - ELSE - nM_out=p%nDOFM ! Selecting only the requrested number of CB modes - ENDIF - nL = p%nDOF__L - nM = p%nDOFM - - CALL WrScr(' Performing Craig-Bampton reduction '//trim(Num2LStr(p%nDOF_red))//' DOFs -> '//trim(Num2LStr(p%nDOFM))//' modes + '//trim(Num2LStr(p%nDOF__Rb))//' DOFs') - CALL AllocAry( CB%MBB, nR, nR, 'CB%MBB', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry( CB%MBM, nR, nM, 'CB%MBM', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry( CB%KBB, nR, nR, 'CB%KBB', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry( CB%PhiL, nL, nM_out,'CB%PhiL', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry( CB%PhiR, nL, nR, 'CB%PhiR', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry( CB%OmegaL, nM_out, 'CB%OmegaL', ErrStat2, ErrMsg2 ); if(Failed()) return - - CALL CraigBamptonReduction(Init%M, Init%K, IDR, nR, p%ID__L, nL, nM, nM_out, CB%MBB, CB%MBM, CB%KBB, CB%PhiL, CB%PhiR, CB%OmegaL, ErrStat2, ErrMsg2) - if(Failed()) return - - CALL AllocAry(PhiRb, nL, nR, 'PhiRb', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if(.not.BC_Before_CB) then - ! We apply the BC now, removing unwanted DOFs - call applyConstr(CB, PhiRb) ! Reduces size of CB%MBB, CB%KBB, CB%MBM, NOTE: "L" unaffected - else - PhiRb=CB%PhiR ! Remove me in the future - endif - ! TODO, right now using PhiRb instead of CB%PhiR, keeping PhiR in harmony with OmegaL for SummaryFile - CALL SetParameters(Init, p, CB%MBB, CB%MBM, CB%KBB, PhiRb, nM_out, CB%OmegaL, CB%PhiL, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'Craig_Bampton') - - CALL CleanUpCB() - -contains - - SUBROUTINE Fatal(ErrMsg_in) - character(len=*), intent(in) :: ErrMsg_in - CALL SetErrStat(ErrID_Fatal, ErrMsg_in, ErrStat, ErrMsg, 'Craig_Bampton'); - CALL CleanUpCB() - END SUBROUTINE Fatal - - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'Craig_Bampton') - Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUpCB() - end function Failed - - subroutine CleanUpCB() - IF(ALLOCATED(PhiRb)) DEALLOCATE(PhiRb) - end subroutine CleanUpCB - - !> Remove fixed DOF from system, this is in case the CB was done on an unconstrained system - !! NOTE: PhiL and OmegaL are not modified - subroutine applyConstr(CBParams, PhiRb) - TYPE(CB_MatArrays), INTENT(INOUT) :: CBparams !< NOTE: data will be reduced (andw hence reallocated) - REAL(FEKi),ALLOCATABLE,INTENT(INOUT) :: PhiRb(:,:)!< NOTE: data will be reduced (andw hence reallocated) - !REAL(ReKi), ALLOCATABLE :: PhiRb(:, :) - REAL(FEKi), ALLOCATABLE :: MBBb(:, :) - REAL(FEKi), ALLOCATABLE :: MBMb(:, :) - REAL(FEKi), ALLOCATABLE :: KBBb(:, :) - ! "b" stands for "bar" - CALL AllocAry( MBBb, p%nDOF__Rb, p%nDOF__Rb, 'matrix MBBb', ErrStat2, ErrMsg2 ); - CALL AllocAry( MBmb, p%nDOF__Rb, p%nDOFM, 'matrix MBmb', ErrStat2, ErrMsg2 ); - CALL AllocAry( KBBb, p%nDOF__Rb, p%nDOF__Rb, 'matrix KBBb', ErrStat2, ErrMsg2 ); - !CALL AllocAry( PhiRb, p%nDOF__L , p%nDOF__Rb, 'matrix PhiRb', ErrStat2, ErrMsg2 ); - !................................ - ! Convert CBparams%MBB , CBparams%MBM , CBparams%KBB , CBparams%PhiR , to - ! MBBb, MBMb, KBBb, PHiRb, - ! (throw out rows/columns of first matrices to create second matrices) - !................................ - ! TODO avoid this all together - MBBb = CBparams%MBB(p%nDOFR__-p%nDOFI__+1:p%nDOFR__, p%nDOFR__-p%nDOFI__+1:p%nDOFR__) - KBBb = CBparams%KBB(p%nDOFR__-p%nDOFI__+1:p%nDOFR__, p%nDOFR__-p%nDOFI__+1:p%nDOFR__) - IF (p%nDOFM > 0) THEN - MBMb = CBparams%MBM(p%nDOFR__-p%nDOFI__+1:p%nDOFR__, : ) - END IF - PhiRb = CBparams%PhiR( :, p%nDOFR__-p%nDOFI__+1:p%nDOFR__) - deallocate(CBparams%MBB) - deallocate(CBparams%KBB) - deallocate(CBparams%MBM) - !deallocate(CBparams%PhiR) - call move_alloc(MBBb, CBparams%MBB) - call move_alloc(KBBb, CBparams%KBB) - call move_alloc(MBMb, CBparams%MBM) - !call move_alloc(PhiRb, CBparams%PhiR) - end subroutine applyConstr - -END SUBROUTINE SD_Craig_Bampton - -!> Extract rigid body mass without SSI -!! NOTE: performs a Guyan reduction -SUBROUTINE SD_Guyan_RigidBodyMass(Init, p, MBB, ErrStat, ErrMsg) - type(SD_InitType), intent(inout) :: Init ! NOTE: Mass and Stiffness are modified but then set back to original - type(SD_ParameterType), intent(in ) :: p ! Parameters - real(FEKi), allocatable, intent(out) :: MBB(:,:) !< MBB - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< error message if errstat /= errid_none - integer(IntKi) :: nM, nR, nL, nM_out - real(FEKi), allocatable :: MBM(:, :) - real(FEKi), allocatable :: KBB(:, :) - real(FEKi), allocatable :: PhiL(:, :) - real(FEKi), allocatable :: PhiR(:, :) - real(FEKi), allocatable :: OmegaL(:) - character(*), parameter :: RoutineName = 'SD_Guyan_RigidBodyMass' - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - ! --- Remove SSI from Mass and stiffness matrix (NOTE: use NodesDOFred, reduced matrix) - CALL InsertSoilMatrices(Init%M, Init%K, p%NodesDOFred, Init, p, ErrStat2, ErrMsg2, Substract=.True.); - - ! --- Perform Guyan reduction to get MBB - nR = p%nDOFR__ ! Using interface + reaction nodes - nL = p%nDOF__L - nM = 0 ! No CB modes (Guyan) - nM_out = 0 - if(allocated(MBB)) deallocate(MBB) - CALL AllocAry( MBB, nR, nR, 'MBB', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry( MBM, nR, nM, 'MBM', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry( KBB, nR, nR, 'KBB', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry( PhiL, nL, nL, 'PhiL', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry( PhiR, nL, nR, 'PhiR', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry( OmegaL, nL, 'OmegaL', ErrStat2, ErrMsg2 ); if(Failed()) return - - CALL CraigBamptonReduction(Init%M, Init%K, p%IDR__, nR, p%ID__L, nL, nM, nM_Out, MBB, MBM, KBB, PhiL, PhiR, OmegaL, ErrStat2, ErrMsg2) - if(Failed()) return - - if(allocated(KBB) ) deallocate(KBB) - if(allocated(MBM) ) deallocate(MBM) - if(allocated(PhiR) ) deallocate(PhiR) - if(allocated(PhiL) ) deallocate(PhiL) - if(allocated(OmegaL)) deallocate(OmegaL) - - ! --- Insert SSI from Mass and stiffness matrix again - CALL InsertSoilMatrices(Init%M, Init%K, p%NodesDOFred, Init, p, ErrStat2, ErrMsg2, Substract=.False.); if(Failed()) return -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - end function Failed -END SUBROUTINE SD_Guyan_RigidBodyMass - -!------------------------------------------------------------------------------------------------------ -!> Set parameters to compute state and output equations -!! NOTE: this function converst from FEKi to ReKi -SUBROUTINE SetParameters(Init, p, MBBb, MBmb, KBBb, PhiRb, nM_out, OmegaL, PhiL, ErrStat, ErrMsg) - use NWTC_LAPACK, only: LAPACK_GEMM, LAPACK_getrf - TYPE(SD_InitType), INTENT(IN ) :: Init ! Input data for initialization routine - TYPE(SD_ParameterType), INTENT(INOUT) :: p ! Parameters - REAL(FEKi), INTENT(IN ) :: MBBb( p%nDOF__Rb, p%nDOF__Rb) ! Guyan mass matrix - REAL(FEKi), INTENT(IN ) :: MBMb( p%nDOF__Rb, p%nDOFM) - REAL(FEKi), INTENT(IN ) :: KBBb( p%nDOF__Rb, p%nDOF__Rb) ! Guyan stiffness matrix - integer(IntKi), INTENT(IN ) :: nM_out - REAL(FEKi), INTENT(IN ) :: PhiL ( p%nDOF__L, nM_out) - REAL(FEKi), INTENT(IN ) :: PhiRb( p%nDOF__L, p%nDOF__Rb) - REAL(FEKi), INTENT(IN ) :: OmegaL(nM_out) - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - real(FEKi), allocatable :: Temp(:,:) - real(ReKi) :: TI_transpose(nDOFL_TP,p%nDOFI__) !bjj: added this so we don't have to take the transpose 5+ times - integer(IntKi) :: I - integer(IntKi) :: n ! size of jacobian in AM2 calculation - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SetParameters' - real(ReKi) :: dt_max, freq_max - character(ErrMsgLen) :: Info - ErrStat = ErrID_None - ErrMsg = '' - - if (p%nDOFI__/=p%nDOF__Rb) then - ! Limitation due to the TI matrix, on the input U_R to the module for now - ErrMsg2='For now number of leader DOF has to be the same a Rb DOF' - ErrStat2=ErrID_Fatal - if(Failed()) return - endif - - ! Set TI, transformation matrix from interface DOFs to TP ref point (Note: TI allocated in AllocParameters) - CALL RigidTrnsf(Init, p, Init%TP_RefPoint, p%IDI__, p%nDOFI__, p%TI, ErrStat2, ErrMsg2); if(Failed()) return - TI_transpose = TRANSPOSE(p%TI) - - ! Store Static Improvement Method constants - if (p%SttcSolve /= idSIM_None) then - if (p%SttcSolve == idSIM_Full) then - CALL WrScr(' Using static improvement method for gravity and ext. loads') - else - CALL WrScr(' Using static improvement method for gravity only') - endif - ! Allocations - NOTE: type conversion belows from FEKi to ReKi - CALL AllocAry( p%PhiL_T, p%nDOF__L, p%nDOF__L, 'p%PhiL_T', ErrStat2, ErrMsg2 ); if(Failed())return - CALL AllocAry( p%PhiLInvOmgL2, p%nDOF__L, p%nDOF__L, 'p%PhiLInvOmgL2', ErrStat2, ErrMsg2 ); if(Failed())return - CALL AllocAry( p%KLLm1 , p%nDOF__L, p%nDOF__L, 'p%KLLm1', ErrStat2, ErrMsg2 ); if(Failed())return - ! TODO PhiL_T and PhiLInvOmgL2 may not be needed if KLLm1 is stored. - p%PhiL_T=TRANSPOSE(PhiL) !transpose of PhiL for static improvement - do I = 1, nM_out - p%PhiLInvOmgL2(:,I) = PhiL(:,I)* (1./OmegaL(I)**2) - enddo - ! KLL^-1 = [PhiL] x [OmegaL^2]^-1 x [PhiL]^t - !p%KLLm1 = MATMUL(p%PhiLInvOmgL2, p%PhiL_T) ! Inverse of KLL: KLL^-1 = [PhiL] x [OmegaL^2]^-1 x [PhiL]^t - CALL LAPACK_gemm( 'N', 'N', 1.0_ReKi, p%PhiLInvOmgL2, p%PhiL_T, 0.0_ReKi, p%KLLm1, ErrStat2, ErrMsg2); if(Failed()) return - endif - - ! block element of D2 matrix (D2_21, D2_42, & part of D2_62) - p%PhiRb_TI = MATMUL(PhiRb, p%TI) - - !............................... - ! equation 46-47 (used to be 9): - !............................... - p%MBB = MATMUL( MATMUL( TI_transpose, MBBb ), p%TI) != MBBt - p%KBB = MATMUL( MATMUL( TI_transpose, KBBb ), p%TI) != KBBt - - ! 6x6 Guyan Damping matrix - if (Init%GuyanDampMod == idGuyanDamp_None) then - ! No Damping - p%CBB = 0.0_ReKi - elseif (Init%GuyanDampMod == idGuyanDamp_Rayleigh) then - ! Rayleigh Damping - p%CBB = Init%RayleighDamp(1) * p%MBB + Init%RayleighDamp(2) * p%KBB - elseif (Init%GuyanDampMod == idGuyanDamp_66) then - ! User 6x6 matrix - if (size(p%CBB,1)/=6) then - ErrMsg='Cannot use 6x6 Guyan Damping matrix, number of interface DOFs is'//num2lstr(size(p%CBB,1)); ErrStat=ErrID_Fatal; - return - endif - p%CBB = Init%GuyanDampMat - endif - - !p%D1_15=-TI_transpose !this is 6x6NIN - IF ( p%nDOFM > 0 ) THEN ! These values don't exist for nDOFM=0; i.e., p%nDOFM == 0 - ! TODO cant use LAPACK due to type conversions FEKi->ReKi - p%MBM = MATMUL( TI_transpose, MBmb ) ! NOTE: type conversion - !CALL LAPACK_gemm( 'T', 'N', 1.0_ReKi, p%TI, MBmb, 0.0_ReKi, p%MBM, ErrStat2, ErrMsg2); if(Failed()) return - - p%MMB = TRANSPOSE( p%MBM ) != MMBt - - p%PhiM = real( PhiL(:,1:p%nDOFM), ReKi) - - ! A_21=-Kmm (diagonal), A_22=-Cmm (approximated as diagonal) - p%KMMDiag= OmegaL(1:p%nDOFM) * OmegaL(1:p%nDOFM) ! OmegaM is a one-dimensional array - p%CMMDiag = 2.0_ReKi * OmegaL(1:p%nDOFM) * Init%JDampings(1:p%nDOFM) ! Init%JDampings is also a one-dimensional array - - ! C1_11, C1_12 ( see eq 15 [multiply columns by diagonal matrix entries for diagonal multiply on the left]) - DO I = 1, p%nDOFM ! if (p%nDOFM=p%nDOFM=nDOFM == 0), this loop is skipped - p%C1_11(:, I) = -p%MBM(:, I)*p%KMMDiag(I) - p%C1_12(:, I) = -p%MBM(:, I)*p%CMMDiag(I) - ENDDO - - ! D1 Matrices - ! MBmt*MmBt - CALL LAPACK_GEMM( 'N', 'T', 1.0_ReKi, p%MBM, p%MBM, 0.0_ReKi, p%MBmmB, ErrStat2, ErrMsg2 ); if(Failed()) return ! MATMUL( p%MBM, p%MMB ) - - ! --- Intermediates D1_14 = D1_141 + D1_142 - !p%D1_141 = MATMUL(p%MBM, TRANSPOSE(p%PhiM)) - CALL LAPACK_GEMM( 'N', 'T', 1.0_ReKi, p%MBM, p%PhiM, 0.0_ReKi, p%D1_141, ErrStat2, ErrMsg2 ); if(Failed()) return - ! NOTE: cant use LAPACK due to type conversions FEKi->ReKi - p%D1_142 =- MATMUL(TI_transpose, TRANSPOSE(PhiRb)) - - - ! C2_21, C2_42 - ! C2_61, C2_62 - DO I = 1, p%nDOFM ! if (p%nDOFM=p%nDOFM=nDOFM == 0), this loop is skipped - p%C2_61(:, i) = -p%PhiM(:, i)*p%KMMDiag(i) - p%C2_62(:, i) = -p%PhiM(:, i)*p%CMMDiag(i) - ENDDO - - ! D2_53, D2_63, D2_64 - !p%D2_63 = p%PhiRb_TI - MATMUL( p%PhiM, p%MMB ) - CALL LAPACK_GEMM( 'N', 'N', 1.0_ReKi, p%PhiM, p%MMB, 0.0_ReKi, p%D2_63, ErrStat2, ErrMsg2 ); if(Failed()) return; - p%D2_63 = - p%D2_63 ! NOTE: removed Guyan acceleration - - !p%D2_64 = MATMUL( p%PhiM, p%PhiM_T ) - CALL LAPACK_GEMM( 'N', 'T', 1.0_ReKi, p%PhiM, p%PhiM, 0.0_ReKi, p%D2_64, ErrStat2, ErrMsg2 ); if(Failed()) return; - - !Now calculate a Jacobian used when AM2 is called and store in parameters - IF (p%IntMethod .EQ. 4) THEN ! Allocate Jacobian if AM2 is requested & if there are states (p%nDOFM > 0) - n=2*p%nDOFM - CALL AllocAry( p%AM2Jac, n, n, 'p%AM2InvJac', ErrStat2, ErrMsg2 ); if(Failed()) return - CALL AllocAry( p%AM2JacPiv, n, 'p%AM2JacPiv', ErrStat2, ErrMsg2 ); if(Failed()) return - - ! First we calculate the Jacobian: - ! (note the Jacobian is first stored as p%AM2InvJac) - p%AM2Jac=0. - DO i=1,p%nDOFM - p%AM2Jac(i+p%nDOFM,i ) =-p%SDdeltaT/2.*p%KMMDiag(i) !J21 - p%AM2Jac(i+p%nDOFM,i+p%nDOFM)=-p%SDdeltaT/2.*p%CMMDiag(i) !J22 -initialize - END DO - - DO I=1,p%nDOFM - p%AM2Jac(I,I)=-1. !J11 - p%AM2Jac(I,p%nDOFM+I)=p%SDdeltaT/2. !J12 - p%AM2Jac(p%nDOFM+I,p%nDOFM+I)=p%AM2Jac(p%nDOFM+I,p%nDOFM+I)-1 !J22 complete - ENDDO - ! Now need to factor it: - !I think it could be improved and made more efficient if we can say the matrix is positive definite - CALL LAPACK_getrf( n, n, p%AM2Jac, p%AM2JacPiv, ErrStat2, ErrMsg2); if(Failed()) return - END IF - - freq_max =maxval(OmegaL(1:p%nDOFM))/TwoPi - dt_max = 1/(20*freq_max) - !if (p%SDDeltaT>dt_max) then - ! print*,'info: time step may be too large compared to max SubDyn frequency.' - !endif - write(Info,'(3x,A,F8.5,A,F8.5,A,F8.5)') 'SubDyn recommended dt:',dt_max, ' - Current dt:', p%SDDeltaT,' - Max frequency:', freq_max - call WrScr(Info) - ELSE ! no retained modes, so - ! OmegaM, JDampings, PhiM, MBM, MMB, x don't exist in this case - ! p%D2_64 are zero in this case so we simplify the equations in the code, omitting these variables - ! p%D2_63 = p%PhiRb_TI in this case so we simplify the equations in the code, omitting storage of this variable - p%D1_141 = 0.0_ReKi - p%D1_142 = - MATMUL(TI_transpose, TRANSPOSE(PhiRb)) - END IF - -CONTAINS - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SetParameters') - Failed = ErrStat >= AbortErrLev - END FUNCTION Failed - -END SUBROUTINE SetParameters - -!------------------------------------------------------------------------------------------------------ -!> Allocate parameter arrays, based on the dimensions already set in the parameter data type. -SUBROUTINE AllocParameters(p, nDOFM, ErrStat, ErrMsg) - TYPE(SD_ParameterType), INTENT(INOUT) :: p ! Parameters - INTEGER(IntKi), INTENT( in) :: nDOFM - 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 - CHARACTER(ErrMsgLen) :: ErrMsg2 - ! initialize error handling: - ErrStat = ErrID_None - ErrMsg = "" - - CALL AllocAry( p%KBB, nDOFL_TP, nDOFL_TP, 'p%KBB', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - CALL AllocAry( p%CBB, nDOFL_TP, nDOFL_TP, 'p%CBB', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - CALL AllocAry( p%MBB, nDOFL_TP, nDOFL_TP, 'p%MBB', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - CALL AllocAry( p%TI, p%nDOFI__, 6, 'p%TI', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - CALL AllocAry( p%D1_141, nDOFL_TP, p%nDOF__L,'p%D1_141', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - CALL AllocAry( p%D1_142, nDOFL_TP, p%nDOF__L,'p%D1_142', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - CALL AllocAry( p%PhiRb_TI, p%nDOF__L, nDOFL_TP,'p%PhiRb_TI', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - - -if (p%nDOFM > 0 ) THEN - CALL AllocAry( p%MBM, nDOFL_TP, nDOFM, 'p%MBM', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - CALL AllocAry( p%MMB, nDOFM, nDOFL_TP, 'p%MMB', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - CALL AllocAry( p%KMMDiag, nDOFM, 'p%KMMDiag', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - CALL AllocAry( p%CMMDiag, nDOFM, 'p%CMMDiag', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - CALL AllocAry( p%C1_11, nDOFL_TP, nDOFM, 'p%C1_11', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - CALL AllocAry( p%C1_12, nDOFL_TP, nDOFM, 'p%C1_12', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - CALL AllocAry( p%PhiM, p%nDOF__L, nDOFM, 'p%PhiM', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - CALL AllocAry( p%C2_61, p%nDOF__L, nDOFM, 'p%C2_61', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - CALL AllocAry( p%C2_62, p%nDOF__L, nDOFM, 'p%C2_62', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - CALL AllocAry( p%MBmmB, nDOFL_TP, nDOFL_TP , 'p%MBmmB', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') ! is p%MBB when p%nDOFM == 0 - CALL AllocAry( p%D2_63, p%nDOF__L, nDOFL_TP, 'p%D2_63', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') ! is p%PhiRb_TI when p%nDOFM == 0 - CALL AllocAry( p%D2_64, p%nDOF__L, p%nDOF__L,'p%D2_64', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') ! is zero when p%nDOFM == 0 -end if - -END SUBROUTINE AllocParameters - -!------------------------------------------------------------------------------------------------------ -!> Allocate parameter arrays, based on the dimensions already set in the parameter data type. -SUBROUTINE AllocMiscVars(p, Misc, ErrStat, ErrMsg) - TYPE(SD_MiscVarType), INTENT(INOUT) :: Misc ! Miscellaneous values, used to avoid local copies and/or multiple allocation/deallocation of same variables each call - TYPE(SD_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 - CHARACTER(ErrMsgLen) :: ErrMsg2 - ! initialize error handling: - ErrStat = ErrID_None - ErrMsg = "" - - ! for readability, we're going to keep track of the max ErrStat through SetErrStat() and not return until the end of this routine. - CALL AllocAry( Misc%F_L, p%nDOF__L, 'F_L', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') - CALL AllocAry( Misc%UR_bar, p%nDOFI__, 'UR_bar', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') !TODO Rb - CALL AllocAry( Misc%UR_bar_dot, p%nDOFI__, 'UR_bar_dot', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') !TODO Rb - CALL AllocAry( Misc%UR_bar_dotdot,p%nDOFI__, 'UR_bar_dotdot', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') !TODO Rb - CALL AllocAry( Misc%UL, p%nDOF__L, 'UL', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') - CALL AllocAry( Misc%UL_dot, p%nDOF__L, 'UL_dot', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') - CALL AllocAry( Misc%UL_dotdot, p%nDOF__L, 'UL_dotdot', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') - CALL AllocAry( Misc%DU_full, p%nDOF, 'DU_full', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') - CALL AllocAry( Misc%U_full, p%nDOF, 'U_full', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') - CALL AllocAry( Misc%U_full_elast, p%nDOF, 'U_full_elast', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') - CALL AllocAry( Misc%U_full_dot, p%nDOF, 'U_full_dot', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') - CALL AllocAry( Misc%U_full_dotdot,p%nDOF, 'U_full_dotdot', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') - CALL AllocAry( Misc%U_red, p%nDOF_red, 'U_red', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') - CALL AllocAry( Misc%U_red_dot, p%nDOF_red, 'U_red_dot', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') - CALL AllocAry( Misc%U_red_dotdot, p%nDOF_red, 'U_red_dotdot', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') - - CALL AllocAry( Misc%Fext, p%nDOF , 'm%Fext ', ErrStat2, ErrMsg2 );CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') - CALL AllocAry( Misc%Fext_red, p%nDOF_red , 'm%Fext_red', ErrStat2, ErrMsg2 );CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') - -END SUBROUTINE AllocMiscVars - -!------------------------------------------------------------------------------------------------------ -!> Partition DOFs and Nodes into sets: -!! Nodes are partitioned into the I,C,L (and R) sets, Nodes_I, Nodes_C, Nodes_L, with: -!! I="Interface" nodes -!! C="Reaction" nodes -!! L=Interior nodes -!! R=I+C -!! DOFs indices are partitioned into B, F, L -!! B=Leader DOFs (Rbar in SubDyn documentation) -!! F=Fixed DOFS -!! L=Interior DOFs -!! Subpartitions of both categories use the convention: "NodePartition_DOFPartition" -!! e.g. C_F : "reaction" nodes DOFs that are fixed -!! C_L : "reaction" nodes DOFs that will be counted as internal -!! I_B : "interface" nodes DOFs that are leader DOFs -SUBROUTINE PartitionDOFNodes(Init, m, p, ErrStat, ErrMsg) - use IntegerList, only: len, concatenate_lists, lists_difference, concatenate_3lists, sort_in_place - type(SD_Inittype), intent( in) :: Init !< Input data for initialization routine - type(SD_MiscVartype), intent( in) :: m !< Misc - type(SD_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) :: I, J, c_B, c_F, c_L, c__ ! counters - integer(IntKi) :: iNode, iiNode - integer(IntKi) :: nNodes_R - integer(IntKi), allocatable :: IDAll(:) - integer(IntKi), allocatable :: INodesAll(:) - integer(IntKi), allocatable :: Nodes_R(:) - integer(IntKi) :: ErrStat2 ! < Error status of the operation - character(ErrMsgLen) :: ErrMsg2 - ErrStat = ErrID_None - ErrMsg = "" - ! --- Count nodes per types - p%nNodes_I = p%nNodes_I ! Number of interface nodes - nNodes_R = p%nNodes_I+p%nNodes_C ! I+C nodes - p%nNodes_L = p%nNodes - nNodes_R ! Number of Interior nodes - ! NOTE: some of the interior nodes may have no DOF if they are involved in a rigid assembly.. - - CALL AllocAry( p%Nodes_L, p%nNodes_L, 1, 'p%Nodes_L', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'PartitionDOFNodes') - CALL AllocAry( Nodes_R , nNodes_R , 'Nodes_R' , ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'PartitionDOFNodes') - - ! -------------------------------------------------------------------------------- - ! --- Partition Nodes: Nodes_L = IAll - NodesR - ! -------------------------------------------------------------------------------- - allocate(INodesAll(1:p%nNodes)); - do iNode=1,p%nNodes - INodesAll(iNode)=iNode - enddo - ! Nodes_R = [Nodes_C Nodes_I] - call concatenate_lists(p%Nodes_C(:,1), p%Nodes_I(:,1), Nodes_R, ErrStat2, ErrMsg2); if(Failed()) return - ! Nodes_L = IAll - Nodes_R - call lists_difference(INodesAll, Nodes_R, p%Nodes_L(:,1), ErrStat2, ErrMsg2); if(Failed()) return - - ! -------------------------------------------------------------------------------- - ! --- Count DOFs - NOTE: we count node by node - ! -------------------------------------------------------------------------------- - ! DOFs of interface nodes - p%nDOFI__ =0 ! Total - p%nDOFI_Rb=0 ! Leader - p%nDOFI_F =0 ! Fixed - do iiNode= 1,p%nNodes_I - p%nDOFI__ = p%nDOFI__ + len(p%NodesDOFred( p%Nodes_I(iiNode,1) )) - p%nDOFI_Rb= p%nDOFI_Rb+ count(p%Nodes_I(iiNode, 2:7)==idBC_Leader) ! assumes 6 DOFs - p%nDOFI_F = p%nDOFI_F + count(p%Nodes_I(iiNode, 2:7)==idBC_Fixed) ! assumes 6 DOFs - enddo - if (p%nDOFI__/=p%nDOFI_Rb+p%nDOFI_F) then - call Fatal('Error in distributing interface DOFs, total number of interface DOF('//num2lstr(p%nDOFI__)//') does not equal sum of: leader ('//num2lstr(p%nDOFI_Rb)//'), fixed ('//num2lstr(p%nDOFI_F)//')'); return - endif - - ! DOFs of reaction nodes - p%nDOFC__ =0 ! Total - p%nDOFC_Rb=0 ! Leader - p%nDOFC_F =0 ! Fixed - p%nDOFC_L =0 ! Internal - do iiNode= 1,p%nNodes_C - p%nDOFC__ = p%nDOFC__ + len(p%NodesDOFred( p%Nodes_C(iiNode,1) )) - p%nDOFC_Rb= p%nDOFC_Rb+ count(p%Nodes_C(iiNode, 2:7)==idBC_Leader) ! assumes 6 DOFs - p%nDOFC_F = p%nDOFC_F + count(p%Nodes_C(iiNode, 2:7)==idBC_Fixed ) ! assumes 6 DOFs - p%nDOFC_L = p%nDOFC_L + count(p%Nodes_C(iiNode, 2:7)==idBC_Internal) ! assumes 6 DOFs - enddo - if (p%nDOFC__/=p%nDOFC_Rb+p%nDOFC_F+p%nDOFC_L) then - call Fatal('Error in distributing reaction DOFs, total number of reaction DOF('//num2lstr(p%nDOFC__)//') does not equal sum of: leader ('//num2lstr(p%nDOFC_Rb)//'), fixed ('//num2lstr(p%nDOFC_F)//'), internal ('//num2lstr(p%nDOFC_L)//')'); return - endif - ! DOFs of reaction + interface nodes - p%nDOFR__ = p%nDOFI__ + p%nDOFC__ ! Total number, used to be called "nDOFR" - - ! DOFs of internal nodes - p%nDOFL_L=0 - do iiNode= 1,p%nNodes_L - p%nDOFL_L = p%nDOFL_L + len(p%NodesDOFred( p%Nodes_L(iiNode,1) )) - enddo - if (p%nDOFL_L/=p%nDOF_red-p%nDOFR__) then - call Fatal('Error in distributing internal DOFs, total number of internal DOF('//num2lstr(p%nDOFL_L)//') does not equal total number of DOF('//num2lstr(p%nDOF_red)//') minus interface and reaction ('//num2lstr(p%nDOFR__)//')'); return - endif - - ! Total number of DOFs in each category: - p%nDOF__Rb = p%nDOFC_Rb + p%nDOFI_Rb ! OK, generic - p%nDOF__F = p%nDOFC_F + p%nDOFI_F ! OK, generic - p%nDOF__L = p%nDOFC_L + p%nDOFL_L ! OK, generic - - ! --- Safety checks ! TODO: these checks are temporary! - if (p%nDOFI_Rb /= p%nNodes_I*6) then - call Fatal('Wrong number of DOF for interface nodes, likely some interface nodes are special joints or are fixed'); return - endif - - ! Set the index arrays - CALL AllocAry( p%IDI__, p%nDOFI__, 'p%IDI__', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'PartitionDOFNodes') - CALL AllocAry( p%IDI_Rb,p%nDOFI_Rb, 'p%IDI_Rb',ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'PartitionDOFNodes') - CALL AllocAry( p%IDI_F, p%nDOFI_F, 'p%IDI_F', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'PartitionDOFNodes') - CALL AllocAry( p%IDC__, p%nDOFC__, 'p%IDC__', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'PartitionDOFNodes') - CALL AllocAry( p%IDC_Rb,p%nDOFC_Rb, 'p%IDC_Rb',ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'PartitionDOFNodes') - CALL AllocAry( p%IDC_F, p%nDOFC_F, 'p%IDC_F', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'PartitionDOFNodes') - CALL AllocAry( p%IDC_L, p%nDOFC_L, 'p%IDC_L', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'PartitionDOFNodes') - CALL AllocAry( p%IDL_L, p%nDOFL_L, 'p%IDL_L', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'PartitionDOFNodes') - CALL AllocAry( p%IDR__, p%nDOFR__, 'p%IDR__', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'PartitionDOFNodes') - CALL AllocAry( p%ID__Rb,p%nDOF__Rb, 'p%ID__Rb',ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'PartitionDOFNodes') - CALL AllocAry( p%ID__F, p%nDOF__F, 'p%ID__F', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'PartitionDOFNodes') - CALL AllocAry( p%ID__L, p%nDOF__L, 'p%ID__L', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'PartitionDOFNodes') ! TODO TODO - if(Failed()) return - - ! -------------------------------------------------------------------------------- - ! --- Distibutes the I, L, C nodal DOFs into B, F, L sub-categories - ! -------------------------------------------------------------------------------- - - ! Distribute the interface DOFs into R,F - c__=0; c_B=0; c_F=0 ! Counters over R and F dofs - do iiNode= 1,p%nNodes_I !Loop on interface nodes - iNode = p%Nodes_I(iiNode,1) - do J = 1, 6 ! DOFs: ItfTDXss ItfTDYss ItfTDZss ItfRDXss ItfRDYss ItfRDZss - c__=c__+1 - p%IDI__(c__) = p%NodesDOFred(iNode)%List(J) ! DOF number - if (p%Nodes_I(iiNode, J+1)==idBC_Leader) then - c_B=c_B+1 - p%IDI_Rb(c_B) = p%NodesDOFred(iNode)%List(J) ! DOF number - - elseif (p%Nodes_I(iiNode, J+1)==idBC_Fixed) then ! - c_F=c_F+1 - p%IDI_F(c_F) = p%NodesDOFred(iNode)%List(J) ! DOF number - endif - enddo - enddo - ! Indices IDI__ = [IDI_B, IDI_F], interface - !call concatenate_lists(p%IDI_Rb, p%IDI_F, p%IDI__, ErrStat2, ErrMsg2); if(Failed()) return - - ! Distribute the reaction DOFs into R,F,L - c__=0; c_B=0; c_F=0; c_L=0; ! Counters over R, F, L dofs - do iiNode= 1,p%nNodes_C !Loop on interface nodes - iNode = p%Nodes_C(iiNode,1) - do J = 1, 6 ! DOFs - c__=c__+1 - p%IDC__(c__) = p%NodesDOFred(iNode)%List(J) ! DOF number - if (p%Nodes_C(iiNode, J+1)==idBC_Leader) then - c_B=c_B+1 - p%IDC_Rb(c_B) = p%NodesDOFred(iNode)%List(J) ! DOF number - - elseif (p%Nodes_C(iiNode, J+1)==idBC_Fixed) then ! - c_F=c_F+1 - p%IDC_F(c_F) = p%NodesDOFred(iNode)%List(J) ! DOF number - - elseif (p%Nodes_C(iiNode, J+1)==idBC_Internal) then ! - c_L=c_L+1 - p%IDC_L(c_L) = p%NodesDOFred(iNode)%List(J) ! DOF number - endif - enddo - enddo - ! Indices IDC__ = [IDC_B, IDC_F, IDC_L], interface - !call concatenate_3lists(p%IDC_Rb, p%IDC_F, p%IDC_L, p%IDC__, ErrStat2, ErrMsg2); if(Failed()) return - !call sort_in_place(p%IDC__) - - - ! Indices IDR__ = [IDI__, IDC__], interface - !call concatenate_lists(p%IDI__, p%IDC__, p%IDR__, ErrStat2, ErrMsg2); if(Failed()) return - ! TODO, NOTE: Backward compatibility [IDC, IDI] - call concatenate_lists(p%IDC__, p%IDI__, p%IDR__, ErrStat2, ErrMsg2); if(Failed()) return - - ! Distribute the internal DOFs - c_L=0; ! Counters over L dofs - do iiNode= 1,p%nNodes_L !Loop on interface nodes - iNode = p%Nodes_L(iiNode,1) - do J = 1, size(p%NodesDOFred(iNode)%List) ! DOFs - c_L=c_L+1 - p%IDL_L(c_L) = p%NodesDOFred(iNode)%List(J) ! DOF number - enddo - enddo - - ! -------------------------------------------------------------------------------- - ! --- Total indices per partition B, F, L - ! -------------------------------------------------------------------------------- - ! Indices ID__Rb = [IDC_B, IDI_B], retained/leader DOFs - call concatenate_lists(p%IDC_Rb, p%IDI_Rb, p%ID__Rb, ErrStat2, ErrMsg2); if(Failed()) return - ! Indices ID__F = [IDC_F, IDI_F], fixed DOFs - call concatenate_lists(p%IDC_F, p%IDI_F, p%ID__F, ErrStat2, ErrMsg2); if(Failed()) return - ! Indices ID__L = [IDL_L, IDC_L], internal DOFs - call concatenate_lists(p%IDL_L, p%IDC_L, p%ID__L, ErrStat2, ErrMsg2); if(Failed()) return - - ! --- Check that partition is complete - if (any(p%ID__Rb<=0)) then - call Fatal('R - Partioning incorrect.'); return - elseif (any(p%ID__F<=0)) then - call Fatal('F - Partioning incorrect.'); return - elseif (any(p%ID__L<=0)) then - call Fatal('L - Partioning incorrect.'); return - endif - allocate(IDAll(1:p%nDOF_red)) - call concatenate_3lists(p%ID__Rb, p%ID__L, p%ID__F, IDAll, ErrStat2, ErrMsg2); if(Failed()) return - call sort_in_place(IDAll) - do I = 1, p%nDOF_red - if (IDAll(I)/=I) then - call Fatal('DOF '//trim(Num2LStr(I))//' missing, problem in R, L F partitioning'); return - endif - enddo - - if(DEV_VERSION) then - write(*,'(A,I0)')'Number of DOFs: "interface" (I__): ',p%nDOFI__ - write(*,'(A,I0)')'Number of DOFs: "interface" retained (I_B): ',p%nDOFI_Rb - write(*,'(A,I0)')'Number of DOFs: "interface" fixed (I_F): ',p%nDOFI_F - write(*,'(A,I0)')'Number of DOFs: "reactions" (C__): ',p%nDOFC__ - write(*,'(A,I0)')'Number of DOFs: "reactions" retained (C_B): ',p%nDOFC_Rb - write(*,'(A,I0)')'Number of DOFs: "reactions" internal (C_L): ',p%nDOFC_L - write(*,'(A,I0)')'Number of DOFs: "reactions" fixed (C_F): ',p%nDOFC_F - write(*,'(A,I0)')'Number of DOFs: "intf+react" (__R): ',p%nDOFR__ - write(*,'(A,I0)')'Number of DOFs: "internal" internal (L_L): ',p%nDOFL_L - write(*,'(A,I0)')'Number of DOFs: retained (__B): ',p%nDOF__Rb - write(*,'(A,I0)')'Number of DOFs: internal (__L): ',p%nDOF__L - write(*,'(A,I0)')'Number of DOFs: fixed (__F): ',p%nDOF__F - write(*,'(A,I0)')'Number of DOFs: total : ',p%nDOF_red - write(*,'(A,I0)')'Number of Nodes: "interface" (I): ',p%nNodes_I - write(*,'(A,I0)')'Number of Nodes: "reactions" (C): ',p%nNodes_C - write(*,'(A,I0)')'Number of Nodes: "internal" (L): ',p%nNodes_L - write(*,'(A,I0)')'Number of Nodes: total (I+C+L): ',p%nNodes - endif - - call CleanUp() - -contains - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'PartitionDOFNodes') - Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() - END FUNCTION Failed - SUBROUTINE Fatal(ErrMsg_in) - character(len=*), intent(in) :: ErrMsg_in - CALL SetErrStat(ErrID_Fatal, ErrMsg_in, ErrStat, ErrMsg, 'PartitionDOFNodes'); - CALL CleanUp() - END SUBROUTINE Fatal - SUBROUTINE CleanUp() - if(allocated(INodesAll)) deallocate(INodesAll) - if(allocated(IDAll)) deallocate(IDAll) - if(allocated(Nodes_R)) deallocate(Nodes_R) - END SUBROUTINE CleanUp - -END SUBROUTINE PartitionDOFNodes - -!> Compute displacements of all nodes in global system (Guyan + Rotated CB) -!! -SUBROUTINE LeverArm(u, p, x, m, DU_full, bGuyan, bElastic, U_full) - TYPE(SD_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(SD_ParameterType),target,INTENT(IN ) :: p !< Parameters - TYPE(SD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - LOGICAL, INTENT(IN ) :: bGuyan !< include Guyan Contribution - LOGICAL, INTENT(IN ) :: bElastic !< include Elastic contribution - REAL(ReKi), DIMENSION(:), INTENT( OUT) :: DU_full !< LeverArm in full system - REAL(ReKi), DIMENSION(:), OPTIONAL, INTENT(IN ) :: U_full !< Displacements in full system - !locals - INTEGER(IntKi) :: iSDNode - REAL(ReKi) :: rotations(3) - INTEGER(IntKi), pointer :: DOFList(:) - ! Variables for Guyan rigid body motion - real(ReKi), dimension(3) :: rIP ! Vector from TP to rotated Node - real(ReKi), dimension(3) :: rIP0 ! Vector from TP to Node (undeflected) - real(ReKi), dimension(3) :: duP ! Displacement of node due to rigid rotation - real(R8Ki), dimension(3,3) :: Rb2g ! Rotation matrix body 2 global coordinates - INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (occurs after initial error) - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None - ! --- Convert inputs to FEM DOFs and convenient 6-vector storage - ! Compute the small rotation angles given the input direction cosine matrix - rotations = GetSmllRotAngs(u%TPMesh%Orientation(:,:,1), ErrStat2, Errmsg2); - m%u_TP = (/REAL(u%TPMesh%TranslationDisp(:,1),ReKi), rotations/) - - if (present(U_full)) then - ! Then we use it directly, U_full may contain Static improvement - DU_full=U_full - ! We remove u_TP for floating - if (p%Floating) then - do iSDNode = 1,p%nNodes - DOFList => p%NodesDOF(iSDNode)%List ! Alias to shorten notations - DU_full(DOFList(1:3)) = DU_full(DOFList(1:3)) - m%u_TP(1:3) - enddo - endif - else - ! --- CB modes contribution to motion (L-DOF only), NO STATIC IMPROVEMENT - if (bElastic .and. p%nDOFM > 0) then - m%UL = matmul( p%PhiM, x%qm ) - else - m%UL = 0.0_ReKi - end if - ! --- Adding Guyan contribution to R and L DOFs - if (bGuyan .and. .not.p%Floating) then - m%UR_bar = matmul( p%TI , m%u_TP ) - m%UL = m%UL + matmul( p%PhiRb_TI, m%u_TP ) - else - ! Guyan modes are rigid body modes, we will add them in the "Full system" later - m%UR_bar = 0.0_ReKi - endif - ! --- Build original DOF vectors (DOF before the CB reduction) - m%U_red(p%IDI__) = m%UR_bar - m%U_red(p%ID__L) = m%UL - m%U_red(p%IDC_Rb)= 0 ! NOTE: for now we don't have leader DOF at "C" (bottom) - m%U_red(p%ID__F) = 0 - if (p%reduced) then - DU_full = matmul(p%T_red, m%U_red) - else - DU_full = m%U_red - endif - ! --- Adding Guyan contribution for rigid body - if (bGuyan .and. p%Floating) then - ! For floating, we compute the Guyan motion directly (rigid body motion with TP as origin) - ! This introduce non-linear "rotations" effects, where the bottom node should "go up", and not just translate horizontally - Rb2g(1:3,1:3) = transpose(u%TPMesh%Orientation(:,:,1)) - do iSDNode = 1,p%nNodes - DOFList => p%NodesDOF(iSDNode)%List ! Alias to shorten notations - ! --- Guyan (rigid body) motion in global coordinates - rIP0(1:3) = p%DP0(1:3, iSDNode) - rIP(1:3) = matmul(Rb2g, rIP0) - duP(1:3) = rIP - rIP0 ! NOTE: without m%u_TP(1:3) - ! Full diplacements Guyan + rotated CB (if asked) >>> Rotate All - if (p%GuyanLoadCorrection) then - DU_full(DOFList(1:3)) = matmul(Rb2g, DU_full(DOFList(1:3))) + duP(1:3) - DU_full(DOFList(4:6)) = matmul(Rb2g, DU_full(DOFList(4:6))) + rotations(1:3) - else - DU_full(DOFList(1:3)) = DU_full(DOFList(1:3)) + duP(1:3) - DU_full(DOFList(4:6)) = DU_full(DOFList(4:6)) + rotations(1:3) - endif - enddo - endif - endif ! U_full no provided -END SUBROUTINE LeverArm - -!------------------------------------------------------------------------------------------------------ -!> Construct force vector on internal DOF (L) from the values on the input mesh -!! First, the full vector of external forces is built on the non-reduced DOF -!! Then, the vector is reduced using the Tred matrix -SUBROUTINE GetExtForceOnInternalDOF(u, p, x, m, F_L, ErrStat, ErrMsg, GuyanLoadCorrection, RotateLoads, U_full) - type(SD_InputType), intent(in ) :: u ! Inputs - type(SD_ParameterType), intent(in ) :: p ! Parameters - type(SD_ContinuousStateType), intent(in ) :: x !< Continuous states at t - type(SD_MiscVarType), intent(inout) :: m ! Misc, for storage optimization of Fext and Fext_red - logical , intent(in ) :: GuyanLoadCorrection ! If true add extra moment - logical , intent(in ) :: RotateLoads ! If true, loads are rotated to body coordinate - real(Reki), optional, intent(in ) :: U_full(:) ! DOF displacements (Guyan + CB) - real(ReKi) , intent(out) :: F_L(p%nDOF__L) !< External force on internal nodes "L" - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - integer :: iNode ! indices of u-mesh nodes and SD nodes - integer :: nMembers - integer :: I - integer :: iCC, iElem, iChannel !< Index on control cables, element, Channel - integer(IntKi), dimension(12) :: IDOF ! 12 DOF indices in global unconstrained system - real(ReKi) :: CableTension ! Controllable Cable force - real(ReKi) :: rotations(3) - real(ReKi) :: du(3), Moment(3), Force(3) - real(ReKi) :: u_TP(6) - ! Variables for Guyan Rigid motion - real(ReKi), dimension(3) :: rIP ! Vector from TP to rotated Node - real(ReKi), dimension(3) :: rIP0 ! Vector from TP to Node (undeflected) - real(ReKi), dimension(3) :: duP ! Displacement of node due to rigid rotation - real(R8Ki), dimension(3,3) :: Rb2g ! Rotation matrix body 2 global - real(R8Ki), dimension(3,3) :: Rg2b ! Rotation matrix global 2 body coordinates - ! - real(ReKi), parameter :: myNaN = -9999998.989_ReKi - - if (GuyanLoadCorrection) then - ! Compute node displacements "DU_full" for lever arm - call LeverArm(u, p, x, m, m%DU_full, bGuyan=.True., bElastic=.False., U_full=U_full) - endif - - ! --- Build vector of external forces (including gravity) (Moment done below) - m%Fext= myNaN - if (RotateLoads) then ! Forces in body coordinates - Rg2b(1:3,1:3) = u%TPMesh%Orientation(:,:,1) ! global 2 body coordinates - do iNode = 1,p%nNodes - m%Fext( p%NodesDOF(iNode)%List(1:3) ) = matmul(Rg2b, u%LMesh%Force(:,iNode) + p%FG(p%NodesDOF(iNode)%List(1:3))) - enddo - else ! Forces in global - do iNode = 1,p%nNodes - m%Fext( p%NodesDOF(iNode)%List(1:3) ) = u%LMesh%Force(:,iNode) + p%FG(p%NodesDOF(iNode)%List(1:3)) - enddo - endif - - ! --- Adding controllable cable forces - if (size(p%CtrlElem2Channel,1) > 0) then - if (.not. allocated (u%CableDeltaL)) then - call Fatal('Cable tension input not allocated but controllable cables are present'); return - endif - if (size(u%CableDeltaL)< maxval(p%CtrlElem2Channel(:,2)) ) then - call Fatal('Cable tension input has length '//trim(num2lstr(size(u%CableDeltaL)))//' but controllable cables need to access channel '//trim(num2lstr(maxval(p%CtrlElem2Channel(:,2))))); return - endif - do iCC = 1, size(p%CtrlElem2Channel,1) ! Loop on controllable cables - iElem = p%CtrlElem2Channel(iCC,1) - iChannel = p%CtrlElem2Channel(iCC,2) - IDOF = p%ElemsDOF(1:12, iElem) - ! T(t) = - EA * DeltaL(t) /(Le + Delta L(t)) ! NOTE DeltaL<0 - CableTension = -p%ElemProps(iElem)%YoungE*p%ElemProps(iElem)%Area * u%CableDeltaL(iChannel) / (p%ElemProps(iElem)%Length + u%CableDeltaL(iChannel)) - print*,'TODO, Controllable pretension cable needs thinking for moment' - STOP - !if (RotateLoads) then ! in body coordinate - ! m%Fext(IDOF) = m%Fext(IDOF) + matmul(Rg2b,m%FC_unit( IDOF ) * (CableTension - p%ElemProps(iElem)%T0)) - !else ! in global - ! m%Fext(IDOF) = m%Fext(IDOF) + m%FC_unit( IDOF ) * (CableTension - p%ElemProps(iElem)%T0) - !endif - enddo - endif - - ! --- Build vector of external moment - do iNode = 1,p%nNodes - Force(1:3) = m%Fext(p%NodesDOF(iNode)%List(1:3) ) ! Controllable cable + External Forces on LMesh - ! Moment ext + gravity - if (RotateLoads) then - ! In body coordinates - Moment(1:3) = matmul(Rg2b, u%LMesh%Moment(1:3,iNode) + p%FG(p%NodesDOF(iNode)%List(4:6))) - else - Moment(1:3) = u%LMesh%Moment(1:3,iNode) + p%FG(p%NodesDOF(iNode)%List(4:6)) - endif - - ! Extra moment dm = Delta u x (fe + fg) - if (GuyanLoadCorrection) then - du = m%DU_full(p%NodesDOF(iNode)%List(1:3)) ! Lever arm - Moment(1) = Moment(1) + du(2) * Force(3) - du(3) * Force(2) - Moment(2) = Moment(2) + du(3) * Force(1) - du(1) * Force(3) - Moment(3) = Moment(3) + du(1) * Force(2) - du(2) * Force(1) - endif - - ! Moment is spread equally across all rotational DOFs if more than 3 rotational DOFs - nMembers = (size(p%NodesDOF(iNode)%List)-3)/3 ! Number of members deducted from Node's DOFList - m%Fext( p%NodesDOF(iNode)%List(4::3)) = Moment(1)/nMembers - m%Fext( p%NodesDOF(iNode)%List(5::3)) = Moment(2)/nMembers - m%Fext( p%NodesDOF(iNode)%List(6::3)) = Moment(3)/nMembers - enddo - - ! TODO: remove test below in the future - if (DEV_VERSION) then - if (any(m%Fext == myNaN)) then - print*,'Error in setting up Fext' - STOP - endif - endif - - ! --- Reduced vector of external force - if (p%reduced) then - m%Fext_red = matmul(p%T_red_T, m%Fext) - F_L= m%Fext_red(p%ID__L) - else - F_L= m%Fext(p%ID__L) - endif - -contains - subroutine Fatal(ErrMsg_in) - character(len=*), intent(in) :: ErrMsg_in - call SetErrStat(ErrID_Fatal, ErrMsg_in, ErrStat, ErrMsg, 'GetExtForce'); - end subroutine Fatal -END SUBROUTINE GetExtForceOnInternalDOF - -!------------------------------------------------------------------------------------------------------ -!> Construct force vector on interface DOF (I) -!! NOTE: This function should only be called after GetExtForceOnInternalDOF -SUBROUTINE GetExtForceOnInterfaceDOF( p, Fext, F_I) - type(SD_ParameterType), intent(in ) :: p ! Parameters - real(ReKi), dimension(:), intent(in ) :: Fext !< Vector of external forces on un-reduced DOF - real(ReKi) , intent(out ) :: F_I(6*p%nNodes_I) !< External force on interface DOF - integer :: iSDNode, startDOF, I - DO I = 1, p%nNodes_I - iSDNode = p%Nodes_I(I,1) - startDOF = (I-1)*6 + 1 ! NOTE: for now we have 6 DOF per interface nodes - F_I(startDOF:startDOF+5) = Fext(p%NodesDOF(iSDNode)%List(1:6)) !TODO try to use Fext_red - ENDDO -END SUBROUTINE GetExtForceOnInterfaceDOF - -!------------------------------------------------------------------------------------------------------ -!> Output the summary file -SUBROUTINE OutSummary(Init, p, m, InitInput, CBparams, ErrStat,ErrMsg) - use Yaml - TYPE(SD_InitType), INTENT(INOUT) :: Init ! Input data for initialization routine - TYPE(SD_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(SD_MiscVarType) , INTENT(IN) :: m ! Misc - TYPE(SD_InitInputType), INTENT(IN) :: InitInput !< Input data for initialization routine - TYPE(CB_MatArrays), INTENT(IN) :: CBparams ! CB parameters that will be passed in for summary file use - INTEGER(IntKi), INTENT(OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT(OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - !LOCALS - INTEGER(IntKi) :: UnSum ! unit number for this summary file - INTEGER(IntKi) :: ErrStat2 ! Temporary storage for local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary storage for local errors - CHARACTER(1024) :: SummaryName ! name of the SubDyn summary file - INTEGER(IntKi) :: i, j, k, propIDs(2), Iprop(2) !counter and temporary holders - INTEGER(IntKi) :: iNode1, iNode2 ! Node indices - INTEGER(IntKi) :: mType ! Member Type - Real(ReKi) :: mMass, mLength ! Member mass and length - REAL(ReKi) :: MRB(6,6) ! REDUCED SYSTEM Kmatrix, equivalent mass matrix - REAL(FEKi),allocatable :: MBB(:,:) ! Leader DOFs mass matrix - REAL(ReKi) :: XYZ1(3),XYZ2(3) !temporary arrays - REAL(FEKi) :: DirCos(3,3) ! direction cosine matrix (global to local) - CHARACTER(*),PARAMETER :: SectionDivide = '#____________________________________________________________________________________________________' - real(ReKi), dimension(:,:), allocatable :: TI2 ! For Equivalent mass matrix - real(FEKi) :: Ke(12,12), Me(12, 12), FCe(12), FGe(12) ! element stiffness and mass matrices gravity force vector - real(ReKi), dimension(:,:), allocatable :: DummyArray ! - ! Variables for Eigenvalue analysis - integer(IntKi) :: nOmega - real(FEKi), dimension(:,:), allocatable :: Modes - real(R8Ki), dimension(:,:), allocatable :: AA, BB, CC, DD ! Linearization matrices - real(FEKi), dimension(:) , allocatable :: Omega - logical, allocatable :: bDOF(:) ! Mask for DOF to keep (True), or reduce (False) - character(len=*),parameter :: ReFmt='ES15.6E2' - character(len=*),parameter :: SFmt='A15,1x' ! Need +1 for comma compared to ReFmt - character(len=*),parameter :: IFmt='I7' - ! - ErrStat = ErrID_None - ErrMsg = "" - - ! --- Eigen values of full system (for summary file output only) - ! We call the EigenSolver here only so that we get a print-out the eigenvalues from the full system (minus Reaction DOF) - ! M and K are reduced matrices, but Boundary conditions are not applied - ! We set bDOF, which is true if not a fixed Boundary conditions - ! NOTE: we don't check for singularities/rigig body modes here - CALL WrScr(' Calculating Full System Modes for summary file') - CALL AllocAry(bDOF, p%nDOF_red, 'bDOF', ErrStat2, ErrMsg2); if(Failed()) return - bDOF(:) = .true. - bDOF(p%ID__F) = .false. - nOmega = count(bDOF) - CALL AllocAry(Omega, nOmega, 'Omega', ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(Modes, p%nDOF_red, nOmega, 'Modes', ErrStat2, ErrMsg2); if(Failed()) return - call EigenSolveWrap(Init%K, Init%M, p%nDOF_red, nOmega, .False., Modes, Omega, ErrStat2, ErrMsg2, bDOF); if(Failed()) return - IF (ALLOCATED(bDOF) ) DEALLOCATE(bDOF) - - !------------------------------------------------------------------------------------------------------------- - ! open txt file - !------------------------------------------------------------------------------------------------------------- - SummaryName = TRIM(Init%RootName)//'.sum.yaml' - UnSum = -1 ! we haven't opened the summary file, yet. - - CALL SDOut_OpenSum( UnSum, SummaryName, SD_ProgDesc, ErrStat2, ErrMsg2 ); if(Failed()) return - !------------------------------------------------------------------------------------------------------------- - ! write discretized data to a txt file - !------------------------------------------------------------------------------------------------------------- -!bjj: for debugging, i recommend using the p% versions of all these variables whenever possible in this summary file: -! (it helps in debugging) - WRITE(UnSum, '(A)') '#Unless specified, units are consistent with Input units, [SI] system is advised.' - WRITE(UnSum, '(A)') SectionDivide - write(UnSum,'(A,3(E15.6))')'#TP reference point:',InitInput%TP_RefPoint(1:3) - - ! --- Internal FEM representation - WRITE(UnSum, '(A)') SectionDivide - WRITE(UnSum, '(A)') '# Internal FEM representation' - call yaml_write_var(UnSum, 'nNodes_I', p%nNodes_I,IFmt, ErrStat2, ErrMsg2, comment='Number of Nodes: "interface" (I)') - call yaml_write_var(UnSum, 'nNodes_C', p%nNodes_C,IFmt, ErrStat2, ErrMsg2, comment='Number of Nodes: "reactions" (C)') - call yaml_write_var(UnSum, 'nNodes_L', p%nNodes_L,IFmt, ErrStat2, ErrMsg2, comment='Number of Nodes: "internal" (L)') - call yaml_write_var(UnSum, 'nNodes ', p%nNodes ,IFmt, ErrStat2, ErrMsg2, comment='Number of Nodes: total (I+C+L)') - if(p%OutAll) then - call yaml_write_var(UnSum, 'nDOFI__ ', p%nDOFI__ ,IFmt, ErrStat2, ErrMsg2, comment='Number of DOFs: "interface" (I__)') - call yaml_write_var(UnSum, 'nDOFI_B ', p%nDOFI_Rb,IFmt, ErrStat2, ErrMsg2, comment='Number of DOFs: "interface" retained (I_B)') - call yaml_write_var(UnSum, 'nDOFI_F ', p%nDOFI_F ,IFmt, ErrStat2, ErrMsg2, comment='Number of DOFs: "interface" fixed (I_F)') - call yaml_write_var(UnSum, 'nDOFC__ ', p%nDOFC__ ,IFmt, ErrStat2, ErrMsg2, comment='Number of DOFs: "reactions" (C__)') - call yaml_write_var(UnSum, 'nDOFC_B ', p%nDOFC_Rb,IFmt, ErrStat2, ErrMsg2, comment='Number of DOFs: "reactions" retained (C_B)') - call yaml_write_var(UnSum, 'nDOFC_L ', p%nDOFC_L ,IFmt, ErrStat2, ErrMsg2, comment='Number of DOFs: "reactions" internal (C_L)') - call yaml_write_var(UnSum, 'nDOFC_F ', p%nDOFC_F ,IFmt, ErrStat2, ErrMsg2, comment='Number of DOFs: "reactions" fixed (C_F)') - call yaml_write_var(UnSum, 'nDOFR__ ', p%nDOFR__ ,IFmt, ErrStat2, ErrMsg2, comment='Number of DOFs: "intf+react" (__R)') - call yaml_write_var(UnSum, 'nDOFL_L ', p%nDOFL_L ,IFmt, ErrStat2, ErrMsg2, comment='Number of DOFs: "internal" internal (L_L)') - endif - call yaml_write_var(UnSum, 'nDOF__B ', p%nDOF__Rb,IFmt, ErrStat2, ErrMsg2, comment='Number of DOFs: retained (__B)') - call yaml_write_var(UnSum, 'nDOF__L ', p%nDOF__L ,IFmt, ErrStat2, ErrMsg2, comment='Number of DOFs: internal (__L)') - call yaml_write_var(UnSum, 'nDOF__F ', p%nDOF__F ,IFmt, ErrStat2, ErrMsg2, comment='Number of DOFs: fixed (__F)') - call yaml_write_var(UnSum, 'nDOF_red', p%nDOF_red,IFmt, ErrStat2, ErrMsg2, comment='Number of DOFs: total') - if(p%OutAll) then - call yaml_write_array(UnSum, 'Nodes_I', p%Nodes_I(:,1), IFmt, ErrStat2, ErrMsg2, comment='"interface" nodes"') - call yaml_write_array(UnSum, 'Nodes_C', p%Nodes_C(:,1), IFmt, ErrStat2, ErrMsg2, comment='"reaction" nodes"') - call yaml_write_array(UnSum, 'Nodes_L', p%Nodes_L(:,1), IFmt, ErrStat2, ErrMsg2, comment='"internal" nodes"') - call yaml_write_array(UnSum, 'DOF_I__', p%IDI__ , IFmt, ErrStat2, ErrMsg2, comment='"interface" DOFs"') - call yaml_write_array(UnSum, 'DOF_I_B', p%IDI_Rb, IFmt, ErrStat2, ErrMsg2, comment='"interface" retained DOFs') - call yaml_write_array(UnSum, 'DOF_I_F', p%IDI_F , IFmt, ErrStat2, ErrMsg2, comment='"interface" fixed DOFs') - call yaml_write_array(UnSum, 'DOF_C__', p%IDC__ , IFmt, ErrStat2, ErrMsg2, comment='"reaction" DOFs"') - call yaml_write_array(UnSum, 'DOF_C_B', p%IDC_Rb, IFmt, ErrStat2, ErrMsg2, comment='"reaction" retained DOFs') - call yaml_write_array(UnSum, 'DOF_C_L', p%IDC_L , IFmt, ErrStat2, ErrMsg2, comment='"reaction" internal DOFs') - call yaml_write_array(UnSum, 'DOF_C_F', p%IDC_F , IFmt, ErrStat2, ErrMsg2, comment='"reaction" fixed DOFs') - call yaml_write_array(UnSum, 'DOF_L_L', p%IDL_L , IFmt, ErrStat2, ErrMsg2, comment='"internal" internal DOFs') - call yaml_write_array(UnSum, 'DOF_R_', p%IDR__ , IFmt, ErrStat2, ErrMsg2, comment='"interface&reaction" DOFs') - endif - call yaml_write_array(UnSum, 'DOF___B', p%ID__Rb, IFmt, ErrStat2, ErrMsg2, comment='all retained DOFs') - call yaml_write_array(UnSum, 'DOF___F', p%ID__F , IFmt, ErrStat2, ErrMsg2, comment='all fixed DOFs') - call yaml_write_array(UnSum, 'DOF___L', p%ID__L , IFmt, ErrStat2, ErrMsg2, comment='all internal DOFs') - - WRITE(UnSum, '()') - WRITE(UnSum, '(A)') '#Index map from DOF to nodes' - WRITE(UnSum, '(A)') '# Node No., DOF/Node, NodalDOF' - call yaml_write_array(UnSum, 'DOF2Nodes', p%DOFred2Nodes , IFmt, ErrStat2, ErrMsg2, comment='(nDOFRed x 3, for each constrained DOF, col1: node index, col2: number of DOF, col3: DOF starting from 1)',label=.true.) - - ! Nodes properties - write(UnSum, '("#",4x,1(A9),8('//trim(SFmt)//'))') 'Node_[#]', 'X_[m]','Y_[m]','Z_[m]', 'JType_[-]', 'JDirX_[-]','JDirY_[-]','JDirZ_[-]','JStff_[Nm/rad]' - call yaml_write_array(UnSum, 'Nodes', Init%Nodes, ReFmt, ErrStat2, ErrMsg2, AllFmt='1(F8.0,","),3(F15.3,","),(F15.0,","),4(E15.6,",")') !, comment='',label=.true.) - - ! Element properties - CALL AllocAry( DummyArray, size(p%ElemProps), 16, 'Elem', ErrStat2, ErrMsg2 ); if(Failed()) return - do i=1,size(p%ElemProps) - DummyArray(i,1) = p%Elems(i,1) ! Should be == i - DummyArray(i,2) = p%Elems(i,2) ! Node 1 - DummyArray(i,3) = p%Elems(i,3) ! Node 2 - DummyArray(i,4) = p%Elems(i,4) ! Prop 1 - DummyArray(i,5) = p%Elems(i,5) ! Prop 2 - DummyArray(i,6) = p%ElemProps(i)%eType ! Type - DummyArray(i,7) = p%ElemProps(i)%Length !Length - DummyArray(i,8) = p%ElemProps(i)%Area ! Area m^2 - DummyArray(i,9) = p%ElemProps(i)%Rho ! density kg/m^3 - DummyArray(i,10) = p%ElemProps(i)%YoungE ! Young modulus - DummyArray(i,11) = p%ElemProps(i)%ShearG ! G - DummyArray(i,12) = p%ElemProps(i)%Kappa ! Shear coefficient - DummyArray(i,13) = p%ElemProps(i)%Ixx ! Moment of inertia - DummyArray(i,14) = p%ElemProps(i)%Iyy ! Moment of inertia - DummyArray(i,15) = p%ElemProps(i)%Jzz ! Moment of inertia - DummyArray(i,16) = p%ElemProps(i)%T0 ! Pretension [N] - enddo - write(UnSum, '("#",4x,6(A9),10('//SFmt//'))') 'Elem_[#] ','Node_1','Node_2','Prop_1','Prop_2','Type','Length_[m]','Area_[m^2]','Dens._[kg/m^3]','E_[N/m2]','G_[N/m2]','shear_[-]','Ixx_[m^4]','Iyy_[m^4]','Jzz_[m^4]','T0_[N]' - call yaml_write_array(UnSum, 'Elements', DummyArray, ReFmt, ErrStat2, ErrMsg2, AllFmt='6(F8.0,","),3(F15.3,","),7(E15.6,",")') !, comment='',label=.true.) - deallocate(DummyArray) - - ! --- C - if(size(p%CtrlElem2Channel,1)>0) then - write(UnSum, '("#",2x,2(A11))') 'Elem_[#] ','Channel_[#]' - call yaml_write_array(UnSum, 'CtrlElem2Channel', p%CtrlElem2Channel, IFmt, ErrStat2, ErrMsg2, comment='') - endif - if (allocated(Init%Soil_K)) then - call yaml_write_array(UnSum, 'Soil_Nodes', Init%Soil_Nodes, IFmt, ErrStat2, ErrMsg2, comment='') - CALL AllocAry( DummyArray, 3, size(Init%Soil_Points,2), 'SoilP', ErrStat2, ErrMsg2 ); if(Failed()) return - do i=1,size(Init%Soil_K,3) - DummyArray(1:3,I) = Init%Nodes(Init%Soil_Nodes(I), 2:4) - call yaml_write_array(UnSum, 'Soil_K'//Num2LStr(I), Init%Soil_K(:,:,I), ReFmt, ErrStat2, ErrMsg2, comment='') - enddo - call yaml_write_array(UnSum, 'Soil_Points_SoilDyn', Init%Soil_Points, ReFmt, ErrStat2, ErrMsg2, comment='') - call yaml_write_array(UnSum, 'Soil_Points_SubDyn', DummyArray, ReFmt, ErrStat2, ErrMsg2, comment='') - deallocate(DummyArray) - endif - - ! --- User inputs (less interesting, repeat of input file) - WRITE(UnSum, '(A)') SectionDivide - WRITE(UnSum, '(A)') '#User inputs' - WRITE(UnSum, '()') - WRITE(UnSum, '(A,I6)') '#Number of properties (NProps):',Init%NPropB - WRITE(UnSum, '(A8,5(A15))') '#Prop No.', 'YoungE', 'ShearG', 'MatDens', 'XsecD', 'XsecT' - WRITE(UnSum, '("#",I8, ES15.6E2,ES15.6E2,ES15.6E2,ES15.6E2,ES15.6E2 ) ') (NINT(Init%PropsB(i, 1)), (Init%PropsB(i, j), j = 2, 6), i = 1, Init%NPropB) - - WRITE(UnSum, '()') - WRITE(UnSum, '(A,I6)') '#No. of Reaction DOFs:',p%nDOFC__ - WRITE(UnSum, '(A, A6)') '#React. DOF_ID', 'BC' - do i = 1, size(p%IDC_F ); WRITE(UnSum, '("#",I10, A10)') p%IDC_F(i) , ' Fixed' ; enddo - do i = 1, size(p%IDC_L ); WRITE(UnSum, '("#",I10, A10)') p%IDC_L(i) , ' Free' ; enddo - do i = 1, size(p%IDC_Rb); WRITE(UnSum, '("#",I10, A10)') p%IDC_Rb(i), ' Leader'; enddo - - WRITE(UnSum, '()') - WRITE(UnSum, '(A,I6)') '#No. of Interface DOFs:',p%nDOFI__ - WRITE(UnSum, '(A,A6)') '#Interf. DOF_ID', 'BC' - do i = 1, size(p%IDI_F ); WRITE(UnSum, '("#",I10, A10)') p%IDI_F(i) , ' Fixed' ; enddo - do i = 1, size(p%IDI_Rb); WRITE(UnSum, '("#",I10, A10)') p%IDI_Rb(i), ' Leader'; enddo - - WRITE(UnSum, '()') - WRITE(UnSum, '(A,I6)') '#Number of concentrated masses (NCMass):',Init%NCMass - WRITE(UnSum, '(A10,10(A15))') '#JointCMass', 'Mass', 'JXX', 'JYY', 'JZZ', 'JXY', 'JXZ', 'JYZ', 'MCGX', 'MCGY', 'MCGZ' - do i=1,Init%NCMass - WRITE(UnSum, '("#",F10.0, 10(E15.6))') (Init%Cmass(i, j), j = 1, CMassCol) - enddo - - WRITE(UnSum, '()') - WRITE(UnSum, '(A,I6)') '#Number of members',p%NMembers - WRITE(UnSum, '(A,I6)') '#Number of nodes per member:', Init%Ndiv+1 - WRITE(UnSum, '(A9,A10,A10,A10,A10,A15,A15,A16)') '#Member ID', 'Joint1_ID', 'Joint2_ID','Prop_I','Prop_J', 'Mass','Length', 'Node IDs...' - DO i=1,p%NMembers - !Calculate member mass here; this should really be done somewhere else, yet it is not used anywhere else - !IT WILL HAVE TO BE MODIFIED FOR OTHER THAN CIRCULAR PIPE ELEMENTS - propIDs=Init%Members(i,iMProp:iMProp+1) - mLength=MemberLength(Init%Members(i,1),Init,ErrStat,ErrMsg) ! TODO double check mass and length - IF (ErrStat .EQ. ErrID_None) THEN - mType = Init%Members(I, iMType) ! - if (mType==idMemberBeam) then - iProp(1) = FINDLOCI(Init%PropSetsB(:,1), propIDs(1)) - iProp(2) = FINDLOCI(Init%PropSetsB(:,1), propIDs(2)) - mMass= BeamMass(Init%PropSetsB(iProp(1),4),Init%PropSetsB(iProp(1),5),Init%PropSetsB(iProp(1),6), & - Init%PropSetsB(iProp(2),4),Init%PropSetsB(iProp(2),5),Init%PropSetsB(iProp(2),6), mLength, .TRUE.) - - WRITE(UnSum, '("#",I9,I10,I10,I10,I10,ES15.6E2,ES15.6E2, A3,'//Num2LStr(Init%NDiv + 1 )//'(I6))') Init%Members(i,1:3),propIDs(1),propIDs(2),& - mMass,mLength,' ',(Init%MemberNodes(i, j), j = 1, Init%NDiv+1) - else if (mType==idMemberCable) then - iProp(1) = FINDLOCI(Init%PropSetsC(:,1), propIDs(1)) - mMass= Init%PropSetsC(iProp(1),3) * mLength ! rho [kg/m] * L - WRITE(UnSum, '("#",I9,I10,I10,I10,I10,ES15.6E2,ES15.6E2, A3,2(I6),A)') Init%Members(i,1:3),propIDs(1),propIDs(2),& - mMass,mLength,' ',(Init%MemberNodes(i, j), j = 1, 2), ' # Cable' - else if (mType==idMemberRigid) then - iProp(1) = FINDLOCI(Init%PropSetsR(:,1), propIDs(1)) - mMass= Init%PropSetsR(iProp(1),2) * mLength ! rho [kg/m] * L - WRITE(UnSum, '("#",I9,I10,I10,I10,I10,ES15.6E2,ES15.6E2, A3,2(I6),A)') Init%Members(i,1:3),propIDs(1),propIDs(2),& - mMass,mLength,' ',(Init%MemberNodes(i, j), j = 1, 2), ' # Rigid link' - else - WRITE(UnSum, '(A)') '#TODO, member unknown' - endif - ELSE - RETURN - ENDIF - ENDDO - !------------------------------------------------------------------------------------------------------------- - ! write Cosine matrix for all members to a txt file - !------------------------------------------------------------------------------------------------------------- - WRITE(UnSum, '(A)') SectionDivide - WRITE(UnSum, '(A, I6)') '#Direction Cosine Matrices for all Members: GLOBAL-2-LOCAL. No. of 3x3 matrices=', p%NMembers - WRITE(UnSum, '(A9,9(A15))') '#Member ID', 'DC(1,1)', 'DC(1,2)', 'DC(1,3)', 'DC(2,1)','DC(2,2)','DC(2,3)','DC(3,1)','DC(3,2)','DC(3,3)' - DO i=1,p%NMembers - iNode1 = FINDLOCI(Init%Joints(:,1), Init%Members(i,2)) ! index of joint 1 of member i - iNode2 = FINDLOCI(Init%Joints(:,1), Init%Members(i,3)) ! index of joint 2 of member i - XYZ1 = Init%Joints(iNode1,2:4) - XYZ2 = Init%Joints(iNode2,2:4) - CALL GetDirCos(XYZ1(1:3), XYZ2(1:3), DirCos, mLength, ErrStat, ErrMsg) - DirCos=TRANSPOSE(DirCos) !This is now global to local - WRITE(UnSum, '("#",I9,9(ES11.3E2))') Init%Members(i,1), ((DirCos(k,j),j=1,3),k=1,3) - ENDDO - - !------------------------------------------------------------------------------------------------------------- - ! write Eigenvalues of full SYstem and CB reduced System - !------------------------------------------------------------------------------------------------------------- - WRITE(UnSum, '(A)') SectionDivide - WRITE(UnSum, '(A, I6)') "#Eigenfrequencies [Hz] for full system, with reaction constraints (+ Soil K/M + SoilDyn K0) " - call yaml_write_array(UnSum, 'Full_frequencies', Omega/(TwoPi), ReFmt, ErrStat2, ErrMsg2) - WRITE(UnSum, '(A, I6)') "#CB frequencies [Hz]" - call yaml_write_array(UnSum, 'CB_frequencies', CBparams%OmegaL(1:p%nDOFM)/(TwoPi), ReFmt, ErrStat2, ErrMsg2) - - !------------------------------------------------------------------------------------------------------------- - ! write Eigenvectors of full System - !------------------------------------------------------------------------------------------------------------- - WRITE(UnSum, '(A)') SectionDivide - WRITE(UnSum, '(A)') ('#FEM Eigenvectors ('//TRIM(Num2LStr(p%nDOF_red))//' x '//TRIM(Num2LStr(nOmega))//& - ') [m or rad], full system with reaction constraints (+ Soil K/M + SoilDyn K0)') - call yaml_write_array(UnSum, 'Full_Modes', Modes(:,1:nOmega), ReFmt, ErrStat2, ErrMsg2) - - !------------------------------------------------------------------------------------------------------------- - ! write CB system matrices - !------------------------------------------------------------------------------------------------------------- - WRITE(UnSum, '(A)') SectionDivide - WRITE(UnSum, '(A)') '#CB Matrices (PhiM,PhiR) (reaction constraints applied)' - call yaml_write_array(UnSum, 'PhiM', CBparams%PhiL(:,1:p%nDOFM ), ReFmt, ErrStat2, ErrMsg2, comment='(CB modes)') - call yaml_write_array(UnSum, 'PhiR', CBparams%PhiR, ReFmt, ErrStat2, ErrMsg2, comment='(Guyan modes)') - - !------------------------------------------------------------------------------------------------------------- - ! write CB system KBBt and MBBt matrices, eq stiffness matrices of the entire substructure at the TP ref point - !------------------------------------------------------------------------------------------------------------- - WRITE(UnSum, '(A)') SectionDivide - WRITE(UnSum, '(A)') "#SubDyn's Structure Equivalent Stiffness and Mass Matrices at the TP reference point (Guyan DOFs)" - call yaml_write_array(UnSum, 'KBBt', p%KBB, ReFmt, ErrStat2, ErrMsg2) - call yaml_write_array(UnSum, 'MBBt', p%MBB, ReFmt, ErrStat2, ErrMsg2) - call yaml_write_array(UnSum, 'CBBt', p%CBB, Refmt, ErrStat2, ErrMsg2, comment='(user Guyan Damping + potential joint damping from CB-reduction)') - - ! Set TI2, transformation matrix from R DOFs to SubDyn Origin - CALL AllocAry( TI2, p%nDOFR__ , 6, 'TI2', ErrStat2, ErrMsg2 ); if(Failed()) return - CALL RigidTrnsf(Init, p, (/0._ReKi, 0._ReKi, 0._ReKi/), p%IDR__, p%nDOFR__, TI2, ErrStat2, ErrMsg2); if(Failed()) return - ! Compute Rigid body mass matrix (without Soil, and using both Interface and Reactions nodes as leader DOF) - if (p%nDOFR__/=p%nDOF__Rb) then - call SD_Guyan_RigidBodyMass(Init, p, MBB, ErrStat2, ErrMsg2); if(Failed()) return - MRB=matmul(TRANSPOSE(TI2),matmul(MBB,TI2)) !Equivalent mass matrix of the rigid body - else - MRB=matmul(TRANSPOSE(TI2),matmul(CBparams%MBB,TI2)) !Equivalent mass matrix of the rigid body - endif - WRITE(UnSum, '(A)') SectionDivide - WRITE(UnSum, '(A)') '#Rigid Body Equivalent Mass Matrix w.r.t. (0,0,0).' - call yaml_write_array(UnSum, 'MRB', MRB, ReFmt, ErrStat2, ErrMsg2) - WRITE(UnSum, '(A,ES15.6E2)') "#SubDyn's Total Mass (structural and non-structural)=", MRB(1,1) - WRITE(UnSum, '(A,3(ES15.6E2))') "#SubDyn's Total Mass CM coordinates (Xcm,Ycm,Zcm) =", (/-MRB(3,5),-MRB(1,6), MRB(1,5)/) /MRB(1,1) - deallocate(TI2) - - - if(p%OutAll) then ! //--- START DEBUG OUTPUTS - - WRITE(UnSum, '()') - WRITE(UnSum, '(A)') SectionDivide - WRITE(UnSum, '(A)') '#**** Additional Debugging Information ****' - - ! --- Element Me,Ke,Fg, Fce - CALL ElemM(p%ElemProps(1), Me) - CALL ElemK(p%ElemProps(1), Ke) - CALL ElemF(p%ElemProps(1), Init%g, FGe, FCe) - call yaml_write_array(UnSum, 'Ke',Ke, ReFmt, ErrStat2, ErrMsg2, comment='First element stiffness matrix') - call yaml_write_array(UnSum, 'Me',Me, ReFmt, ErrStat2, ErrMsg2, comment='First element mass matrix') - call yaml_write_array(UnSum, 'FGe',FGe, ReFmt, ErrStat2, ErrMsg2, comment='First element gravity vector') - call yaml_write_array(UnSum, 'FCe',FCe, ReFmt, ErrStat2, ErrMsg2, comment='First element cable pretension') - - ! --- Write assembed K M to a txt file - WRITE(UnSum, '(A)') SectionDivide - WRITE(UnSum, '(A, I6)') '#FULL FEM K and M matrices. TOTAL FEM TDOFs:', p%nDOF - call yaml_write_array(UnSum, 'K', Init%K, ReFmt, ErrStat2, ErrMsg2, comment='Stiffness matrix') - call yaml_write_array(UnSum, 'M', Init%M, ReFmt, ErrStat2, ErrMsg2, comment='Mass matrix') - - ! --- write assembed GRAVITY FORCE FG VECTOR. gravity forces applied at each node of the full system - WRITE(UnSum, '(A)') SectionDivide - WRITE(UnSum, '(A)') '#Gravity and cable loads applied at each node of the system (before DOF elimination with T matrix)' - call yaml_write_array(UnSum, 'FG', p%FG, ReFmt, ErrStat2, ErrMsg2, comment='') - - ! --- write CB system matrices - WRITE(UnSum, '(A)') SectionDivide - WRITE(UnSum, '(A)') '#Additional CB Matrices (MBB,MBM,KBB) (constraint applied)' - call yaml_write_array(UnSum, 'MBB ',CBparams%MBB, ReFmt, ErrStat2, ErrMsg2, comment='') - call yaml_write_array(UnSum, 'MBM', CBparams%MBM, ReFmt, ErrStat2, ErrMsg2, comment='') - !call yaml_write_array(UnSum, 'CBB', CBparams%CBB, ReFmt, ErrStat2, ErrMsg2, comment='') - !call yaml_write_array(UnSum, 'CMM', CBparams%CMM, ReFmt, ErrStat2, ErrMsg2, comment='') - !call yaml_write_array(UnSum, 'CMMdiag_zeta',2.0_ReKi * CBparams%OmegaL(1:p%nDOFM) * Init%JDampings(1:p%nDOFM) , ReFmt, ErrStat2, ErrMsg2, comment='(2ZetaOmegaM)') - call yaml_write_array(UnSum, 'CMMdiag',p%CMMDiag, ReFmt, ErrStat2, ErrMsg2, comment='(2 Zeta OmegaM)') - call yaml_write_array(UnSum, 'KBB', CBparams%KBB, ReFmt, ErrStat2, ErrMsg2, comment='') - call yaml_write_array(UnSum, 'KMM', CBparams%OmegaL**2, ReFmt, ErrStat2, ErrMsg2, comment='(diagonal components, OmegaL^2)') - call yaml_write_array(UnSum, 'KMMdiag', p%KMMDiag, ReFmt, ErrStat2, ErrMsg2, comment='(diagonal components, OmegaL^2)') - IF (p%SttcSolve/= idSIM_None) THEN - call yaml_write_array(UnSum, 'PhiL', transpose(p%PhiL_T), ReFmt, ErrStat2, ErrMsg2, comment='') - call yaml_write_array(UnSum, 'PhiLOm2-1', p%PhiLInvOmgL2, ReFmt, ErrStat2, ErrMsg2, comment='') - call yaml_write_array(UnSum, 'KLL^-1' , p%KLLm1 , ReFmt, ErrStat2, ErrMsg2, comment='') - endif - ! --- Reduction info - WRITE(UnSum, '(A)') SectionDivide - call yaml_write_array(UnSum, 'T_red', p%T_red, 'ES9.2E2', ErrStat2, ErrMsg2, comment='(Constraint elimination matrix)') - - ! --- Linearization/ state matrices - call StateMatrices(p, ErrStat2, ErrMsg2, AA, BB, CC, DD); if(Failed()) return - call yaml_write_array(UnSum, 'AA', AA, 'ES10.3E2', ErrStat2, ErrMsg2, comment='(State matrix dXdx)') - call yaml_write_array(UnSum, 'BB', BB, 'ES10.3E2', ErrStat2, ErrMsg2, comment='(State matrix dXdu)') - call yaml_write_array(UnSum, 'CC', CC, 'ES10.3E2', ErrStat2, ErrMsg2, comment='(State matrix dYdx)') - call yaml_write_array(UnSum, 'DD', DD, 'ES10.3E2', ErrStat2, ErrMsg2, comment='(State matrix dYdu)') - if(allocated(AA)) deallocate(AA) - if(allocated(BB)) deallocate(BB) - if(allocated(CC)) deallocate(CC) - if(allocated(DD)) deallocate(DD) - endif ! //--- END DEBUG OUTPUTS - - ! --- write TP TI matrix - WRITE(UnSum, '(A)') SectionDivide - call yaml_write_array(UnSum, 'TI' , p%TI , 'ES9.2E2', ErrStat2, ErrMsg2, comment='(TP refpoint Transformation Matrix TI)') - if (allocated(p%TIReact)) then - call yaml_write_array(UnSum, 'TIReact', p%TIReact, 'ES9.2E2', ErrStat2, ErrMsg2, comment='(Transformation Matrix TIreact to (0,0,-WtrDepth))') - endif - - call CleanUp() - -contains - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'OutSummary') - Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() - END FUNCTION Failed - SUBROUTINE CleanUp() - if(allocated(Omega)) deallocate(Omega) - if(allocated(Modes)) deallocate(Modes) - CALL SDOut_CloseSum( UnSum, ErrStat2, ErrMsg2 ) - END SUBROUTINE CleanUp -END SUBROUTINE OutSummary - -SUBROUTINE StateMatrices(p, ErrStat, ErrMsg, AA, BB, CC, DD, u) - type(SD_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 - real(R8Ki), dimension(:,:), allocatable, optional :: AA !< - real(R8Ki), dimension(:,:), allocatable, optional :: BB !< - real(R8Ki), dimension(:,:), allocatable, optional :: CC !< - real(R8Ki), dimension(:,:), allocatable, optional :: DD !< - type(SD_InputType), intent(in), optional :: u !< Inputs - integer(IntKi) :: nU, nX, nY, nCB, i, j, iNode, iOff, k, nMembers, iField - real(R8Ki), dimension(:), allocatable :: dFext_dFmeshk - real(R8Ki), dimension(:), allocatable :: dFred_dFmeshk - real(R8Ki), dimension(:), allocatable :: dFL_dFmeshk - real(R8Ki), dimension(:,:), allocatable :: PhiM_T - character(ErrMsgLen) :: ErrMsg2 - integer(IntKi) :: ErrStat2 - ErrStat = ErrID_None - ErrMsg = "" - - nCB = p%nDOFM - nX = 2*nCB - nU = 18 + 6*p%nNodes - nY=6 - - ! --- A matrix - if (present(AA)) then - if(allocated(AA)) deallocate(AA) - call AllocAry(AA, nX, nX, 'AA', ErrStat2, ErrMsg2 ); if(Failed()) return; AA(:,:) = 0.0_ReKi - if (nCB>0) then - do i=1,nCB - AA(i,nCB+i) = 1.0_ReKi ! Identity for 12 - enddo - do i=1,nCB - AA(nCB+i,i ) = -p%KMMDiag(i) ! 11 - AA(nCB+i,nCB+i) = -p%CMMDiag(i) ! 22 - enddo - endif - endif - - ! --- B matrix - if (present(BB)) then - if(allocated(BB)) deallocate(BB) - call AllocAry(BB, nX, nU, 'BB', ErrStat2, ErrMsg2 ); if(Failed()) return; BB(:,:) = 0.0_ReKi - if(nCB>0) then - BB(nCB+1:nX, 1 :6 ) = 0.0_ReKi - BB(nCB+1:nX, 13:18 ) = -p%MMB(1:nCB,1:6) ! TODO rotate - call AllocAry(dFext_dFmeshk, p%nDOF , 'dFext', ErrStat2, ErrMsg2 ); if(Failed()) return - call AllocAry(dFred_dFmeshk, p%nDOF_red , 'dFred', ErrStat2, ErrMsg2 ); if(Failed()) return - call AllocAry(dFL_dFmeshk , p%nDOF__L , 'dFl' , ErrStat2, ErrMsg2 ); if(Failed()) return - call AllocAry(PhiM_T , p%nDOFM , p%nDOF__L , 'PhiMT', ErrStat2, ErrMsg2 ); if(Failed()) return - PhiM_T = transpose(p%PhiM) - iOff=18 - k=0 - do iField = 1,2 ! Forces, Moment - do iNode = 1,p%nNodes - nMembers = (size(p%NodesDOF(iNode)%List)-3)/3 ! Number of members deducted from Node's nDOFList - do j=1,3 - k=k+1 - ! Build Fext with unit load (see GetExtForceOnInternalDOF) - dFext_dFmeshk= 0.0_ReKi - if (iField==1) then - ! Force - All nodes have only 3 translational DOFs - dFext_dFmeshk( p%NodesDOF(iNode)%List(j) ) = 1.0_ReKi - else - ! Moment is spread equally across all rotational DOFs if more than 3 rotational DOFs - dFext_dFmeshk( p%NodesDOF(iNode)%List((3+j)::3)) = 1.0_ReKi/nMembers - endif - ! Reduce and keep only "internal" DOFs L - if (p%reduced) then - dFred_dFmeshk = matmul(p%T_red_T, dFext_dFmeshk) - dFL_dFmeshk= dFred_dFmeshk(p%ID__L) - else - dFL_dFmeshk= dFext_dFmeshk(p%ID__L) - endif - ! - BB(nCB+1:nX, iOff+k) = matmul(PhiM_T, dFL_dFmeshk) - enddo ! 1-3 - enddo ! nodes - enddo ! field - endif - endif - - ! --- C matrix - if (present(CC)) then - if(allocated(CC)) deallocate(CC) - call AllocAry(CC, nY, nX, 'CC', ErrStat2, ErrMsg2 ); if(Failed()) return; CC(:,:) = 0.0_ReKi - !print*,'Warning: C matrix does not have all outputs, or extra moment, or static solve' - if (nCB>0) then - CC(1:nY,1:nCB ) = - p%C1_11 - CC(1:nY,nCB+1:nX) = - p%C1_12 - if (p%GuyanLoadCorrection .and. p%Floating .and. present(u)) then - CC(1:3,:) = matmul(transpose(u%TPMesh%Orientation(:,:,1)), CC(1:3,:)) ! >>> Rotate All - CC(4:6,:) = matmul(transpose(u%TPMesh%Orientation(:,:,1)), CC(4:6,:)) ! >>> Rotate All - endif - endif - endif - - ! --- D matrix - if (present(DD)) then - !print*,'Warning: D matrix does not have all outputs, or extra moment, or static solve' - if(allocated(DD)) deallocate(DD) - call AllocAry(DD, nY, nU, 'DD', ErrStat2, ErrMsg2 ); if(Failed()) return; DD(:,:) = 0.0_ReKi - DD(1:nY,1:6 ) = - p%KBB - DD(1:nY,7:12 ) = - p%CBB - DD(1:nY,13:18 ) = - p%MBB - if (p%nDOFM>0) then - if (p%GuyanLoadCorrection .and. p%Floating .and. present(u)) then - ! TODO TODO rotate it A MBmmB A^t - !DD(1:3,:) = DD(1:3,:) + matmul(transpose(u%TPMesh%Orientation(:,:,1)), p%MBmmB(1:3,:) ! >>> Rotate All - DD(1:nY,13:18 ) = DD(1:nY,13:18 )+ p%MBmmB - else - DD(1:nY,13:18 ) = DD(1:nY,13:18 )+ p%MBmmB - endif - endif - endif - - call CleanUp() -contains - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'StateMatrices') - Failed = ErrStat >= AbortErrLev - if(Failed) call CleanUp() - END FUNCTION Failed - SUBROUTINE CleanUp() - if(allocated(dFext_dFmeshk)) deallocate(dFext_dFmeshk) - if(allocated(dFred_dFmeshk)) deallocate(dFred_dFmeshk) - if(allocated(dFL_dFmeshk)) deallocate(dFL_dFmeshk) - if(allocated(PhiM_T)) deallocate(PhiM_T) - END SUBROUTINE CleanUp -END SUBROUTINE StateMatrices - -!------------------------------------------------------------------------------------------------------ -!> Calculate length of a member as given in input file -!! Joints and Members ID have not been reindexed (Elems and Nodes have) -FUNCTION MemberLength(MemberID,Init,ErrStat,ErrMsg) - TYPE(SD_InitType), INTENT(IN) :: Init !< Input data for initialization routine, this structure contains many variables needed for summary file - INTEGER(IntKi), INTENT(IN) :: MemberID !< Member ID # - REAL(ReKi) :: MemberLength !< Member Length - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - !Locals - REAL(Reki) :: xyz1(3),xyz2(3) ! Coordinates of joints in GLOBAL REF SYS - integer(IntKi) :: iMember !< Member index in Init%Members list - INTEGER(IntKi) :: Joint1,Joint2 ! JointID - CHARACTER(*), PARAMETER :: RoutineName = 'MemberLength' - ErrStat = ErrID_None - ErrMsg = '' - MemberLength=0.0 - - !Find the MemberID in the list - iMember = FINDLOCI(Init%Members(:,1), MemberID) - if (iMember<=0) then - call SetErrStat(ErrID_Fatal,' Member with ID '//trim(Num2LStr(MemberID))//' not found in member list!', ErrStat,ErrMsg,RoutineName); - return - endif - ! Find joints ID for this member - Joint1 = FINDLOCI(Init%Joints(:,1), Init%Members(iMember,2)) - Joint2 = FINDLOCI(Init%Joints(:,1), Init%Members(iMember,3)) - xyz1= Init%Joints(Joint1,2:4) - xyz2= Init%Joints(Joint2,2:4) - MemberLength=SQRT( SUM((xyz2-xyz1)**2.) ) - if ( EqualRealNos(MemberLength, 0.0_ReKi) ) then - call SetErrStat(ErrID_Fatal,' Member with ID '//trim(Num2LStr(MemberID))//' has zero length!', ErrStat,ErrMsg,RoutineName); - return - endif -END FUNCTION MemberLength - -!------------------------------------------------------------------------------------------------------ -!> Calculate member mass, given properties at the ends, keep units consistent -!! For now it works only for circular pipes or for a linearly varying area -FUNCTION BeamMass(rho1,D1,t1,rho2,D2,t2,L,ctube) - REAL(ReKi), INTENT(IN) :: rho1,D1,t1,rho2,D2,t2 ,L ! Density, OD and wall thickness for circular tube members at ends, Length of member - LOGICAL, INTENT(IN) :: ctube ! =TRUE for circular pipes, false elseshape - REAL(ReKi) :: BeamMass !mass - REAL(ReKi) :: a0,a1,a2,b0,b1,dd,dt !temporary coefficients - !Density allowed to vary linearly only - b0=rho1 - b1=(rho2-rho1)/L - !Here we will need to figure out what element it is for now circular pipes - IF (ctube) THEN !circular tube - a0=pi * (D1*t1-t1**2.) - dt=t2-t1 !thickness variation - dd=D2-D1 !OD variation - a1=pi * ( dd*t1 + D1*dt -2.*t1*dt)/L - a2=pi * ( dd*dt-dt**2.)/L**2. - ELSE !linearly varying area - a0=D1 !This is an area - a1=(D2-D1)/L !Delta area - a2=0. - ENDIF - BeamMass= b0*a0*L +(a0*b1+b0*a1)*L**2/2. + (b0*a2+b1*a1)*L**3/3 + a2*b1*L**4/4.!Integral of rho*A dz -END FUNCTION BeamMass - -!------------------------------------------------------------------------------------------------------ -!> Check whether MAT IS SYMMETRIC AND RETURNS THE MAXIMUM RELATIVE ERROR -SUBROUTINE SymMatDebug(M,MAT) - INTEGER(IntKi), INTENT(IN) :: M ! Number of rows and columns - REAL(ReKi),INTENT(IN) :: MAT(M ,M) !matrix to be checked - !LOCALS - REAL(ReKi) :: Error,MaxErr !element by element relative difference in (Transpose(MAT)-MAT)/MAT - INTEGER(IntKi) :: i, j, imax,jmax !counter and temporary holders - - MaxErr=0. - imax=0 - jmax=0 - DO j=1,M - DO i=1,M - Error=MAT(i,j)-MAT(j,i) - IF (MAT(i,j).NE.0) THEN - Error=ABS(Error)/MAT(i,j) - ENDIF - IF (Error > MaxErr) THEN - imax=i - jmax=j - MaxErr=Error - ENDIF - ENDDO - ENDDO - - !-------------------------------------- - ! write discretized data to a txt file - WRITE(*, '(A,e15.6)') 'Matrix Symmetry Check: Largest (abs) relative error is:', MaxErr - WRITE(*, '(A,I4,I4)') 'Matrix Symmetry Check: (I,J)=', imax,jmax - -END SUBROUTINE SymMatDebug - -FUNCTION is_numeric(string, x) - IMPLICIT NONE - CHARACTER(len=*), INTENT(IN) :: string - REAL(ReKi), INTENT(OUT) :: x - LOGICAL :: is_numeric - INTEGER :: e,n - CHARACTER(len=12) :: fmt - x = 0.0_ReKi - n=LEN_TRIM(string) - WRITE(fmt,'("(F",I0,".0)")') n - READ(string,fmt,IOSTAT=e) x - is_numeric = e == 0 -END FUNCTION is_numeric -FUNCTION is_logical(string, b) - IMPLICIT NONE - CHARACTER(len=*), INTENT(IN) :: string - Logical, INTENT(OUT) :: b - LOGICAL :: is_logical - INTEGER :: e,n - b = .false. - n=LEN_TRIM(string) - READ(string,*,IOSTAT=e) b - is_logical = e == 0 -END FUNCTION is_logical - -!> Parses a file for Kxx,Kxy,..Kxthtx,..Kxtz, Kytx, Kyty,..Kztz -SUBROUTINE ReadSSIfile ( Filename, JointID, SSIK, SSIM, ErrStat, ErrMsg, UnEc ) - USE NWTC_IO - INTEGER, INTENT(IN) :: JointID !< ID of th ejoint for which we are reading SSI - INTEGER, INTENT(IN), OPTIONAL :: UnEc !< I/O unit for echo file. If present and > 0, write to UnEc - INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status; if present, program does not abort on error - CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message - INTEGER :: CurLine !< The current line to be parsed in the FileInfo structure. - REAL(FEKi), INTENT(INOUT) , dimension(21) :: SSIK, SSIM !< Matrices being filled by reading the file. - CHARACTER(*), INTENT(IN) :: Filename !< Name of the input file. - ! Local declarations: - CHARACTER(5), DIMENSION(21) :: Knames=(/'Kxx ','Kxy ','Kyy ','Kxz ','Kyz ', 'Kzz ','Kxtx ','Kytx ','Kztx ','Ktxtx', & - 'Kxty ','Kyty ','Kzty ','Ktxty','Ktyty', & - 'Kxtz ','Kytz ','Kztz ','Ktxtz','Ktytz','Ktztz'/) ! Dictionary of names by column for an Upper Triangular Matrix - CHARACTER(5), DIMENSION(21) :: Mnames=(/'Mxx ','Mxy ','Myy ','Mxz ','Myz ', 'Mzz ','Mxtx ','Mytx ','Mztx ','Mtxtx', & - 'Mxty ','Myty ','Mzty ','Mtxty','Mtyty', & - 'Mxtz ','Mytz ','Mztz ','Mtxtz','Mtytz','Mtztz'/) - TYPE (FileInfoType) :: FileInfo ! The derived type for holding the file information. - INTEGER(IntKi) :: i, j, imax !counters - CHARACTER(ErrMsgLen) :: ErrMsg2 - INTEGER(IntKi) :: ErrStat2 ! Error status; if present, program does not abort on error - CHARACTER(*), PARAMETER :: RoutineName = 'ReadSSIfile' - - SSIK=0.0_FEKi - SSIM=0.0_FEKi - - CALL ProcessComFile ( Filename, FileInfo, ErrStat2, ErrMsg2 );CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ); IF (ErrStat >= AbortErrLev) RETURN - CurLine = 1 - imax=21 - DO i=1, imax !This will search also for already hit up names, but that's ok, it should be pretty fast - DO j=1,FileInfo%NumLines - CurLine=j - CALL ParseVarWDefault ( FileInfo, CurLine, Knames(i), SSIK(i), 0.0_FEKi, ErrStat2, ErrMsg2 ) - CALL ParseVarWDefault ( FileInfo, CurLine, Mnames(i), SSIM(i), 0.0_FEKi, ErrStat2, ErrMsg2 ) - ENDDO - ENDDO - IF ( PRESENT(UnEc) ) THEN - IF ( UnEc .GT. 0 ) THEN - WRITE (UnEc,'(1X,A20," = ",I11)') 'JOINT ID',JointID - DO i=1,21 - WRITE (UnEc,'(1X,ES11.4e2," = ",A20)') SSIK(i), Knames(i) - WRITE (UnEc,'(1X,ES11.4e2," = ",A20)') SSIM(i), Mnames(i) - ENDDO - ENDIF - END IF - RETURN -END SUBROUTINE ReadSSIfile - - -end module SubDyn diff --git a/OpenFAST/modules/subdyn/src/SubDyn_Driver.f90 b/OpenFAST/modules/subdyn/src/SubDyn_Driver.f90 deleted file mode 100644 index bbe48257b..000000000 --- a/OpenFAST/modules/subdyn/src/SubDyn_Driver.f90 +++ /dev/null @@ -1,349 +0,0 @@ -!********************************************************************************************************************************** -! SubDyn_DriverCode: This code tests the SubDyn modules -!.................................................................................................................................. -! LICENSING -! Copyright (C) 2013-2016 National Renewable Energy Laboratory -! -! This file is part of SubDyn. -! -! 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. -! -!********************************************************************************************************************************** -PROGRAM TestSubDyn - - USE NWTC_Library - USE SubDyn - USE SubDyn_Types - USE SubDyn_Output - USE VersionInfo - - IMPLICIT NONE - - INTEGER(IntKi), PARAMETER :: NumInp = 1 ! Number of inputs sent to SD_UpdateStates - - - TYPE SD_Drvr_InitInput - LOGICAL :: Echo - REAL(ReKi) :: Gravity - CHARACTER(1024) :: SDInputFile - REAL(ReKi) :: WtrDpth - CHARACTER(1024) :: OutRootName - INTEGER :: NSteps - REAL(DbKi) :: TimeInterval - REAL(ReKi) :: TP_RefPoint(3) - REAL(ReKi) :: SubRotateZ - INTEGER :: InputsMod - CHARACTER(1024) :: InputsFile - REAL(ReKi) :: uTPInSteady(6) - REAL(ReKi) :: uDotTPInSteady(6) - REAL(ReKi) :: uDotDotTPInSteady(6) - END TYPE SD_Drvr_InitInput - - - ! Program variables - - REAL(DbKi) :: Time ! Variable for storing time, in seconds - REAL(DbKi) :: TimeInterval ! Interval between time steps, in seconds - REAL(DbKi) :: InputTime(NumInp) ! Variable for storing time associated with inputs, in seconds - - TYPE(SD_InitInputType) :: InitInData ! Input data for initialization - TYPE(SD_InitOutputType) :: InitOutData ! Output data from initialization - - TYPE(SD_ContinuousStateType) :: x ! Continuous states - TYPE(SD_DiscreteStateType) :: xd ! Discrete states - TYPE(SD_ConstraintStateType) :: z ! Constraint states - TYPE(SD_OtherStateType) :: OtherState ! Other states - TYPE(SD_MiscVarType) :: m ! Misc/optimization variables - - TYPE(SD_ParameterType) :: p ! Parameters - TYPE(SD_InputType) :: u(NumInp) ! System inputs - TYPE(SD_OutputType) :: y ! System outputs - - - INTEGER(IntKi) :: n ! Loop counter (for time step) - INTEGER(IntKi) :: ErrStat, ErrStat1, ErrStat2, ErrStat3 ! Status of error message - CHARACTER(1024) :: ErrMsg, ErrMsg1, ErrMsg2, ErrMsg3 ! Error message if ErrStat /= ErrID_None - - - CHARACTER(1024) :: drvrFilename ! Filename and path for the driver input file. This is passed in as a command line argument when running the Driver exe. - TYPE(SD_Drvr_InitInput) :: drvrInitInp ! Initialization data for the driver program - INTEGER :: UnIn ! Unit number for the input file - INTEGER :: UnEcho ! The local unit number for this module's echo file - INTEGER(IntKi) :: UnSD_Out ! Output file identifier - REAL(ReKi), ALLOCATABLE :: SDin(:,:) ! Variable for storing time, forces, and body velocities, in m/s or rad/s for SubDyn inputs - INTEGER(IntKi) :: J ! Generic loop counter - REAL(ReKi) :: dcm (3,3) ! The resulting transformation matrix from X to x, (-). - CHARACTER(10) :: AngleMsg ! For debugging, a string version of the largest rotation input - - ! Other/Misc variables - REAL(DbKi) :: TiLstPrn ! The time of the last print - REAL(DbKi) :: TMax - REAL(DbKi) :: OutTime ! Used to determine if output should be generated at this simulation time - REAL(ReKi) :: PrevClockTime ! Clock time at start of simulation in seconds - REAL(ReKi) :: UsrTime1 ! User CPU time for simulation initialization - INTEGER :: StrtTime (8) ! Start time of simulation - CHARACTER(200) :: git_commit ! String containing the current git commit hash - TYPE(ProgDesc), PARAMETER :: version = ProgDesc( 'SubDyn Driver', '', '' ) ! The version number of this program. - !............................................................................................................................... - ! Routines called in initialization - !............................................................................................................................... - ErrMsg = "" - ErrStat = ErrID_None - UnEcho=-1 - UnIn =-1 - - ! Get the current time - 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) - PrevClockTime = TimeValues2Seconds( StrtTime ) ! We'll use this time for the SimStats routine - TiLstPrn = 0.0_DbKi ! The first value of ZTime, used to write simulation stats to screen (s) - - ! Initialize the NWTC Subroutine Library - CALL NWTC_Init( ) - - ! Display the copyright notice - CALL DispCopyrightLicense( version%Name ) - ! Obtain OpenFAST git commit hash - git_commit = QueryGitVersion() - ! Tell our users what they're running - CALL WrScr( ' Running '//TRIM( version%Name )//' a part of OpenFAST - '//TRIM(git_Commit)//NewLine//' linked with '//TRIM( NWTC_Ver%Name )//NewLine ) - - ! Set the abort error level to a fatal error - AbortErrLev = ErrID_Fatal - - IF ( command_argument_count() /= 1 ) then - CALL print_help() - STOP - endif - - ! Parse the driver input file and run the simulation based on that file - IF ( command_argument_count() == 1 ) THEN - CALL get_command_argument(1, drvrFilename) - - CALL ReadDriverInputFile( drvrFilename, drvrInitInp); - InitInData%g = drvrInitInp%Gravity - InitInData%SDInputFile = drvrInitInp%SDInputFile - InitInData%RootName = drvrInitInp%OutRootName - InitInData%TP_RefPoint = drvrInitInp%TP_RefPoint - InitInData%SubRotateZ = drvrInitInp%SubRotateZ - TimeInterval = drvrInitInp%TimeInterval - InitInData%WtrDpth = drvrInitInp%WtrDpth - END IF - - TMax = TimeInterval * drvrInitInp%NSteps - - ! Initialize the module - CALL SD_Init( InitInData, u(1), p, x, xd, z, OtherState, y, m, TimeInterval, InitOutData, ErrStat2, ErrMsg2 ); call AbortIfFailed() - - CALL AllocAry(SDin, drvrInitInp%NSteps, 19, 'SDinput array', ErrStat2, ErrMsg2); call AbortIfFailed() - SDin(:,:)=0.0_ReKi - - ! Read Input time series data from a file - IF ( drvrInitInp%InputsMod == 2 ) THEN - ! Open the inputs data file - CALL GetNewUnit( UnIn ) - CALL OpenFInpFile ( UnIn, drvrInitInp%InputsFile, ErrStat2, ErrMsg2); Call AbortIfFailed() - DO n = 1,drvrInitInp%NSteps - ! TODO Add safety for backward compatibility if only 13 columns - READ (UnIn,*,IOSTAT=ErrStat2) (SDin (n,J), J=1,19) - ErrMsg2 = ' Error reading line '//trim(Num2LStr(n))//' of file: '//trim(drvrInitInp%InputsFile) - call AbortIfFailed() - END DO - CLOSE ( UnIn ) - else - ! We fill an array with constant values - do n = 0,drvrInitInp%NSteps-1 ! Loop on time steps, starts at 0 - SDin(n+1,1) = n*TimeInterval - SDin(n+1,2:7 ) = drvrInitInp%uTPInSteady(1:6) ! Displacements - SDin(n+1,8:13) = drvrInitInp%uDotTPInSteady(1:6) ! Velocities - !SDin(n+1,14:19) = drvrInitInp%uDotDotTPInSteady(1:6) ! Accelerations - enddo - end if - - ! Destroy initialization data - CALL SD_DestroyInitInput( InitInData, ErrStat2, ErrMsg2 ); call AbortIfFailed() - CALL SD_DestroyInitOutput( InitOutData, ErrStat2, ErrMsg2 ); call AbortIfFailed() - - !............................................................................................................................... - ! Routines called in loose coupling -- the glue code may implement this in various ways - !............................................................................................................................... - ! Force the displacement of the interface node in the global Z direction to be the sag of the column under it's own weight - ! u(1)%UFL(3) =-12.958 !this is for testbeam3 - - ! TEMPORARY HACK FOR CONTROLLABLE CABLES - !allocate(u(1)%CableDeltaL(5)) - !!u(1)%CableDeltaL= 1.0e7_ReKi - !u(1)%CableDeltaL= 0.0e7_ReKi - - call WrScr('') - DO n = 0,drvrInitInp%NSteps-1 ! Loop on time steps, starts at 0 - - Time = n*TimeInterval - InputTime(1) = Time - - ! Set module inputs u (likely from the outputs of another module or a set of test conditions) here: - IF ( u(1)%TPMesh%Initialized ) THEN - ! For now, set all hydrodynamic load inputs to 0.0 - u(1)%LMesh%Force (:,:) = 0.0 - u(1)%LMesh%Moment (:,:) = 0.0 - - ! Input displacements, velocities and potentially accelerations - u(1)%TPMesh%TranslationDisp(:,1) = SDin(n+1,2:4) - CALL SmllRotTrans( 'InputRotation', REAL(SDin(n+1,5),reki), REAL(SDin(n+1,6),reki), REAL(SDin(n+1,7),reki), dcm, 'Junk', ErrStat, ErrMsg ) - u(1)%TPMesh%Orientation(:,:,1) = dcm - u(1)%TPMesh%TranslationVel(:,1) = SDin(n+1,8:10) - u(1)%TPMesh%RotationVel(:,1) = SDin(n+1,11:13) - - IF ( drvrInitInp%InputsMod == 2 ) THEN - u(1)%TPMesh%TranslationAcc(:,1) = SDin(n+1,14:16) - u(1)%TPMesh%RotationAcc(:,1) = SDin(n+1,17:19) - ELSE ! constant inputs - u(1)%TPMesh%TranslationAcc(:,1) = drvrInitInp%uDotDotTPInSteady(1:3) - u(1)%TPMesh%RotationAcc(:,1) = drvrInitInp%uDotDotTPInSteady(4:6) - END IF - END IF - - - ! Calculate outputs at n - CALL SD_CalcOutput( Time, u(1), p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2); call AbortIfFailed() - ! Get state variables at next step: INPUT at step n, OUTPUT at step n + 1 - CALL SD_UpdateStates( Time, n, u, InputTime, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2); call AbortIfFailed() - ! Display simulation status every SttsTime-seconds: - IF ( Time - TiLstPrn >= 1 ) THEN - CALL SimStatus( TiLstPrn, PrevClockTime, Time, TMax ) - ENDIF - - END DO ! Loop on n, time steps - - ! Routine to terminate program execution - CALL SD_End( u(1), p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2) - IF ( ErrStat /= ErrID_None ) THEN - CALL WrScr( ErrMsg ) - END IF - - ! Write simulation times and stop - CALL RunTimes( StrtTime, UsrTime1, StrtTime, UsrTime1, Time ) - -CONTAINS - SUBROUTINE AbortIfFailed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SubDyn_Driver') - IF ( ErrStat /= ErrID_None ) THEN - CALL WrScr( ErrMsg ) - END IF - if (ErrStat >= AbortErrLev) then - call CleanUp() - STOP - endif - END SUBROUTINE AbortIfFailed - - SUBROUTINE CleanUp() - if(UnEcho>0) CLOSE(UnEcho) - if(UnEcho>0) CLOSE( UnIn) - if(allocated(SDin)) deallocate(SDin) - END SUBROUTINE CleanUp - - !------------------------------------------------------------------------------------------------------------------------------- - SUBROUTINE ReadDriverInputFile( inputFile, InitInp) - CHARACTER(*), INTENT( IN ) :: inputFile - TYPE(SD_Drvr_InitInput), INTENT( OUT ) :: InitInp - ! Local variables - INTEGER :: I ! generic integer for counting - INTEGER :: J ! generic integer for counting - CHARACTER( 2) :: strI ! string version of the loop counter - - CHARACTER(1024) :: EchoFile ! Name of SubDyn echo file - CHARACTER(1024) :: Line ! String to temporarially hold value of read line - CHARACTER(1024) :: TmpPath ! Temporary storage for relative path name - CHARACTER(1024) :: TmpFmt ! Temporary storage for format statement - CHARACTER(1024) :: FileName ! Name of SubDyn input file - CHARACTER(1024) :: FilePath ! Path Name of SubDyn input file - - UnEcho=-1 - UnIn =-1 - - FileName = TRIM(inputFile) - - CALL GetNewUnit( UnIn ) - CALL OpenFInpFile( UnIn, FileName, ErrStat2, ErrMsg2); - call AbortIfFailed() - - CALL WrScr( 'Opening SubDyn Driver input file: '//FileName ) - - ! Read until "echo" - CALL ReadCom( UnIn, FileName, 'SubDyn Driver input file header line 1', ErrStat2, ErrMsg2); call AbortIfFailed() - CALL ReadCom( UnIn, FileName, 'SubDyn Driver input file header line 2', ErrStat2, ErrMsg2); call AbortIfFailed() - CALL ReadVar ( UnIn, FileName, InitInp%Echo, 'Echo', 'Echo Input', ErrStat2, ErrMsg2); call AbortIfFailed() - ! If we echo, we rewind - IF ( InitInp%Echo ) THEN - EchoFile = TRIM(FileName)//'.echo' - CALL GetNewUnit( UnEcho ) - CALL OpenEcho ( UnEcho, EchoFile, ErrStat, ErrMsg ); call AbortIfFailed() - REWIND(UnIn) - CALL ReadCom( UnIn, FileName, 'SubDyn Driver input file header line 1', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() - CALL ReadCom( UnIn, FileName, 'SubDyn Driver input file header line 2', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() - CALL ReadVar ( UnIn, FileName, InitInp%Echo, 'Echo', 'Echo the input file data', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() - END IF - !---------------------- ENVIRONMENTAL CONDITIONS ------------------------------------------------- - CALL ReadCom( UnIn, FileName, 'Environmental conditions header', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() - CALL ReadVar( UnIn, FileName, InitInp%Gravity, 'Gravity', 'Gravity', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() - CALL ReadVar( UnIn, FileName, InitInp%WtrDpth, 'WtrDpth', 'WtrDpth', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() - !---------------------- SubDyn ------------------------------------------------------------------- - CALL ReadCom( UnIn, FileName, 'SubDyn header', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() - CALL ReadVar( UnIn, FileName, InitInp%SDInputFile, 'HDInputFile', 'SubDyn input filename', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() - CALL ReadVar( UnIn, FileName, InitInp%OutRootName, 'OutRootName', 'SubDyn output root filename', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() - CALL ReadVar( UnIn, FileName, InitInp%NSteps , 'NSteps', 'Number of time steps in the SubDyn simulation', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() - CALL ReadVar( UnIn, FileName, InitInp%TimeInterval, 'TimeInterval', 'Time interval for any SubDyn inputs', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() - CALL ReadAry( UnIn, FileName, InitInp%TP_RefPoint, 3, 'TP reference point', 'TP reference point', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() - CALL ReadVar( UnIn, FileName, InitInp%SubRotateZ, 'SubRotateZ', 'Rotation angle in degrees about Z axis.', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() - !---------------------- INPUTS ------------------------------------------------------------------- - CALL ReadCom( UnIn, FileName, 'INPUTS header', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() - CALL ReadVar( UnIn, FileName, InitInp%InputsMod , 'InputsMod', 'Model for the inputs', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() - CALL ReadVar( UnIn, FileName, InitInp%InputsFile, 'InputsFile', 'Filename for the SubDyn inputs', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() - !---------------------- STEADY INPUTS (for InputsMod = 1) ---------------------------------------- - CALL ReadCom( UnIn, FileName, 'STEADY STATE INPUTS header', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() - IF ( InitInp%InputsMod == 1 ) THEN - CALL ReadAry ( UnIn, FileName, InitInp%uTPInSteady , 6, 'uInSteady', 'Steady-state TP displacements and rotations.', ErrStat2, ErrMsg2, UnEcho) - CALL ReadAry ( UnIn, FileName, InitInp%uDotTPInSteady , 6, 'uDotTPInSteady', 'Steady-state TP translational and rotational velocities.', ErrStat2, ErrMsg2, UnEcho) - CALL ReadAry ( UnIn, FileName, InitInp%uDotDotTPInSteady, 6, 'uDotDotTPInSteady', 'Steady-state TP translational and rotational accelerations.', ErrStat2, ErrMsg2, UnEcho) - ELSE - InitInp%uTPInSteady = 0.0 - InitInp%uDotTPInSteady = 0.0 - InitInp%uDotDotTPInSteady = 0.0 - END IF - if(UnEcho>0) CLOSE( UnEcho ) - if(UnIn>0) CLOSE( UnIn ) - - ! Perform input checks and triggers - CALL GetPath( FileName, FilePath ) - IF ( PathIsRelative( InitInp%SDInputFile ) ) then - InitInp%SDInputFile = TRIM(FilePath)//TRIM(InitInp%SDInputFile) - END IF - IF ( PathIsRelative( InitInp%OutRootName ) ) then - InitInp%OutRootName = TRIM(FilePath)//TRIM(InitInp%OutRootName) - endif - IF ( PathIsRelative( InitInp%InputsFile ) ) then - InitInp%InputsFile = TRIM(FilePath)//TRIM(InitInp%InputsFile) - endif - - END SUBROUTINE ReadDriverInputFile - - subroutine print_help() - print '(a)', 'usage: ' - print '(a)', '' - print '(a)', 'SubDynDriver.exe driverfilename' - print '(a)', '' - print '(a)', 'Where driverfilename is the name of the SubDyn driver input file.' - print '(a)', '' - end subroutine print_help -!---------------------------------------------------------------------------------------------------------------------------------- -END PROGRAM TestSubDyn diff --git a/OpenFAST/modules/subdyn/src/SubDyn_Output.f90 b/OpenFAST/modules/subdyn/src/SubDyn_Output.f90 deleted file mode 100644 index 88b05b9be..000000000 --- a/OpenFAST/modules/subdyn/src/SubDyn_Output.f90 +++ /dev/null @@ -1,1051 +0,0 @@ -!.................................................................................................................................. -! LICENSING -! Copyright (C) 2013-2016 National Renewable Energy Laboratory -! -! This file is part of SubDyn. -! -! 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. -! -!********************************************************************************************************************************** -MODULE SubDyn_Output - USE NWTC_Library - USE SubDyn_Types - USE SD_FEM - USE SubDyn_Output_Params, only: MNfmKe, MNfmMe, MNTDss, MNRDe, MNTRAe, IntfSS, IntfTRss, IntfTRAss, ReactSS - USE SubDyn_Output_Params, only: ParamIndxAry, ParamUnitsAry, ValidParamAry, SSqm01, SSqmd01, SSqmdd01 - - IMPLICIT NONE - - ! The maximum number of output channels which can be output by the code. - INTEGER(IntKi),PUBLIC, PARAMETER :: MaxOutPts = 2265 - - PRIVATE - ! ..... Public Subroutines ................................................................................................... - PUBLIC :: SDOut_CloseSum - PUBLIC :: SDOut_OpenSum - PUBLIC :: SDOut_MapOutputs - PUBLIC :: SDOut_OpenOutput - PUBLIC :: SDOut_CloseOutput - PUBLIC :: SDOut_WriteOutputNames - PUBLIC :: SDOut_WriteOutputUnits - PUBLIC :: SDOut_WriteOutputs - PUBLIC :: SDOut_Init - PUBLIC :: SD_Init_Jacobian - PUBLIC :: SD_Perturb_u - PUBLIC :: SD_Perturb_x - PUBLIC :: SD_Compute_dY - PUBLIC :: SD_Compute_dX - -CONTAINS - - -!> This subroutine initializes the output module, checking if the output parameter list (OutList) -! contains valid names, and opening the output file if there are any requested outputs -SUBROUTINE SDOut_Init( Init, y, p, misc, InitOut, WtrDpth, ErrStat, ErrMsg ) - TYPE(SD_InitType), INTENT( INOUT ) :: Init ! data needed to initialize the output module - TYPE(SD_OutputType), INTENT( INOUT ) :: y ! SubDyn module's output data - TYPE(SD_ParameterType), target, INTENT( INOUT ) :: p ! SubDyn module paramters - TYPE(SD_MiscVarType), INTENT( INOUT ) :: misc ! SubDyn misc/optimization variables - TYPE(SD_InitOutputType ), INTENT( INOUT ) :: InitOut ! SubDyn module initialization output data - REAL(ReKi), INTENT( IN ) :: WtrDpth ! water depth from initialization routine - INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! Local variables - INTEGER(IntKi) :: ErrStat2 ! Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None - INTEGER(IntKi) :: I,J,K2 !Counters - INTEGER(IntKi) :: iMember ! Member index (not member ID) - INTEGER(IntKi) :: iElem ! Index of element in Element List - INTEGER(IntKi) :: iNode ! Index of node in Node list - INTEGER(IntKi) :: iiElem ! Loop counter on element index - INTEGER(IntKi) :: nElemPerNode, nNodesPerElem ! Number of elements connecting to a node, Number of nodes per elem - type(MeshAuxDataType), pointer :: pLst !< Alias to shorten notation and highlight code similarities - real(ReKi), allocatable :: T_TIreact(:,:) ! Transpose of TIreact, temporary - ErrStat = 0 - ErrMsg="" - - p%OutAllDims=12*p%NMembers*2 !size of AllOut Member Joint forces - - ! Check that the variables in OutList are valid - CALL SDOut_ChkOutLst( Init%SSOutList, p, ErrStat2, ErrMsg2 ); if(Failed()) return - - ! --- Allocation (size 0 if not outputs) - !IF ( ALLOCATED( p%OutParam ) .AND. p%NumOuts > 0 ) THEN ! Output has been requested - ! Allocate SDWrOuput which is used to store a time step's worth of output channels, prior to writing to a file. - CALL AllocAry(misc%SDWrOutput , p%NumOuts + p%OutAllInt*p%OutAllDims, 'SDWrOutupt' , ErrStat2, ErrMsg2) ; if(Failed()) return - ! Allocate WriteOuput - CALL AllocAry(y%WriteOutput , p%NumOuts + p%OutAllInt*p%OutAllDims, 'WriteOutput', ErrStat2, ErrMsg2); if(Failed()) return - ! Header, and Units, copy of data already available in the OutParam data structure ! TODO TODO TODO remove copy - CALL AllocAry(InitOut%WriteOutputHdr, p%NumOuts + p%OutAllint*p%OutAllDims, 'WriteOutputHdr', ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(InitOut%WriteOutputUnt, p%NumOuts + p%OutAllint*p%OutAllDims, 'WriteOutputUnt', ErrStat2, ErrMsg2); if(Failed()) return - misc%SDWrOutput = 0.0_ReKi - misc%LastOutTime = 0.0_DbKi - misc%Decimat = 0 - y%WriteOutput = 0 - DO I = 1,p%NumOuts+p%OutAllint*p%OutAllDims - InitOut%WriteOutputHdr(I) = TRIM( p%OutParam(I)%Name ) - InitOut%WriteOutputUnt(I) = TRIM( p%OutParam(I)%Units ) - END DO - - !_________________________________ OUTPUT FOR REQUESTED MEMBERS _______________________________ - DO I=1,p%NMOutputs - pLst => p%MOutLst(I) ! Alias to shorten notations - CALL AllocAry(pLst%NodeIDs, pLst%NoutCnt , 'MOutLst(I)%NodeIDs', ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(pLst%ElmIDs, pLst%NoutCnt, 2, 'MOutLst(I)%ElmIDs' , ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(pLst%ElmNds, pLst%NoutCnt, 2, 'MOutLst(I)%ElmNds' , ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(pLst%Me, 12, 12, pLst%NoutCnt, 2, 'MOutLst(I)%Me' , ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(pLst%Ke, 12, 12, pLst%NoutCnt, 2, 'MOutLst(I)%Ke' , ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(pLst%Fg, 12, pLst%NoutCnt, 2, 'MOutLst(I)%Fg' , ErrStat2, ErrMsg2); if(Failed()) return - - ! NOTE: len(MemberNodes) >2 if nDiv>1 - iMember = FINDLOCI(Init%Members(:,1), pLst%MemberID) ! Reindexing from MemberID to 1:nMembers - pLst%NodeIDs(1:pLst%NoutCnt)=Init%MemberNodes(iMember, pLst%NodeCnt) ! We are storing the actual node numbers corresponding to what the user ordinal number is requesting - pLst%ElmIDs=0 !Initialize to 0 - pLst%ElmNds=0 !Initialize to 0 - - DO J=1,pLst%NoutCnt ! loop on requested nodes for that member - iNode = pLst%NodeIDs(J) ! Index of requested node in node list - nElemPerNode = Init%NodesConnE(iNode, 1) ! Number of elements connecting to the j-th node - ! Finding 1 or max 2 elements that belong to the member and connect to the node - K2=0 ! Counter so that max 2 elements are included: NOTE: I belive more than 2 should be an error - DO iiElem = 1, nElemPerNode - iElem = Init%NodesConnE(iNode, iiElem+1) ! iiElem-th Element Number - IF (ThisElementIsAlongMember(iElem, iNode, iMember)) THEN - IF (K2 == 2) EXIT ! we found both elements already, error... - K2=K2+1 - call ConfigOutputNode_MKF_ID(pLst, iElem, iiNode=J, iStore=K2, NodeID2=iNode) - END IF - ENDDO ! iiElem, nElemPerNode - ENDDO !J, Noutcnt - ENDDO !I, NMOutputs - - !_________________________________ OUTPUT FOR ALL MEMBERS __________________________________ - IF (p%OutAll) THEN !I need to store all member end forces and moments - - ! MOutLst2: nodal output info by members, for all members, First and Last Node - ALLOCATE ( p%MOutLst2(p%NMembers), STAT = ErrStat2 ); ErrMsg2 = 'Error allocating p%MOutLst2 array in SDOut_Init'; if(Failed()) return - - DO iMember=1,p%NMembers - pLst => p%MOutLst2(iMember) ! Alias - pLst%MemberID = Init%Members(iMember,1) - nNodesPerElem = count(Init%MemberNodes(iMember,:) >0 ) - CALL AllocAry(pLst%NodeIDs, nNodesPerElem, 'MOutLst2(I)%NodeIDs', ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(pLst%ElmIDs, 2, 1, 'MOutLst2(I)%ElmIDs' , ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(pLst%ElmNds, 2, 1, 'MOutLst2(I)%ElmNds' , ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(pLst%Me, 12, 12, 2, 1, 'MOutLst2(I)%Me' , ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(pLst%Ke, 12, 12, 2, 1, 'MOutLst2(I)%Ke' , ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(pLst%Fg, 12, 2, 1, 'MOutLst2(I)%Fg' , ErrStat2, ErrMsg2); if(Failed()) return - pLst%NodeIDs(1:nNodesPerElem) = Init%MemberNodes(iMember,1:nNodesPerElem) ! We are storing the actual node numbers in the member - !ElmIDs could contain the same element twice if Ndiv=1 - pLst%ElmIDs=0 !Initialize to 0 - DO J=1,nNodesPerElem,nNodesPerElem-1 ! loop on first and last node of member - iNode = pLst%NodeIDs(J) ! Index of requested node in node list - nElemPerNode = Init%NodesConnE(iNode, 1) ! Number of elements connecting to the 1st or last node of the member - K2= J/(nNodesPerElem)+1 ! 1 (first node) or 2 (last node) depending on J - DO iiElem=1, nElemPerNode - iElem = Init%NodesConnE(iNode,iiElem+1) ! iiElem-th Element Number in the set of elements attached to the selected node - IF (ThisElementIsAlongMember(iElem, iNode, iMember)) THEN - call ConfigOutputNode_MKF_ID(pLst, iElem, iiNode=K2, iStore=1, NodeID2=iNode) - EXIT !We found the element for that node, exit loop on elements - ENDIF - ENDDO - ENDDO ! Loop on divisions - ENDDO ! Loop on members - ENDIF ! OutAll - !_____________________________________REACTIONS_____________________________________________ - ! --- Check if reaction requested by user - p%OutReact = .FALSE. - DO I=1,p%NumOuts - if ( ANY( p%OutParam(I)%Indx == ReactSS) ) THEN ! bjj: removed check of first 5 characters being "React" because (1) cases matter and (2) we can also ask for "-React*" or "mREACT" - p%OutReact =.TRUE. - EXIT - ENDIF - ENDDO - IF (p%OutReact) THEN !I need to store all constrained forces and moments; WE do not allow more than one member to be connected at a constrained joint for the time being - ! MOutLst3: nodal output info by members, for the members involved in reaction - ALLOCATE(p%MOutLst3(p%nNodes_C), STAT = ErrStat2); ErrMsg2 = 'Error allocating p%MOutLst3 array in SDOut_Init'; if(Failed()) return - - DO I=1,p%nNodes_C !For all constrained node - pLst => p%MOutLst3(I) - iNode = p%Nodes_C(I,1) ! Note: Nodes_C has been reindexed - nElemPerNode = Init%NodesConnE(iNode,1) ! Number of elements connecting to the joint - CALL AllocAry(pLst%ElmIDs, 1, nElemPerNode, ' p%MOutLst3(I)%ElmIds', ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(pLst%ElmNds, 1, nElemPerNode, ' p%MOutLst3(I)%ElmNds', ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(pLst%Me, 12, 12 , 1, nElemPerNode, ' p%MOutLst3(I)%Me' , ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(pLst%Ke, 12, 12 , 1, nElemPerNode, ' p%MOutLst3(I)%Ke' , ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(pLst%Fg, 12 , 1, nElemPerNode, ' p%MOutLst3(I)%Fg' , ErrStat2, ErrMsg2); if(Failed()) return - DO iiElem = 1, nElemPerNode - iElem = Init%NodesConnE(iNode, iiElem+1) ! iiElem-th Element Number in the set of elements attached to the selected node - call ConfigOutputNode_MKF_ID(pLst, iElem, iiNode=1, iStore=iiElem, NodeID2=iNode) - ENDDO - ENDDO - ! Compute p%TIreact, rigid transf. matrix from reaction DOFs to base structure point (0,0,-WD) - CALL AllocAry(p%TIreact, 6, p%nDOFC__, 'TIReact ', ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(T_TIreact, p%nDOFC__, 6, 'TIReact_T', ErrStat2, ErrMsg2); if(Failed()) return - call RigidTrnsf(Init, p, (/0.0_Reki, 0.0_ReKi, -WtrDpth /), p%IDC__, p%nDOFC__, T_TIreact, ErrStat2, ErrMsg2); if(Failed()) return - p%TIreact=transpose(T_TIreact) - deallocate(T_TIreact) - ENDIF - RETURN - -CONTAINS - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SDOut_Init') - Failed = ErrStat >= AbortErrLev - END FUNCTION Failed - - !> Returns true if an element is connected to node iNode, and along member iMember - LOGICAL FUNCTION ThisElementIsAlongMember(iElem, iNode, iMember) - integer(IntKi), intent(in) :: iElem !< Element index - integer(IntKi), intent(in) :: iNode !< Node index - integer(IntKi), intent(in) :: iMember !< Member index - integer(IntKi), dimension(2) :: ElemNodes ! Node IDs for element under consideration (may not be consecutive numbers) - integer(IntKi) :: iOtherNode ! Other node than iNode for element iElem - ElemNodes = p%Elems(iElem,2:3) ! 1st and 2nd node of the element - ! Check that the other node belongs to the member - IF (ElemNodes(1) == iNode) then - iOtherNode=ElemNodes(2) - else if (ElemNodes(2) == iNode) then - iOtherNode=ElemNodes(1) - else - ThisElementIsAlongMember=.false. ! Not along member since nodes don't match - return - endif - ! Being along the member means the second node of the element is in the node list of the member - ThisElementIsAlongMember= ANY(Init%MemberNodes(iMember,:) == iOtherNode) - END FUNCTION - - !> Set different "data" for a given output node, and possibly store more than one "data" per node: - !! The "data" is: - !! - Mass, stiffness matrices and constant element force (gravity and cable) - !! - A flag whether the node is the 1st or second node of an element - !! The "data" is stored at the index (iiNode,iStore): - !! - iiNode: node index within the list of nodes that are to be used for output for this member - !! - iStore: index over the number of "data" stored per node. E.g. Member1 and 2 connecting to a node - SUBROUTINE ConfigOutputNode_MKF_ID(pLst, iElem, iiNode, iStore, NodeID2) - type(MeshAuxDataType), intent(inout) :: pLst !< Info for one member output - integer(IntKi) , intent(in) :: iElem !< Element index to which the node belong - integer(IntKi) , intent(in) :: iiNode !< Index over the nodes of a given member (>2 if nDIV>1) - integer(IntKi) , intent(in) :: iStore !< Storage index, used several informations are stored per node - integer(IntKi) , intent(in) :: NodeID2 !< If ElemNode(2) == NodeID2, then it's the second node - integer(IntKi), dimension(2) :: ElemNodes ! Node IDs for element under consideration (may not be consecutive numbers) - REAL(FEKi) :: FCe(12) ! Pretension force from cable element - pLst%ElmIDs(iiNode,iStore) = iElem ! This array has for each joint requested the elements' ID to get results for - ElemNodes = p%Elems(iElem,2:3) ! 1st and 2nd node of the k-th element - if (ElemNodes(2) == NodeID2) then - pLst%ElmNds(iiNode,iStore) = 2 ! store whether first or second node of element - else - pLst%ElmNds(iiNode,iStore) = 1 ! store whether first or second node of element - endif - ! --- Element Me, Ke, Fg, Fce - CALL ElemM(p%ElemProps(iElem), pLst%Me(:,:,iiNode,iStore)) - CALL ElemK(p%ElemProps(iElem), pLst%Ke(:,:,iiNode,iStore)) - CALL ElemF(p%ElemProps(iElem), Init%g, pLst%Fg(:,iiNode,iStore), FCe) - ! NOTE: Removing this force contribution for now (maybe put Tension only?) - ! The output of subdyn will just be the "Kx" part for now - !pLst%Fg(:,iiNode,iStore) = pLst%Fg(:,iiNode,iStore) + FCe(1:12) ! Adding cable element force - pLst%Fg(:,iiNode,iStore) = 0.0_ReKi - END SUBROUTINE ConfigOutputNode_MKF_ID - - -END SUBROUTINE SDOut_Init -!------------------------------------------------------------------------------------------------------ -!> Writes the data stored in the y variable to the correct indexed postions in WriteOutput -!! This is called by SD_CalcOutput() at each time step. -!! This routine does fill Allouts -!! note that this routine assumes m%u_TP and m%udotdot_TP have been set before calling -!! this routine (which is done in SD_CalcOutput() and SD CalcContStateDeriv) -SUBROUTINE SDOut_MapOutputs(u,p,x, y, m, AllOuts, ErrStat, ErrMsg ) - type(SD_InputType), intent( in ) :: u ! SubDyn module's input data - type(SD_ContinuousStateType), intent( in ) :: x ! SubDyn module's states data - type(SD_OutputType), intent( inout ) :: y ! SubDyn module's output data - type(SD_ParameterType), target,intent( in ) :: p ! SubDyn module's parameter data - type(SD_MiscVarType), intent( inout ) :: m ! Misc/optimization variables - real(ReKi), intent( out ) :: AllOuts(0:MaxOutPts+p%OutAllInt*p%OutAllDims) ! Array of output data for all possible outputs - integer(IntKi), intent( out ) :: ErrStat ! Error status of the operation - character(*), intent( out ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - !locals - integer(IntKi) :: iMemberOutput, iiNode, iSDNode, iMeshNode, I, J, L, L2 ! Counters - integer(IntKi) :: maxOutModes ! maximum modes to output, the minimum of 99 or p%nDOFM - real(ReKi), dimension (6) :: FM_elm, FK_elm, Fext !output static and dynamic forces and moments - real(ReKi), dimension (6) :: FM_elm2, FK_elm2 !output static and dynamic forces and moments - real(FEKi), dimension (3,3) :: DIRCOS !direction cosice matrix (global to local) (3x3) - real(ReKi), allocatable :: ReactNs(:) !6*Nreact reactions - integer(IntKi) :: sgn !+1/-1 for node force calculations - type(MeshAuxDataType), pointer :: pLst !< Info for a given member-output (Alias to shorten notation) - integer(IntKi), pointer :: DOFList(:) !< List of DOF indices for a given Nodes (Alias to shorten notation) - ErrStat = ErrID_None - ErrMsg = "" - - AllOuts = 0.0_ReKi ! initialize for those outputs that aren't valid (and thus aren't set in this routine) - - ! -------------------------------------------------------------------------------- - ! --- Requested member-outputs (Node kinematics and loads) - ! -------------------------------------------------------------------------------- - ! p%MOutLst has the mapping for the member, node, elements per node, to be used - ! MXNYZZZ will need to connects to p%MOutLst(X)%ElmIDs(Y,1:2) if it is a force or accel; else to u%UFL(p%MOutLst(X)%NodeIDs(Y)) - if (p%NumOuts > 0) then !bjj: some of these fields aren't allocated when NumOuts==0 - ! Loop over member-outputs requested - DO iMemberOutput=1,p%NMOutputs - pLst=>p%MOutLst(iMemberOutput) ! List for a given member-output - DO iiNode=1,pLst%NOutCnt !Iterate on requested nodes for that member - ! --- Forces (potentially averaged on 2 elements) - call ElementForce(pLst, iiNode, 1, FM_elm, FK_elm, sgn, DIRCOS, .false.) - FM_elm2=sgn*FM_elm - FK_elm2=sgn*FK_elm - IF (pLst%ElmIDs(iiNode,2) .NE. 0) THEN ! Second element exist - ! NOTE: forces are computed in the coordinate system of the first element for averaging - call ElementForce(pLst, iiNode, 2, FM_elm, FK_elm, sgn, DIRCOS, .true.) ! True= we use DIRCOS from element above - FM_elm2=0.5*( FM_elm2 + sgn*FM_elm ) ! Now Average - FK_elm2=0.5*( FK_elm2 + sgn*FK_elm) ! Now Average - ENDIF - ! Static (elastic) component of reaction forces and moments at MαNβ along local member coordinate system - ! "MαNβFKxe, MαNβFKye, MαNβFKze, MαNβMKxe, MαNβMKye, MαNβMKze" - AllOuts(MNfmKe (:,iiNode,iMemberOutput)) = FK_elm2 !static forces and moments (6) Local Ref - ! Dynamic (inertial) component of reaction forces and moments at MαNβ along local member coordinate system - ! "MαNβFMxe, MαNβFMye, MαNβFMze, MαNβMMxe, MαNβMMye, MαNβMMze" - AllOuts(MNfmMe (:,iiNode,iMemberOutput)) = FM_elm2 !dynamic forces and moments (6) Local Ref - - ! --- Displacements and acceleration - DOFList => p%NodesDOF(pLst%NodeIDs(iiNode))%List - ! Displacement- Translational -no need for averaging since it is a node translation - In global reference SS - ! "MαNβTDxss, MαNβTDyss, MαNβTDzss" - AllOuts(MNTDss (:,iiNode,iMemberOutput)) = m%U_full(DOFList(1:3)) - ! Displacement- Rotational - need direction cosine matrix to tranform rotations - In Local reference Element Ref Sys - ! "MαNβRDxss, MαNβRDye, MαNβRDze" - AllOuts(MNRDe (:,iiNode,iMemberOutput)) = matmul(DIRCOS,m%U_full(DOFList(4:6))) !local ref - ! Accelerations- I need to get the direction cosine matrix to tranform displacement and rotations - ! "MαNβTAxe, MαNβTAye, MαNβTAze" - ! "MαNβRAxe, MαNβRAye, MαNβRAze" - AllOuts(MNTRAe (1:3,iiNode,iMemberOutput)) = matmul(DIRCOS,m%U_full_dotdot(DOFList(1:3))) ! translational accel local ref - AllOuts(MNTRAe (4:6,iiNode,iMemberOutput)) = matmul(DIRCOS,m%U_full_dotdot(DOFList(4:6))) ! rotational accel local ref - ENDDO ! iiNode, Loop on requested nodes for that member - ENDDO ! iMemberOutput, Loop on member outputs - END IF - - ! -------------------------------------------------------------------------------- - ! --- All nodal loads from stiffness and mass matrix - ! -------------------------------------------------------------------------------- - ! "MaaaJbFKxe, MaaaJbMKxe MaaaJbFMxe, MaaaJbMMxe for member aaa and node b." - IF (p%OutAll) THEN - DO iMemberOutput=1,p%NMembers !Cycle on all members - pLst=>p%MOutLst2(iMemberOutput) - DO iiNode=1,2 !Iterate on requested nodes for that member (first and last) - call ElementForce(pLst, iiNode, 1, FM_elm, FK_elm, sgn, DIRCOS, .false.) - ! Store in All Outs - L = MaxOutPts+(iMemberOutput-1)*24+(iiNode-1)*12+1 - L2 = L+11 - AllOuts( L:L2 ) =sgn* (/FK_elm,FM_elm/) - ENDDO !iiNode, nodes 1 and 2 - ENDDO ! iMemberOutput, Loop on members - ENDIF - - ! -------------------------------------------------------------------------------- - ! --- Interface kinematics and loads (TP/platform reference point) - ! -------------------------------------------------------------------------------- - ! Total interface reaction forces and moments in SS coordinate system - ! "IntfFXss, IntfFYss, IntfFZss, IntfMXss, IntfMYss, IntfMZss," - AllOuts(IntfSS(1:nDOFL_TP))= - (/y%Y1Mesh%Force (:,1), y%Y1Mesh%Moment(:,1)/) !-y%Y1 !Note this is the force that the TP applies to the Jacket, opposite to what the GLue Code needs thus "-" sign - ! Interface translations and rotations in SS coordinate system - ! "IntfTDXss, IntfTDYss, IntfTDZss, IntfRDXss, IntfRDYss IntfRDZss" - AllOuts(IntfTRss(1:nDOFL_TP))=m%u_TP - ! Interface Translational and rotational accelerations in SS coordinate system - ! "IntfTAXss, IntfTAYss, IntfTAZss, IntfRAXss, IntfRAYss IntfRAZss" - AllOuts(IntfTRAss(1:nDOFL_TP))= m%udotdot_TP - - ! -------------------------------------------------------------------------------- - ! --- Modal parameters "SSqmXX, SSqmdotXX, SSqmddXX" amplitude, speed and acceleration - ! -------------------------------------------------------------------------------- - maxOutModes = min(p%nDOFM,99) ! We only have space for the first 99 values - IF ( maxOutModes > 0 ) THEN - !BJJ: TODO: is there a check to see if we requested these channels but didn't request the modes? (i.e., retain 2 modes but asked for 75th mode?) - AllOuts(SSqm01 :SSqm01 +maxOutModes-1) = x%qm (1:maxOutModes) - AllOuts(SSqmd01 :SSqmd01 +maxOutModes-1) = x%qmdot (1:maxOutModes) - AllOuts(SSqmdd01:SSqmdd01+maxOutModes-1) = m%qmdotdot(1:maxOutModes) - END IF - - ! --------------------------------------------------------------------------------} - ! --- Base reaction loads - ! --------------------------------------------------------------------------------{ - ! Total base reaction forces and moments at the (0.,0.,-WtrDpth) location in SS coordinate system - ! "ReactFXss, ReactFYss, ReactFZss, ReactMXss, ReactMYss, ReactMZss" - IF (p%OutReact) THEN - ALLOCATE ( ReactNs(6*p%nNodes_C), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating space for ReactNs array.' - ErrStat = ErrID_Fatal - RETURN - END IF - ReactNs = 0.0_ReKi !Initialize - DO I=1,p%nNodes_C !Do for each constrained node, they are ordered as given in the input file and so as in the order of y2mesh - FK_elm2=0._ReKi !Initialize for cumulative force - FM_elm2=0._ReKi !Initialize - pLst => p%MOutLst3(I) - !Find the joint forces - DO J=1,SIZE(pLst%ElmIDs(1,:)) !for all the elements connected (normally 1) - iiNode = 1 - call ElementForce(pLst, iiNode, J, FM_elm, FK_elm, sgn, DIRCOS, .false.) - !transform back to global, need to do 3 at a time since cosine matrix is 3x3 - DO L=1,2 - FM_elm2((L-1)*3+1:L*3) = FM_elm2((L-1)*3+1:L*3) + matmul(transpose(DIRCOS),FM_elm((L-1)*3+1:L*3)) !sum forces at joint in GLOBAL REF - FK_elm2((L-1)*3+1:L*3) = FK_elm2((L-1)*3+1:L*3) + matmul(transpose(DIRCOS),FK_elm((L-1)*3+1:L*3)) !signs may be wrong, we will fix that later; - ! I believe this is all fixed in terms of signs now ,RRD 5/20/13 - ENDDO - ENDDO - ! FK_elm2 ! + FM_elm2 !removed the inertial component 12/13 !Not sure why I need an intermediate step here, but the sum would not work otherwise - ! NEED TO ADD HYDRODYNAMIC FORCES AT THE RESTRAINT NODES - iSDNode = p%Nodes_C(I,1) - iMeshNode = iSDNode ! input and Y2 mesh nodes are the same as subdyn - Fext = (/ u%LMesh%Force(:,iMeshNode), u%LMesh%Moment(:,iMeshNode) /) - ReactNs((I-1)*6+1:6*I) = FK_elm2 - Fext !Accumulate reactions from all nodes in GLOBAL COORDINATES - ENDDO - ! Store into AllOuts - AllOuts( ReactSS(1:nDOFL_TP) ) = matmul(p%TIreact,ReactNs) - ENDIF - if (allocated(ReactNs)) deallocate(ReactNs) -contains - - subroutine ElementForce(pLst, iiNode, JJ, FM_elm, FK_elm, sgn, DIRCOS, bUseInputDirCos) - type(MeshAuxDataType), intent(in) :: pLst !< Info for one member output - integer(IntKi) , intent(in) :: iiNode !< Index over the nodes of a given member (>2 if nDIV>1) - integer(IntKi) , intent(in) :: JJ !< TODO: interpretation: index over other member connected to the current member (for averaging) - real(FEKi), dimension (3,3), intent(inout) :: DIRCOS !direction cosice matrix (global to local) (3x3) - real(ReKi), dimension (6), intent(out) :: FM_elm, FK_elm !output static and dynamic forces and moments - integer(IntKi), intent(out) :: sgn !+1/-1 for node force calculations - logical, intent(in) :: bUseInputDirCos !< If True, use DIRCOS from input, otherwise, use element DirCos - ! Local - integer(IntKi) :: iElem !< Element index/number - integer(IntKi) :: FirstOrSecond !< 1 or 2 if first node or second node - integer(IntKi), dimension(2) :: ElemNodes ! Node IDs for element under consideration (may not be consecutive numbers) - real(ReKi) , dimension(12) :: X_e, Xdd_e ! Displacement and acceleration for an element - integer(IntKi), dimension(2), parameter :: NodeNumber_To_Sign = (/-1, +1/) - - iElem = pLst%ElmIDs(iiNode,JJ) ! element number - FirstOrSecond = pLst%ElmNds(iiNode,JJ) ! first or second node of the element to be considered - sgn = NodeNumber_To_Sign(FirstOrSecond) ! Assign sign depending if it's the 1st or second node - ElemNodes = p%Elems(iElem,2:3) ! first and second node ID associated with element iElem - X_e(1:6) = m%U_full_elast (p%NodesDOF(ElemNodes(1))%List(1:6)) - X_e(7:12) = m%U_full_elast (p%NodesDOF(ElemNodes(2))%List(1:6)) - Xdd_e(1:6) = m%U_full_dotdot(p%NodesDOF(ElemNodes(1))%List(1:6)) - Xdd_e(7:12) = m%U_full_dotdot(p%NodesDOF(ElemNodes(2))%List(1:6)) - if (.not. bUseInputDirCos) then - DIRCOS=transpose(p%ElemProps(iElem)%DirCos)! global to local - endif - CALL CALC_NODE_FORCES( DIRCOS, pLst%Me(:,:,iiNode,JJ),pLst%Ke(:,:,iiNode,JJ), Xdd_e, X_e, pLst%Fg(:,iiNode,JJ), FirstOrSecond, FM_elm, FK_elm) - end subroutine ElementForce - - !==================================================================================================== - !> Calculates static and dynamic forces for a given element, using K and M of the element, and - !output quantities Udotdot and Y2 containing the - !and K2 indicating wheter the 1st (1) or 2nd (2) node is to be picked - !---------------------------------------------------------------------------------------------------- - SUBROUTINE CALC_NODE_FORCES(DIRCOS,Me,Ke,Udotdot,Y2 ,Fg, FirstOrSecond, FM_nod, FK_nod) - Real(FEKi), DIMENSION (3,3), INTENT(IN) :: DIRCOS !direction cosice matrix (global to local) (3x3) - Real(FEKi), DIMENSION (12,12), INTENT(IN) :: Me,Ke !element M and K matrices (12x12) in GLOBAL REFERENCE (DIRCOS^T K DIRCOS) - Real(ReKi), DIMENSION (12), INTENT(IN) :: Udotdot, Y2 !acceleration and velocities, gravity forces - Real(FEKi), DIMENSION (12), INTENT(IN) :: Fg !acceleration and velocities, gravity forces - Integer(IntKi), INTENT(IN) :: FirstOrSecond !1 or 2 depending on node of interest - REAL(ReKi), DIMENSION (6), INTENT(OUT) :: FM_nod, FK_nod !output static and dynamic forces and moments - !Locals - INTEGER(IntKi) :: L !counter - REAL(DbKi), DIMENSION(12) :: FM_glb, FF_glb, FM_elm, FF_elm ! temporary storage - - FM_glb = matmul(Me,Udotdot) ! GLOBAL REFERENCE - FF_glb = matmul(Ke,Y2) ! GLOBAL REFERENCE - FF_glb = FF_glb - Fg ! GLOBAL REFERENCE ! NOTE: Fg is now 0, only the "Kx" part in Fk - DO L=1,4 ! Transforming coordinates 3 at a time - FM_elm((L-1)*3+1:L*3) = matmul(DIRCOS, FM_glb( (L-1)*3+1:L*3 ) ) - FF_elm((L-1)*3+1:L*3) = matmul(DIRCOS, FF_glb( (L-1)*3+1:L*3 ) ) - ENDDO - FM_nod = FM_elm(6*(FirstOrSecond-1)+1:FirstOrSecond*6) ! k2=1, 1:6, k2=2 7:12 - FK_nod = FF_elm(6*(FirstOrSecond-1)+1:FirstOrSecond*6) - - END SUBROUTINE CALC_NODE_FORCES -END SUBROUTINE SDOut_MapOutputs - - -!==================================================================================================== -SUBROUTINE SDOut_CloseSum( UnSum, ErrStat, ErrMsg ) - INTEGER, INTENT( IN ) :: UnSum ! the unit number for the SubDyn summary file - 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 :: Stat ! status from I/) operation - ErrStat = ErrID_None - ErrMsg = "" - ! Write any closing information in the summary file - IF ( UnSum > 0 ) THEN - WRITE (UnSum,'(/,A/)', IOSTAT=Stat) '#This summary file was closed on '//CurDate()//' at '//CurTime()//'.' - IF (Stat /= 0) THEN - ErrStat = ErrID_FATAL - ErrMsg = ' Problem writing to summary file.' - END IF - ! Close the file - CLOSE( UnSum, IOSTAT=Stat ) - IF (Stat /= 0) THEN - ErrStat = ErrID_FATAL - ErrMsg = TRIM(ErrMsg)//' Problem closing summary file.' - END IF - IF ( ErrStat /= ErrID_None ) ErrMsg = 'SDOut_CloseSum'//TRIM(ErrMsg) - END IF -END SUBROUTINE SDOut_CloseSum - -!==================================================================================================== -SUBROUTINE SDOut_OpenSum( UnSum, SummaryName, SD_Prog, ErrStat, ErrMsg ) - INTEGER, INTENT( OUT ) :: UnSum ! the unit number for the SubDyn summary file - CHARACTER(*), INTENT( IN ) :: SummaryName ! the name of the SubDyn summary file - TYPE(ProgDesc), INTENT( IN ) :: SD_Prog ! the name/version/date of the program - INTEGER, INTENT( OUT ) :: ErrStat ! returns a non-zero value when an error occurs - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - integer :: ErrStat2 - ErrStat = ErrID_None - ErrMsg = "" - - CALL GetNewUnit( UnSum ) - CALL OpenFOutFile ( UnSum, SummaryName, ErrStat, ErrMsg ) - IF ( ErrStat >= AbortErrLev ) THEN - ErrMsg = 'Failed to open SubDyn summary file: '//TRIM(ErrMsg) - RETURN - END IF - - ! Write the summary file header - WRITE (UnSum,'(/,A/)', IOSTAT=ErrStat2) '#This summary file was generated by '//TRIM( SD_Prog%Name )//& - ' '//TRIM( SD_Prog%Ver )//' on '//CurDate()//' at '//CurTime()//'.' -END SUBROUTINE SDOut_OpenSum - -!==================================================================================================== -SUBROUTINE SDOut_OpenOutput( ProgVer, OutRootName, p, InitOut, ErrStat, ErrMsg ) -! This subroutine initialized the output module, checking if the output parameter list (OutList) -! contains valid names, and opening the output file if there are any requested outputs -!---------------------------------------------------------------------------------------------------- - ! Passed variables - TYPE(ProgDesc), INTENT( IN ) :: ProgVer - CHARACTER(*), INTENT( IN ) :: OutRootName ! Root name for the output file - TYPE(SD_ParameterType), INTENT( INOUT ) :: p - TYPE(SD_InitOutPutType ), INTENT( IN ) :: InitOut ! - INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! Local variables - INTEGER :: I ! Generic loop counter - CHARACTER(1024) :: OutFileName ! The name of the output file including the full path. - CHARACTER(200) :: Frmt ! a string to hold a format statement - INTEGER :: ErrStat2 - ErrStat = ErrID_None - ErrMsg = "" - ! Open the output file, if necessary, and write the header - IF ( ALLOCATED( p%OutParam ) .AND. p%NumOuts > 0 ) THEN ! Output has been requested so let's open an output file - ! Open the file for output - OutFileName = TRIM(OutRootName)//'.out' - CALL GetNewUnit( p%UnJckF ) - - CALL OpenFOutFile ( p%UnJckF, OutFileName, ErrStat, ErrMsg ) - IF ( ErrStat >= AbortErrLev ) THEN - ErrMsg = ' Error opening SubDyn-level output file: '//TRIM(ErrMsg) - RETURN - END IF - - ! Write the output file header - WRITE (p%UnJckF,'(/,A/)', IOSTAT=ErrStat2) 'These predictions were generated by '//TRIM(GETNVD(ProgVer))//& - ' on '//CurDate()//' at '//CurTime()//'.' - - WRITE(p%UnJckF, '(//)') ! add 3 lines to make file format consistant with FAST v8 (headers on line 7; units on line 8) [this allows easier post-processing] - - ! Write the names of the output parameters: - Frmt = '(A8,'//TRIM(Int2LStr(p%NumOuts+p%OutAllInt*p%OutAllDims))//'(:,A,'//TRIM( p%OutSFmt )//'))' - WRITE(p%UnJckF,Frmt, IOSTAT=ErrStat2) TRIM( 'Time' ), ( p%Delim, TRIM( InitOut%WriteOutputHdr(I) ), I=1,p%NumOuts+p%OutAllInt*p%OutAllDims ) - - ! Write the units of the output parameters: - WRITE(p%UnJckF,Frmt, IOSTAT=ErrStat2) TRIM( 's'), ( p%Delim, TRIM( InitOut%WriteOutputUnt(I) ), I=1,p%NumOuts+p%OutAllInt*p%OutAllDims ) - END IF ! there are any requested outputs -END SUBROUTINE SDOut_OpenOutput - -!==================================================================================================== - - -!==================================================================================================== -SUBROUTINE SDOut_CloseOutput ( p, ErrStat, ErrMsg ) -! This function cleans up after running the SubDyn output module. It closes the output file, -! releases memory, and resets the number of outputs requested to 0. -!---------------------------------------------------------------------------------------------------- - TYPE(SD_ParameterType), INTENT( INOUT ) :: p ! data for this instance of the floating platform module - INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - LOGICAL :: Err - - ErrStat = 0 - ErrMsg = "" - Err = .FALSE. - - ! Close our output file - CLOSE( p%UnJckF, IOSTAT = ErrStat ) - IF ( ErrStat /= 0 ) Err = .TRUE. - - ! Make sure ErrStat is non-zero if an error occurred - IF ( Err ) ErrStat = ErrID_Fatal - RETURN - -END SUBROUTINE SDOut_CloseOutput -!==================================================================================================== - -SUBROUTINE SDOut_WriteOutputNames( UnJckF, p, ErrStat, ErrMsg ) - - INTEGER, INTENT( IN ) :: UnJckF ! file unit for the output file - TYPE(SD_ParameterType), INTENT( IN ) :: p ! SubDyn module's parameter data - INTEGER, INTENT( OUT ) :: ErrStat ! returns a non-zero value when an error occurs - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - CHARACTER(200) :: Frmt ! a string to hold a format statement - INTEGER :: I ! Generic loop counter - - ErrStat = ErrID_None - ErrMsg = "" - - Frmt = '(A8,'//TRIM(Int2LStr(p%NumOuts+p%OutAllInt*p%OutAllDims))//'(:,A,'//TRIM( p%OutSFmt )//'))' - - WRITE(UnJckF,Frmt) TRIM( p%OutParam(0)%Name ), ( p%Delim, TRIM( p%OutParam(I)%Name ), I=1,p%NumOuts+p%OutAllInt*p%OutAllDims ) - -END SUBROUTINE SDOut_WriteOutputNames - -!==================================================================================================== - -SUBROUTINE SDOut_WriteOutputUnits( UnJckF, p, ErrStat, ErrMsg ) - INTEGER, INTENT( IN ) :: UnJckF ! file unit for the output file - TYPE(SD_ParameterType), INTENT( IN ) :: p ! SubDyn module's parameter data - INTEGER, INTENT( OUT ) :: ErrStat ! returns a non-zero value when an error occurs - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - CHARACTER(200) :: Frmt ! a string to hold a format statement - INTEGER :: I ! Generic loop counter - ErrStat = ErrID_None - ErrMsg = "" - - Frmt = '(A8,'//TRIM(Int2LStr(p%NumOuts+p%OutAllInt*p%OutAllDims))//'(:,A,'//TRIM( p%OutSFmt )//'))' - - WRITE(UnJckF,Frmt) TRIM( p%OutParam(0)%Units ), ( p%Delim, TRIM( p%OutParam(I)%Units ), I=1,p%NumOuts+p%OutAllInt*p%OutAllDims ) - -END SUBROUTINE SDOut_WriteOutputUnits - -!==================================================================================================== -SUBROUTINE SDOut_WriteOutputs( UnJckF, Time, SDWrOutput, p, ErrStat, ErrMsg ) -! This subroutine writes the data stored in WriteOutputs (and indexed in OutParam) to the file -! opened in SDOut_Init() -!---------------------------------------------------------------------------------------------------- - INTEGER, INTENT( IN ) :: UnJckF ! file unit for the output file - REAL(DbKi), INTENT( IN ) :: Time ! Time for this output - REAL(ReKi), INTENT( IN ) :: SDWrOutput(:) ! SubDyn module's output data - TYPE(SD_ParameterType), INTENT( IN ) :: p ! SubDyn module's parameter 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 :: I ! Generic loop counter - CHARACTER(200) :: Frmt ! a string to hold a format statement - ErrStat = ErrID_None - ErrMsg = "" - - ! Initialize ErrStat and determine if it makes any sense to write output - IF ( .NOT. ALLOCATED( p%OutParam ) .OR. UnJckF < 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' To write outputs for SubDyn there must be a valid file ID and OutParam must be allocated.' - RETURN - ELSE - ErrStat = ErrID_None - END IF - - ! Write the output parameters to the file - Frmt = '(F10.4,'//TRIM(Int2LStr(p%NumOuts+p%OutAllInt*p%OutAllDims))//'(:,A,'//TRIM( p%OutFmt )//'))' - - WRITE(UnJckF,Frmt) Time, ( p%Delim, SDWrOutput(I), I=1,p%NumOuts+p%OutAllInt*p%OutAllDims ) - -END SUBROUTINE SDOut_WriteOutputs - -!==================================================================================================== - - -!==================================================================================================== -SUBROUTINE SDOut_ChkOutLst( OutList, p, ErrStat, ErrMsg ) -! This routine checks the names of inputted output channels, checks to see if any of them are ill- -! conditioned (returning an error if so), and assigns the OutputDataType settings (i.e, the index, -! name, and units of the output channels). -! NOTE OutParam is populated here -!---------------------------------------------------------------------------------------------------- - TYPE(SD_ParameterType), INTENT( INOUT ) :: p ! SubDyn module parameter data - CHARACTER(ChanLen), INTENT( IN ) :: OutList (:) ! An array holding the names of the requested output channels. - INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! Local variables. - INTEGER :: I,J,K ! Generic loop-counting index. - INTEGER :: INDX ! Index for valid arrays - CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I). - !CHARACTER(28), PARAMETER :: OutPFmt = "( I4, 3X,A 10,1 X, A10 )" ! Output format parameter output list. - CHARACTER(ChanLen), DIMENSION(24) :: ToTUnits,ToTNames,ToTNames0 - LOGICAL :: InvalidOutput(0:MaxOutPts) ! This array determines if the output channel is valid for this configuration - LOGICAL :: CheckOutListAgain - ErrStat = ErrID_None - ErrMsg = "" - - InvalidOutput = .FALSE. - - ! mark invalid output channels: - DO k=p%nDOFM+1,99 - InvalidOutput(SSqm01 +k-1) = .true. - InvalidOutput(SSqmd01 +k-1) = .true. - InvalidOutput(SSqmdd01+k-1) = .true. - END DO - - DO I=1,9 - !I know el # and whether it is 1st node or second node - if (I <= p%NMOutputs) then - INDX=p%MOutLst(I)%NOutCnt+1 - else - INDX = 1 - end if - - DO J=INDX,9 !Iterate on requested nodes for that member - !Forces and moments - InvalidOutput(MNfmKe (:,J,I)) = .true. !static forces and moments (6) Local Ref - InvalidOutput(MNfmMe (:,J,I)) = .true. !dynamic forces and moments (6) Local Ref - !Displacement - InvalidOutput(MNTDss (:,J,I)) = .true. !Translational - InvalidOutput(MNRDe (:,J,I)) = .true. !Rotational - !Accelerations - InvalidOutput(MNTRAe (:,J,I)) = .true. !translational accel local ref - END DO - END DO - - !------------------------------------------------------------------------------------------------- - ! ALLOCATE the OutParam array - !------------------------------------------------------------------------------------------------- - ALLOCATE ( p%OutParam(1:p%NumOuts+p%OutAllInt*p%OutAllDims) , STAT=ErrStat ) - IF ( ErrStat /= 0 ) THEN - ErrMsg = ' Error allocating memory for the OutParam array.' - ErrStat = ErrID_Fatal - RETURN - END IF - - - !------------------------------------------------------------------------------------------------- - ! Set index, name, and units for the output channels - ! If a selected output channel is not available in this module, set error flag and return. - !------------------------------------------------------------------------------------------------- - !!!p%OutParam(0)%Name = 'Time' ! OutData(0) is the time channel by default. - !!!p%OutParam(0)%Units = '(sec)' ! - !!!p%OutParam(0)%Indx = Time - !!!p%OutParam(0)%SignM = 1 - - DO I = 1,p%NumOuts - - p%OutParam(I)%Name = OutList(I) - OutListTmp = OutList(I) - - - ! Reverse the sign (+/-) of the output channel if the user prefixed the - ! channel name with a '-', '_', 'm', or 'M' character indicating "minus". - - CheckOutListAgain = .FALSE. - - IF ( INDEX( '-_', OutListTmp(1:1) ) > 0 ) THEN - p%OutParam(I)%SignM = -1 ! ex, '-TipDxc1' causes the sign of TipDxc1 to be switched. - OutListTmp = OutListTmp(2:) - ELSE IF ( INDEX( 'mM', OutListTmp(1:1) ) > 0 ) THEN ! We'll assume this is a variable name for now, (if not, we will check later if OutListTmp(2:) is also a variable name) - CheckOutListAgain = .TRUE. - p%OutParam(I)%SignM = 1 - ELSE - p%OutParam(I)%SignM = 1 - END IF - - CALL Conv2UC( OutListTmp ) ! Convert OutListTmp to upper case - - - Indx = IndexCharAry( OutListTmp(1:9), ValidParamAry ) - - IF ( CheckOutListAgain .AND. Indx < 1 ) THEN ! Let's assume that "M" really meant "minus" and then test again - p%OutParam(I)%SignM = -1 ! ex, 'MTipDxc1' causes the sign of TipDxc1 to be switched. - OutListTmp = OutListTmp(2:) - - Indx = IndexCharAry( OutListTmp(1:9), ValidParamAry ) - END IF - - IF ( Indx > 0 ) THEN - p%OutParam(I)%Indx = ParamIndxAry(Indx) - IF ( InvalidOutput( ParamIndxAry(Indx) ) ) THEN - p%OutParam(I)%Units = 'INVALID' - p%OutParam(I)%SignM = 0 - ELSE - p%OutParam(I)%Units = ParamUnitsAry(Indx) - END IF - ELSE - ErrMsg = p%OutParam(I)%Name//' is not an available output channel.' - ErrStat = ErrID_Fatal - p%OutParam(I)%Units = 'INVALID' - p%OutParam(I)%Indx = 0 - p%OutParam(I)%SignM = 0 ! this will print all zeros - END IF - - END DO - - IF (p%OutAll) THEN !Finish populating the OutParam with all the joint forces and moments - ToTNames0=RESHAPE(SPREAD( (/"FKxe", "FKye", "FKze", "MKxe", "MKye", "MKze", "FMxe", "FMye", "FMze", "MMxe", "MMye", "MMze"/), 2, 2), (/24/) ) - ToTUnits=RESHAPE(SPREAD( (/"(N) ","(N) ","(N) ", "(N*m)","(N*m)","(N*m)", "(N) ","(N) ","(N) ", "(N*m)","(N*m)","(N*m)"/), 2, 2), (/24/) ) - DO I=1,p%NMembers - DO K=1,2 - DO J=1,12 - TotNames(J+(K-1)*12)=TRIM("M"//Int2Lstr(I))//TRIM("J"//Int2Lstr(K))//TRIM(TotNames0(J)) - ENDDO - ENDDO - p%OutParam(p%NumOuts+(I-1)*12*2+1:p%NumOuts+I*12*2)%Name = ToTNames - p%OutParam(p%NumOuts+(I-1)*12*2+1:p%NumOuts+I*12*2)%Units = ToTUnits - ENDDO - p%OutParam(p%NumOuts+1:p%NumOuts+p%OutAllDims)%SignM = 1 - p%OutParam(p%NumOuts+1:p%NumOuts+p%OutAllDims)%Indx= MaxOutPts+(/(J, J=1, p%OutAllDims)/) - ENDIF - -END SUBROUTINE SDOut_ChkOutLst -!==================================================================================================== -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. -!! Do not change the order of this packing without changing subroutine ! -SUBROUTINE SD_Init_Jacobian(Init, p, u, y, InitOut, ErrStat, ErrMsg) - TYPE(SD_InitType) , INTENT(IN ) :: Init !< Init - TYPE(SD_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(SD_InputType) , INTENT(IN ) :: u !< inputs - TYPE(SD_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(SD_InitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_Init_Jacobian' - real(ReKi) :: dx, dy, dz, maxDim - ! local variables: - ErrStat = ErrID_None - ErrMsg = "" - ! --- System dimension - dx = maxval(Init%Nodes(:,2))- minval(Init%Nodes(:,2)) - dy = maxval(Init%Nodes(:,3))- minval(Init%Nodes(:,3)) - dz = maxval(Init%Nodes(:,4))- minval(Init%Nodes(:,4)) - maxDim = max(dx, dy, dz) - - ! --- System dimension - call Init_Jacobian_y(); if (Failed()) return - call Init_Jacobian_x(); if (Failed()) return - call Init_Jacobian_u(); if (Failed()) return - -contains - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_Init_Jacobian') - Failed = ErrStat >= AbortErrLev - END FUNCTION Failed - !> This routine initializes the Jacobian parameters and initialization outputs for the linearized outputs. - - SUBROUTINE Init_Jacobian_y() - INTEGER(IntKi) :: index_next, i - ! Number of outputs - p%Jac_ny = y%Y1Mesh%nNodes * 6 & ! 3 forces + 3 moments at each node - + y%Y2Mesh%nNodes * 18 & ! 6 displacements + 6 velocities + 6 accelerations at each node - + p%NumOuts ! WriteOutput values - ! Storage info for each output (names, rotframe) - call AllocAry(InitOut%LinNames_y, p%Jac_ny, 'LinNames_y',ErrStat2,ErrMsg2); if(ErrStat2/=ErrID_None) return - call AllocAry(InitOut%RotFrame_y, p%Jac_ny, 'RotFrame_y',ErrStat2,ErrMsg2); if(ErrStat2/=ErrID_None) return - ! Names - index_next = 1 - call PackLoadMesh_Names( y%Y1Mesh, 'Interface displacement', InitOut%LinNames_y, index_next) - call PackMotionMesh_Names(y%Y2Mesh, 'Nodes motion' , InitOut%LinNames_y, index_next) - do i=1,p%NumOuts - InitOut%LinNames_y(i+index_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) - end do - ! RotFrame - InitOut%RotFrame_y(:) = .false. - END SUBROUTINE Init_Jacobian_y - - !> This routine initializes the Jacobian parameters and initialization outputs for the linearized continuous states. - SUBROUTINE Init_Jacobian_x() - INTEGER(IntKi) :: i - p%Jac_nx = p%nDOFM ! qm - ! allocate space for the row/column names and for perturbation sizes - CALL AllocAry(InitOut%LinNames_x , 2*p%Jac_nx, 'LinNames_x' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return - CALL AllocAry(InitOut%RotFrame_x , 2*p%Jac_nx, 'RotFrame_x' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return - CALL AllocAry(InitOut%DerivOrder_x, 2*p%Jac_nx, 'DerivOrder_x', ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return - ! default perturbations, p%dx: - p%dx(1) = 2.0_ReKi*D2R_D ! deflection states in rad and rad/s - p%dx(2) = 2.0_ReKi*D2R_D ! deflection states in rad and rad/s - InitOut%RotFrame_x = .false. - InitOut%DerivOrder_x = 2 - ! set linearization output names: - do i=1,p%Jac_nx - InitOut%LinNames_x(i) = 'Craig-Bampton mode '//trim(num2lstr(i))//' amplitude, -'; - end do - do i=1,p%Jac_nx - InitOut%LinNames_x(i+p%Jac_nx) = 'First time derivative of '//trim(InitOut%LinNames_x(i))//'/s' - InitOut%RotFrame_x(i+p%Jac_nx) = InitOut%RotFrame_x(i) - end do - END SUBROUTINE Init_Jacobian_x - - SUBROUTINE Init_Jacobian_u() - REAL(R8Ki) :: perturb - INTEGER(IntKi) :: i, j, idx, nu, i_meshField - ! Number of inputs - nu = u%TPMesh%nNodes * 18 & ! 3 Translation Displacements + 3 orientations + 6 velocities + 6 accelerations at each node - + u%LMesh%nNodes * 6 ! 3 forces + 3 moments at each node - ! --- Info of linearized inputs (Names, RotFrame, IsLoad) - call AllocAry(InitOut%LinNames_u, nu, 'LinNames_u', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - call AllocAry(InitOut%RotFrame_u, nu, 'RotFrame_u', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - call AllocAry(InitOut%IsLoad_u , nu, 'IsLoad_u' , ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - InitOut%RotFrame_u = .false. ! every input is on a mesh, which stores values in the global (not rotating) frame - idx = 1 - call PackMotionMesh_Names(u%TPMesh, 'TPMesh', InitOut%LinNames_u, idx) ! all 6 motion fields - InitOut%IsLoad_u(1:idx-1) = .false. ! the TPMesh inputs are not loads - InitOut%IsLoad_u(idx:) = .true. ! the remaining inputs are loads - call PackLoadMesh_Names( u%LMesh, 'LMesh', InitOut%LinNames_u, idx) - - ! --- Jac_u_indx: matrix to store index to help us figure out what the ith value of the u vector really means - ! (see perturb_u ... these MUST match ) - ! column 1 indicates module's mesh and field - ! column 2 indicates the first index (x-y-z component) of the field - ! column 3 is the node - call allocAry( p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return - idx = 1 - !Module/Mesh/Field: u%TPMesh%TranslationDisp = 1; - !Module/Mesh/Field: u%TPMesh%Orientation = 2; - !Module/Mesh/Field: u%TPMesh%TranslationVel = 3; - !Module/Mesh/Field: u%TPMesh%RotationVel = 4; - !Module/Mesh/Field: u%TPMesh%TranslationAcc = 5; - !Module/Mesh/Field: u%TPMesh%RotationAcc = 6; - do i_meshField = 1,6 - do i=1,u%TPMesh%nNodes - do j=1,3 - p%Jac_u_indx(idx,1) = i_meshField - p%Jac_u_indx(idx,2) = j !component idx: j - p%Jac_u_indx(idx,3) = i !Node: i - idx = idx + 1 - end do !j - end do !i - end do - !Module/Mesh/Field: u%LMesh%Force = 7; - !Module/Mesh/Field: u%LMesh%Moment = 8; - do i_meshField = 7,8 - do i=1,u%LMesh%nNodes - do j=1,3 - p%Jac_u_indx(idx,1) = i_meshField - p%Jac_u_indx(idx,2) = j !component idx: j - p%Jac_u_indx(idx,3) = i !Node: i - idx = idx + 1 - end do !j - end do !i - end do - - ! --- Default perturbations, p%du: - call allocAry( p%du, 8, 'p%du', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return ! 8 = number of unique values in p%Jac_u_indx(:,1) - perturb = 2.0_R8Ki*D2R_D - p%du( 1) = perturb ! u%TPMesh%TranslationDisp = 1; - p%du( 2) = perturb ! u%TPMesh%Orientation = 2; - p%du( 3) = perturb ! u%TPMesh%TranslationVel = 3; - p%du( 4) = perturb ! u%TPMesh%RotationVel = 4; - p%du( 5) = perturb ! u%TPMesh%TranslationAcc = 5; - p%du( 6) = perturb ! u%TPMesh%RotationAcc = 6; - p%du( 7) = 170*maxDim**2 ! u%LMesh%Force = 7; - p%du( 8) = 14*maxDim**3 ! u%LMesh%Moment = 8; - END SUBROUTINE Init_Jacobian_u - -END SUBROUTINE SD_Init_Jacobian -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine beamdyn::init_jacobian is consistant with this routine! -SUBROUTINE SD_Perturb_u( p, n, perturb_sign, u, du ) - TYPE(SD_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(SD_InputType) , INTENT(INOUT) :: u !< perturbed SD inputs - REAL( R8Ki ) , INTENT( OUT) :: du !< amount that specific input was perturbed - ! local variables - INTEGER :: fieldIndx - INTEGER :: node - fieldIndx = p%Jac_u_indx(n,2) - node = p%Jac_u_indx(n,3) - du = p%du( p%Jac_u_indx(n,1) ) - ! determine which mesh we're trying to perturb and perturb the input: - SELECT CASE( p%Jac_u_indx(n,1) ) - CASE ( 1) !Module/Mesh/Field: u%TPMesh%TranslationDisp = 1; - u%TPMesh%TranslationDisp( fieldIndx,node) = u%TPMesh%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE ( 2) !Module/Mesh/Field: u%TPMesh%Orientation = 2; - CALL PerturbOrientationMatrix( u%TPMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - CASE ( 3) !Module/Mesh/Field: u%TPMesh%TranslationVel = 3; - u%TPMesh%TranslationVel( fieldIndx,node) = u%TPMesh%TranslationVel( fieldIndx,node) + du * perturb_sign - CASE ( 4) !Module/Mesh/Field: u%TPMesh%RotationVel = 4; - u%TPMesh%RotationVel(fieldIndx,node) = u%TPMesh%RotationVel(fieldIndx,node) + du * perturb_sign - CASE ( 5) !Module/Mesh/Field: u%TPMesh%TranslationAcc = 5; - u%TPMesh%TranslationAcc( fieldIndx,node) = u%TPMesh%TranslationAcc( fieldIndx,node) + du * perturb_sign - CASE ( 6) !Module/Mesh/Field: u%TPMesh%RotationAcc = 6; - u%TPMesh%RotationAcc(fieldIndx,node) = u%TPMesh%RotationAcc(fieldIndx,node) + du * perturb_sign - CASE ( 7) !Module/Mesh/Field: u%LMesh%Force = 7; - u%LMesh%Force(fieldIndx,node) = u%LMesh%Force(fieldIndx,node) + du * perturb_sign - CASE ( 8) !Module/Mesh/Field: u%LMesh%Moment = 8; - u%LMesh%Moment(fieldIndx,node) = u%LMesh%Moment(fieldIndx,node) + du * perturb_sign - END SELECT -END SUBROUTINE SD_Perturb_u -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine beamdyn::init_jacobian is consistant with this routine! -SUBROUTINE SD_Compute_dY(p, y_p, y_m, delta, dY) - TYPE(SD_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(SD_OutputType) , INTENT(IN ) :: y_p !< SD outputs at \f$ u + \Delta_p u \f$ or \f$ z + \Delta_p z \f$ (p=plus) - TYPE(SD_OutputType) , INTENT(IN ) :: y_m !< SD outputs at \f$ u - \Delta_m u \f$ or \f$ z - \Delta_m z \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta_p = \Delta_p u \f$ or \f$ delta_p = \Delta_p x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial z_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ - ! local variables: - INTEGER(IntKi) :: i ! loop over outputs - INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled - indx_first = 1 - call PackLoadMesh_dY( y_p%Y1Mesh, y_m%Y1Mesh, dY, indx_first) - call PackMotionMesh_dY(y_p%Y2Mesh, y_m%Y2Mesh, dY, indx_first) ! all 6 motion fields - do i=1,p%NumOuts - dY(i+indx_first-1) = y_p%WriteOutput(i) - y_m%WriteOutput(i) - end do - dY = dY / (2.0_R8Ki*delta) -END SUBROUTINE SD_Compute_dY -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the x array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine sd_init_jacobian is consistant with this routine! -SUBROUTINE SD_Perturb_x( p, fieldIndx, mode, perturb_sign, x, dx ) - TYPE(SD_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: fieldIndx !< field in the state type: 1=displacements; 2=velocities - INTEGER( IntKi ) , INTENT(IN ) :: mode !< node number - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(SD_ContinuousStateType), INTENT(INOUT) :: x !< perturbed SD states - REAL( R8Ki ) , INTENT( OUT) :: dx !< amount that specific state was perturbed - if (fieldIndx==1) then - dx=p%dx(1) - x%qm(mode) = x%qm(mode) + dx * perturb_sign - else - dx=p%dx(2) - x%qmdot(mode) = x%qmdot(mode) + dx * perturb_sign - end if -END SUBROUTINE SD_Perturb_x -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine sd_init_jacobian is consistant with this routine! -SUBROUTINE SD_Compute_dX(p, x_p, x_m, delta, dX) - TYPE(SD_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(SD_ContinuousStateType), INTENT(IN ) :: x_p !< SD continuous states at \f$ u + \Delta_p u \f$ or \f$ x + \Delta_p x \f$ (p=plus) - TYPE(SD_ContinuousStateType), INTENT(IN ) :: x_m !< SD continuous states at \f$ u - \Delta_m u \f$ or \f$ x - \Delta_m x \f$ (m=minus) - REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta_p = \Delta_p u \f$ or \f$ delta_p = \Delta_p x \f$ - REAL(R8Ki) , INTENT(INOUT) :: dX(:) !< column of dXdu or dXdx: \f$ \frac{\partial X}{\partial u_i} = \frac{x_p - x_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial X}{\partial x_i} = \frac{x_p - x_m}{2 \, \Delta x}\f$ - INTEGER(IntKi) :: i ! loop over modes - do i=1,p%Jac_nx - dX(i) = x_p%qm(i) - x_m%qm(i) - end do - do i=1,p%Jac_nx - dX(p%Jac_nx+i) = x_p%qmdot(i) - x_m%qmdot(i) - end do - dX = dX / (2.0_R8Ki*delta) -END SUBROUTINE SD_Compute_dX - -END MODULE SubDyn_Output diff --git a/OpenFAST/modules/subdyn/src/SubDyn_Output_Params.f90 b/OpenFAST/modules/subdyn/src/SubDyn_Output_Params.f90 deleted file mode 100644 index 4844a51f1..000000000 --- a/OpenFAST/modules/subdyn/src/SubDyn_Output_Params.f90 +++ /dev/null @@ -1,3723 +0,0 @@ -module SubDyn_Output_Params - use NWTC_Library - - ! Indices for computing output channels: - ! NOTES: - ! (1) These parameters are in the order stored in "OutListParameters.xlsx" - ! (2) Array AllOuts() must be dimensioned to the value of the largest output parameter - IMPLICIT NONE - - PUBLIC - - ! Time: - INTEGER, PARAMETER :: Time = 0 - - ! Member Forces: - - INTEGER(IntKi), PARAMETER :: M1N1FKxe = 1 - INTEGER(IntKi), PARAMETER :: M1N2FKxe = 2 - INTEGER(IntKi), PARAMETER :: M1N3FKxe = 3 - INTEGER(IntKi), PARAMETER :: M1N4FKxe = 4 - INTEGER(IntKi), PARAMETER :: M1N5FKxe = 5 - INTEGER(IntKi), PARAMETER :: M1N6FKxe = 6 - INTEGER(IntKi), PARAMETER :: M1N7FKxe = 7 - INTEGER(IntKi), PARAMETER :: M1N8FKxe = 8 - INTEGER(IntKi), PARAMETER :: M1N9FKxe = 9 - INTEGER(IntKi), PARAMETER :: M2N1FKxe = 10 - INTEGER(IntKi), PARAMETER :: M2N2FKxe = 11 - INTEGER(IntKi), PARAMETER :: M2N3FKxe = 12 - INTEGER(IntKi), PARAMETER :: M2N4FKxe = 13 - INTEGER(IntKi), PARAMETER :: M2N5FKxe = 14 - INTEGER(IntKi), PARAMETER :: M2N6FKxe = 15 - INTEGER(IntKi), PARAMETER :: M2N7FKxe = 16 - INTEGER(IntKi), PARAMETER :: M2N8FKxe = 17 - INTEGER(IntKi), PARAMETER :: M2N9FKxe = 18 - INTEGER(IntKi), PARAMETER :: M3N1FKxe = 19 - INTEGER(IntKi), PARAMETER :: M3N2FKxe = 20 - INTEGER(IntKi), PARAMETER :: M3N3FKxe = 21 - INTEGER(IntKi), PARAMETER :: M3N4FKxe = 22 - INTEGER(IntKi), PARAMETER :: M3N5FKxe = 23 - INTEGER(IntKi), PARAMETER :: M3N6FKxe = 24 - INTEGER(IntKi), PARAMETER :: M3N7FKxe = 25 - INTEGER(IntKi), PARAMETER :: M3N8FKxe = 26 - INTEGER(IntKi), PARAMETER :: M3N9FKxe = 27 - INTEGER(IntKi), PARAMETER :: M4N1FKxe = 28 - INTEGER(IntKi), PARAMETER :: M4N2FKxe = 29 - INTEGER(IntKi), PARAMETER :: M4N3FKxe = 30 - INTEGER(IntKi), PARAMETER :: M4N4FKxe = 31 - INTEGER(IntKi), PARAMETER :: M4N5FKxe = 32 - INTEGER(IntKi), PARAMETER :: M4N6FKxe = 33 - INTEGER(IntKi), PARAMETER :: M4N7FKxe = 34 - INTEGER(IntKi), PARAMETER :: M4N8FKxe = 35 - INTEGER(IntKi), PARAMETER :: M4N9FKxe = 36 - INTEGER(IntKi), PARAMETER :: M5N1FKxe = 37 - INTEGER(IntKi), PARAMETER :: M5N2FKxe = 38 - INTEGER(IntKi), PARAMETER :: M5N3FKxe = 39 - INTEGER(IntKi), PARAMETER :: M5N4FKxe = 40 - INTEGER(IntKi), PARAMETER :: M5N5FKxe = 41 - INTEGER(IntKi), PARAMETER :: M5N6FKxe = 42 - INTEGER(IntKi), PARAMETER :: M5N7FKxe = 43 - INTEGER(IntKi), PARAMETER :: M5N8FKxe = 44 - INTEGER(IntKi), PARAMETER :: M5N9FKxe = 45 - INTEGER(IntKi), PARAMETER :: M6N1FKxe = 46 - INTEGER(IntKi), PARAMETER :: M6N2FKxe = 47 - INTEGER(IntKi), PARAMETER :: M6N3FKxe = 48 - INTEGER(IntKi), PARAMETER :: M6N4FKxe = 49 - INTEGER(IntKi), PARAMETER :: M6N5FKxe = 50 - INTEGER(IntKi), PARAMETER :: M6N6FKxe = 51 - INTEGER(IntKi), PARAMETER :: M6N7FKxe = 52 - INTEGER(IntKi), PARAMETER :: M6N8FKxe = 53 - INTEGER(IntKi), PARAMETER :: M6N9FKxe = 54 - INTEGER(IntKi), PARAMETER :: M7N1FKxe = 55 - INTEGER(IntKi), PARAMETER :: M7N2FKxe = 56 - INTEGER(IntKi), PARAMETER :: M7N3FKxe = 57 - INTEGER(IntKi), PARAMETER :: M7N4FKxe = 58 - INTEGER(IntKi), PARAMETER :: M7N5FKxe = 59 - INTEGER(IntKi), PARAMETER :: M7N6FKxe = 60 - INTEGER(IntKi), PARAMETER :: M7N7FKxe = 61 - INTEGER(IntKi), PARAMETER :: M7N8FKxe = 62 - INTEGER(IntKi), PARAMETER :: M7N9FKxe = 63 - INTEGER(IntKi), PARAMETER :: M8N1FKxe = 64 - INTEGER(IntKi), PARAMETER :: M8N2FKxe = 65 - INTEGER(IntKi), PARAMETER :: M8N3FKxe = 66 - INTEGER(IntKi), PARAMETER :: M8N4FKxe = 67 - INTEGER(IntKi), PARAMETER :: M8N5FKxe = 68 - INTEGER(IntKi), PARAMETER :: M8N6FKxe = 69 - INTEGER(IntKi), PARAMETER :: M8N7FKxe = 70 - INTEGER(IntKi), PARAMETER :: M8N8FKxe = 71 - INTEGER(IntKi), PARAMETER :: M8N9FKxe = 72 - INTEGER(IntKi), PARAMETER :: M9N1FKxe = 73 - INTEGER(IntKi), PARAMETER :: M9N2FKxe = 74 - INTEGER(IntKi), PARAMETER :: M9N3FKxe = 75 - INTEGER(IntKi), PARAMETER :: M9N4FKxe = 76 - INTEGER(IntKi), PARAMETER :: M9N5FKxe = 77 - INTEGER(IntKi), PARAMETER :: M9N6FKxe = 78 - INTEGER(IntKi), PARAMETER :: M9N7FKxe = 79 - INTEGER(IntKi), PARAMETER :: M9N8FKxe = 80 - INTEGER(IntKi), PARAMETER :: M9N9FKxe = 81 - INTEGER(IntKi), PARAMETER :: M1N1FKye = 82 - INTEGER(IntKi), PARAMETER :: M1N2FKye = 83 - INTEGER(IntKi), PARAMETER :: M1N3FKye = 84 - INTEGER(IntKi), PARAMETER :: M1N4FKye = 85 - INTEGER(IntKi), PARAMETER :: M1N5FKye = 86 - INTEGER(IntKi), PARAMETER :: M1N6FKye = 87 - INTEGER(IntKi), PARAMETER :: M1N7FKye = 88 - INTEGER(IntKi), PARAMETER :: M1N8FKye = 89 - INTEGER(IntKi), PARAMETER :: M1N9FKye = 90 - INTEGER(IntKi), PARAMETER :: M2N1FKye = 91 - INTEGER(IntKi), PARAMETER :: M2N2FKye = 92 - INTEGER(IntKi), PARAMETER :: M2N3FKye = 93 - INTEGER(IntKi), PARAMETER :: M2N4FKye = 94 - INTEGER(IntKi), PARAMETER :: M2N5FKye = 95 - INTEGER(IntKi), PARAMETER :: M2N6FKye = 96 - INTEGER(IntKi), PARAMETER :: M2N7FKye = 97 - INTEGER(IntKi), PARAMETER :: M2N8FKye = 98 - INTEGER(IntKi), PARAMETER :: M2N9FKye = 99 - INTEGER(IntKi), PARAMETER :: M3N1FKye = 100 - INTEGER(IntKi), PARAMETER :: M3N2FKye = 101 - INTEGER(IntKi), PARAMETER :: M3N3FKye = 102 - INTEGER(IntKi), PARAMETER :: M3N4FKye = 103 - INTEGER(IntKi), PARAMETER :: M3N5FKye = 104 - INTEGER(IntKi), PARAMETER :: M3N6FKye = 105 - INTEGER(IntKi), PARAMETER :: M3N7FKye = 106 - INTEGER(IntKi), PARAMETER :: M3N8FKye = 107 - INTEGER(IntKi), PARAMETER :: M3N9FKye = 108 - INTEGER(IntKi), PARAMETER :: M4N1FKye = 109 - INTEGER(IntKi), PARAMETER :: M4N2FKye = 110 - INTEGER(IntKi), PARAMETER :: M4N3FKye = 111 - INTEGER(IntKi), PARAMETER :: M4N4FKye = 112 - INTEGER(IntKi), PARAMETER :: M4N5FKye = 113 - INTEGER(IntKi), PARAMETER :: M4N6FKye = 114 - INTEGER(IntKi), PARAMETER :: M4N7FKye = 115 - INTEGER(IntKi), PARAMETER :: M4N8FKye = 116 - INTEGER(IntKi), PARAMETER :: M4N9FKye = 117 - INTEGER(IntKi), PARAMETER :: M5N1FKye = 118 - INTEGER(IntKi), PARAMETER :: M5N2FKye = 119 - INTEGER(IntKi), PARAMETER :: M5N3FKye = 120 - INTEGER(IntKi), PARAMETER :: M5N4FKye = 121 - INTEGER(IntKi), PARAMETER :: M5N5FKye = 122 - INTEGER(IntKi), PARAMETER :: M5N6FKye = 123 - INTEGER(IntKi), PARAMETER :: M5N7FKye = 124 - INTEGER(IntKi), PARAMETER :: M5N8FKye = 125 - INTEGER(IntKi), PARAMETER :: M5N9FKye = 126 - INTEGER(IntKi), PARAMETER :: M6N1FKye = 127 - INTEGER(IntKi), PARAMETER :: M6N2FKye = 128 - INTEGER(IntKi), PARAMETER :: M6N3FKye = 129 - INTEGER(IntKi), PARAMETER :: M6N4FKye = 130 - INTEGER(IntKi), PARAMETER :: M6N5FKye = 131 - INTEGER(IntKi), PARAMETER :: M6N6FKye = 132 - INTEGER(IntKi), PARAMETER :: M6N7FKye = 133 - INTEGER(IntKi), PARAMETER :: M6N8FKye = 134 - INTEGER(IntKi), PARAMETER :: M6N9FKye = 135 - INTEGER(IntKi), PARAMETER :: M7N1FKye = 136 - INTEGER(IntKi), PARAMETER :: M7N2FKye = 137 - INTEGER(IntKi), PARAMETER :: M7N3FKye = 138 - INTEGER(IntKi), PARAMETER :: M7N4FKye = 139 - INTEGER(IntKi), PARAMETER :: M7N5FKye = 140 - INTEGER(IntKi), PARAMETER :: M7N6FKye = 141 - INTEGER(IntKi), PARAMETER :: M7N7FKye = 142 - INTEGER(IntKi), PARAMETER :: M7N8FKye = 143 - INTEGER(IntKi), PARAMETER :: M7N9FKye = 144 - INTEGER(IntKi), PARAMETER :: M8N1FKye = 145 - INTEGER(IntKi), PARAMETER :: M8N2FKye = 146 - INTEGER(IntKi), PARAMETER :: M8N3FKye = 147 - INTEGER(IntKi), PARAMETER :: M8N4FKye = 148 - INTEGER(IntKi), PARAMETER :: M8N5FKye = 149 - INTEGER(IntKi), PARAMETER :: M8N6FKye = 150 - INTEGER(IntKi), PARAMETER :: M8N7FKye = 151 - INTEGER(IntKi), PARAMETER :: M8N8FKye = 152 - INTEGER(IntKi), PARAMETER :: M8N9FKye = 153 - INTEGER(IntKi), PARAMETER :: M9N1FKye = 154 - INTEGER(IntKi), PARAMETER :: M9N2FKye = 155 - INTEGER(IntKi), PARAMETER :: M9N3FKye = 156 - INTEGER(IntKi), PARAMETER :: M9N4FKye = 157 - INTEGER(IntKi), PARAMETER :: M9N5FKye = 158 - INTEGER(IntKi), PARAMETER :: M9N6FKye = 159 - INTEGER(IntKi), PARAMETER :: M9N7FKye = 160 - INTEGER(IntKi), PARAMETER :: M9N8FKye = 161 - INTEGER(IntKi), PARAMETER :: M9N9FKye = 162 - INTEGER(IntKi), PARAMETER :: M1N1FKze = 163 - INTEGER(IntKi), PARAMETER :: M1N2FKze = 164 - INTEGER(IntKi), PARAMETER :: M1N3FKze = 165 - INTEGER(IntKi), PARAMETER :: M1N4FKze = 166 - INTEGER(IntKi), PARAMETER :: M1N5FKze = 167 - INTEGER(IntKi), PARAMETER :: M1N6FKze = 168 - INTEGER(IntKi), PARAMETER :: M1N7FKze = 169 - INTEGER(IntKi), PARAMETER :: M1N8FKze = 170 - INTEGER(IntKi), PARAMETER :: M1N9FKze = 171 - INTEGER(IntKi), PARAMETER :: M2N1FKze = 172 - INTEGER(IntKi), PARAMETER :: M2N2FKze = 173 - INTEGER(IntKi), PARAMETER :: M2N3FKze = 174 - INTEGER(IntKi), PARAMETER :: M2N4FKze = 175 - INTEGER(IntKi), PARAMETER :: M2N5FKze = 176 - INTEGER(IntKi), PARAMETER :: M2N6FKze = 177 - INTEGER(IntKi), PARAMETER :: M2N7FKze = 178 - INTEGER(IntKi), PARAMETER :: M2N8FKze = 179 - INTEGER(IntKi), PARAMETER :: M2N9FKze = 180 - INTEGER(IntKi), PARAMETER :: M3N1FKze = 181 - INTEGER(IntKi), PARAMETER :: M3N2FKze = 182 - INTEGER(IntKi), PARAMETER :: M3N3FKze = 183 - INTEGER(IntKi), PARAMETER :: M3N4FKze = 184 - INTEGER(IntKi), PARAMETER :: M3N5FKze = 185 - INTEGER(IntKi), PARAMETER :: M3N6FKze = 186 - INTEGER(IntKi), PARAMETER :: M3N7FKze = 187 - INTEGER(IntKi), PARAMETER :: M3N8FKze = 188 - INTEGER(IntKi), PARAMETER :: M3N9FKze = 189 - INTEGER(IntKi), PARAMETER :: M4N1FKze = 190 - INTEGER(IntKi), PARAMETER :: M4N2FKze = 191 - INTEGER(IntKi), PARAMETER :: M4N3FKze = 192 - INTEGER(IntKi), PARAMETER :: M4N4FKze = 193 - INTEGER(IntKi), PARAMETER :: M4N5FKze = 194 - INTEGER(IntKi), PARAMETER :: M4N6FKze = 195 - INTEGER(IntKi), PARAMETER :: M4N7FKze = 196 - INTEGER(IntKi), PARAMETER :: M4N8FKze = 197 - INTEGER(IntKi), PARAMETER :: M4N9FKze = 198 - INTEGER(IntKi), PARAMETER :: M5N1FKze = 199 - INTEGER(IntKi), PARAMETER :: M5N2FKze = 200 - INTEGER(IntKi), PARAMETER :: M5N3FKze = 201 - INTEGER(IntKi), PARAMETER :: M5N4FKze = 202 - INTEGER(IntKi), PARAMETER :: M5N5FKze = 203 - INTEGER(IntKi), PARAMETER :: M5N6FKze = 204 - INTEGER(IntKi), PARAMETER :: M5N7FKze = 205 - INTEGER(IntKi), PARAMETER :: M5N8FKze = 206 - INTEGER(IntKi), PARAMETER :: M5N9FKze = 207 - INTEGER(IntKi), PARAMETER :: M6N1FKze = 208 - INTEGER(IntKi), PARAMETER :: M6N2FKze = 209 - INTEGER(IntKi), PARAMETER :: M6N3FKze = 210 - INTEGER(IntKi), PARAMETER :: M6N4FKze = 211 - INTEGER(IntKi), PARAMETER :: M6N5FKze = 212 - INTEGER(IntKi), PARAMETER :: M6N6FKze = 213 - INTEGER(IntKi), PARAMETER :: M6N7FKze = 214 - INTEGER(IntKi), PARAMETER :: M6N8FKze = 215 - INTEGER(IntKi), PARAMETER :: M6N9FKze = 216 - INTEGER(IntKi), PARAMETER :: M7N1FKze = 217 - INTEGER(IntKi), PARAMETER :: M7N2FKze = 218 - INTEGER(IntKi), PARAMETER :: M7N3FKze = 219 - INTEGER(IntKi), PARAMETER :: M7N4FKze = 220 - INTEGER(IntKi), PARAMETER :: M7N5FKze = 221 - INTEGER(IntKi), PARAMETER :: M7N6FKze = 222 - INTEGER(IntKi), PARAMETER :: M7N7FKze = 223 - INTEGER(IntKi), PARAMETER :: M7N8FKze = 224 - INTEGER(IntKi), PARAMETER :: M7N9FKze = 225 - INTEGER(IntKi), PARAMETER :: M8N1FKze = 226 - INTEGER(IntKi), PARAMETER :: M8N2FKze = 227 - INTEGER(IntKi), PARAMETER :: M8N3FKze = 228 - INTEGER(IntKi), PARAMETER :: M8N4FKze = 229 - INTEGER(IntKi), PARAMETER :: M8N5FKze = 230 - INTEGER(IntKi), PARAMETER :: M8N6FKze = 231 - INTEGER(IntKi), PARAMETER :: M8N7FKze = 232 - INTEGER(IntKi), PARAMETER :: M8N8FKze = 233 - INTEGER(IntKi), PARAMETER :: M8N9FKze = 234 - INTEGER(IntKi), PARAMETER :: M9N1FKze = 235 - INTEGER(IntKi), PARAMETER :: M9N2FKze = 236 - INTEGER(IntKi), PARAMETER :: M9N3FKze = 237 - INTEGER(IntKi), PARAMETER :: M9N4FKze = 238 - INTEGER(IntKi), PARAMETER :: M9N5FKze = 239 - INTEGER(IntKi), PARAMETER :: M9N6FKze = 240 - INTEGER(IntKi), PARAMETER :: M9N7FKze = 241 - INTEGER(IntKi), PARAMETER :: M9N8FKze = 242 - INTEGER(IntKi), PARAMETER :: M9N9FKze = 243 - INTEGER(IntKi), PARAMETER :: M1N1FMxe = 244 - INTEGER(IntKi), PARAMETER :: M1N2FMxe = 245 - INTEGER(IntKi), PARAMETER :: M1N3FMxe = 246 - INTEGER(IntKi), PARAMETER :: M1N4FMxe = 247 - INTEGER(IntKi), PARAMETER :: M1N5FMxe = 248 - INTEGER(IntKi), PARAMETER :: M1N6FMxe = 249 - INTEGER(IntKi), PARAMETER :: M1N7FMxe = 250 - INTEGER(IntKi), PARAMETER :: M1N8FMxe = 251 - INTEGER(IntKi), PARAMETER :: M1N9FMxe = 252 - INTEGER(IntKi), PARAMETER :: M2N1FMxe = 253 - INTEGER(IntKi), PARAMETER :: M2N2FMxe = 254 - INTEGER(IntKi), PARAMETER :: M2N3FMxe = 255 - INTEGER(IntKi), PARAMETER :: M2N4FMxe = 256 - INTEGER(IntKi), PARAMETER :: M2N5FMxe = 257 - INTEGER(IntKi), PARAMETER :: M2N6FMxe = 258 - INTEGER(IntKi), PARAMETER :: M2N7FMxe = 259 - INTEGER(IntKi), PARAMETER :: M2N8FMxe = 260 - INTEGER(IntKi), PARAMETER :: M2N9FMxe = 261 - INTEGER(IntKi), PARAMETER :: M3N1FMxe = 262 - INTEGER(IntKi), PARAMETER :: M3N2FMxe = 263 - INTEGER(IntKi), PARAMETER :: M3N3FMxe = 264 - INTEGER(IntKi), PARAMETER :: M3N4FMxe = 265 - INTEGER(IntKi), PARAMETER :: M3N5FMxe = 266 - INTEGER(IntKi), PARAMETER :: M3N6FMxe = 267 - INTEGER(IntKi), PARAMETER :: M3N7FMxe = 268 - INTEGER(IntKi), PARAMETER :: M3N8FMxe = 269 - INTEGER(IntKi), PARAMETER :: M3N9FMxe = 270 - INTEGER(IntKi), PARAMETER :: M4N1FMxe = 271 - INTEGER(IntKi), PARAMETER :: M4N2FMxe = 272 - INTEGER(IntKi), PARAMETER :: M4N3FMxe = 273 - INTEGER(IntKi), PARAMETER :: M4N4FMxe = 274 - INTEGER(IntKi), PARAMETER :: M4N5FMxe = 275 - INTEGER(IntKi), PARAMETER :: M4N6FMxe = 276 - INTEGER(IntKi), PARAMETER :: M4N7FMxe = 277 - INTEGER(IntKi), PARAMETER :: M4N8FMxe = 278 - INTEGER(IntKi), PARAMETER :: M4N9FMxe = 279 - INTEGER(IntKi), PARAMETER :: M5N1FMxe = 280 - INTEGER(IntKi), PARAMETER :: M5N2FMxe = 281 - INTEGER(IntKi), PARAMETER :: M5N3FMxe = 282 - INTEGER(IntKi), PARAMETER :: M5N4FMxe = 283 - INTEGER(IntKi), PARAMETER :: M5N5FMxe = 284 - INTEGER(IntKi), PARAMETER :: M5N6FMxe = 285 - INTEGER(IntKi), PARAMETER :: M5N7FMxe = 286 - INTEGER(IntKi), PARAMETER :: M5N8FMxe = 287 - INTEGER(IntKi), PARAMETER :: M5N9FMxe = 288 - INTEGER(IntKi), PARAMETER :: M6N1FMxe = 289 - INTEGER(IntKi), PARAMETER :: M6N2FMxe = 290 - INTEGER(IntKi), PARAMETER :: M6N3FMxe = 291 - INTEGER(IntKi), PARAMETER :: M6N4FMxe = 292 - INTEGER(IntKi), PARAMETER :: M6N5FMxe = 293 - INTEGER(IntKi), PARAMETER :: M6N6FMxe = 294 - INTEGER(IntKi), PARAMETER :: M6N7FMxe = 295 - INTEGER(IntKi), PARAMETER :: M6N8FMxe = 296 - INTEGER(IntKi), PARAMETER :: M6N9FMxe = 297 - INTEGER(IntKi), PARAMETER :: M7N1FMxe = 298 - INTEGER(IntKi), PARAMETER :: M7N2FMxe = 299 - INTEGER(IntKi), PARAMETER :: M7N3FMxe = 300 - INTEGER(IntKi), PARAMETER :: M7N4FMxe = 301 - INTEGER(IntKi), PARAMETER :: M7N5FMxe = 302 - INTEGER(IntKi), PARAMETER :: M7N6FMxe = 303 - INTEGER(IntKi), PARAMETER :: M7N7FMxe = 304 - INTEGER(IntKi), PARAMETER :: M7N8FMxe = 305 - INTEGER(IntKi), PARAMETER :: M7N9FMxe = 306 - INTEGER(IntKi), PARAMETER :: M8N1FMxe = 307 - INTEGER(IntKi), PARAMETER :: M8N2FMxe = 308 - INTEGER(IntKi), PARAMETER :: M8N3FMxe = 309 - INTEGER(IntKi), PARAMETER :: M8N4FMxe = 310 - INTEGER(IntKi), PARAMETER :: M8N5FMxe = 311 - INTEGER(IntKi), PARAMETER :: M8N6FMxe = 312 - INTEGER(IntKi), PARAMETER :: M8N7FMxe = 313 - INTEGER(IntKi), PARAMETER :: M8N8FMxe = 314 - INTEGER(IntKi), PARAMETER :: M8N9FMxe = 315 - INTEGER(IntKi), PARAMETER :: M9N1FMxe = 316 - INTEGER(IntKi), PARAMETER :: M9N2FMxe = 317 - INTEGER(IntKi), PARAMETER :: M9N3FMxe = 318 - INTEGER(IntKi), PARAMETER :: M9N4FMxe = 319 - INTEGER(IntKi), PARAMETER :: M9N5FMxe = 320 - INTEGER(IntKi), PARAMETER :: M9N6FMxe = 321 - INTEGER(IntKi), PARAMETER :: M9N7FMxe = 322 - INTEGER(IntKi), PARAMETER :: M9N8FMxe = 323 - INTEGER(IntKi), PARAMETER :: M9N9FMxe = 324 - INTEGER(IntKi), PARAMETER :: M1N1FMye = 325 - INTEGER(IntKi), PARAMETER :: M1N2FMye = 326 - INTEGER(IntKi), PARAMETER :: M1N3FMye = 327 - INTEGER(IntKi), PARAMETER :: M1N4FMye = 328 - INTEGER(IntKi), PARAMETER :: M1N5FMye = 329 - INTEGER(IntKi), PARAMETER :: M1N6FMye = 330 - INTEGER(IntKi), PARAMETER :: M1N7FMye = 331 - INTEGER(IntKi), PARAMETER :: M1N8FMye = 332 - INTEGER(IntKi), PARAMETER :: M1N9FMye = 333 - INTEGER(IntKi), PARAMETER :: M2N1FMye = 334 - INTEGER(IntKi), PARAMETER :: M2N2FMye = 335 - INTEGER(IntKi), PARAMETER :: M2N3FMye = 336 - INTEGER(IntKi), PARAMETER :: M2N4FMye = 337 - INTEGER(IntKi), PARAMETER :: M2N5FMye = 338 - INTEGER(IntKi), PARAMETER :: M2N6FMye = 339 - INTEGER(IntKi), PARAMETER :: M2N7FMye = 340 - INTEGER(IntKi), PARAMETER :: M2N8FMye = 341 - INTEGER(IntKi), PARAMETER :: M2N9FMye = 342 - INTEGER(IntKi), PARAMETER :: M3N1FMye = 343 - INTEGER(IntKi), PARAMETER :: M3N2FMye = 344 - INTEGER(IntKi), PARAMETER :: M3N3FMye = 345 - INTEGER(IntKi), PARAMETER :: M3N4FMye = 346 - INTEGER(IntKi), PARAMETER :: M3N5FMye = 347 - INTEGER(IntKi), PARAMETER :: M3N6FMye = 348 - INTEGER(IntKi), PARAMETER :: M3N7FMye = 349 - INTEGER(IntKi), PARAMETER :: M3N8FMye = 350 - INTEGER(IntKi), PARAMETER :: M3N9FMye = 351 - INTEGER(IntKi), PARAMETER :: M4N1FMye = 352 - INTEGER(IntKi), PARAMETER :: M4N2FMye = 353 - INTEGER(IntKi), PARAMETER :: M4N3FMye = 354 - INTEGER(IntKi), PARAMETER :: M4N4FMye = 355 - INTEGER(IntKi), PARAMETER :: M4N5FMye = 356 - INTEGER(IntKi), PARAMETER :: M4N6FMye = 357 - INTEGER(IntKi), PARAMETER :: M4N7FMye = 358 - INTEGER(IntKi), PARAMETER :: M4N8FMye = 359 - INTEGER(IntKi), PARAMETER :: M4N9FMye = 360 - INTEGER(IntKi), PARAMETER :: M5N1FMye = 361 - INTEGER(IntKi), PARAMETER :: M5N2FMye = 362 - INTEGER(IntKi), PARAMETER :: M5N3FMye = 363 - INTEGER(IntKi), PARAMETER :: M5N4FMye = 364 - INTEGER(IntKi), PARAMETER :: M5N5FMye = 365 - INTEGER(IntKi), PARAMETER :: M5N6FMye = 366 - INTEGER(IntKi), PARAMETER :: M5N7FMye = 367 - INTEGER(IntKi), PARAMETER :: M5N8FMye = 368 - INTEGER(IntKi), PARAMETER :: M5N9FMye = 369 - INTEGER(IntKi), PARAMETER :: M6N1FMye = 370 - INTEGER(IntKi), PARAMETER :: M6N2FMye = 371 - INTEGER(IntKi), PARAMETER :: M6N3FMye = 372 - INTEGER(IntKi), PARAMETER :: M6N4FMye = 373 - INTEGER(IntKi), PARAMETER :: M6N5FMye = 374 - INTEGER(IntKi), PARAMETER :: M6N6FMye = 375 - INTEGER(IntKi), PARAMETER :: M6N7FMye = 376 - INTEGER(IntKi), PARAMETER :: M6N8FMye = 377 - INTEGER(IntKi), PARAMETER :: M6N9FMye = 378 - INTEGER(IntKi), PARAMETER :: M7N1FMye = 379 - INTEGER(IntKi), PARAMETER :: M7N2FMye = 380 - INTEGER(IntKi), PARAMETER :: M7N3FMye = 381 - INTEGER(IntKi), PARAMETER :: M7N4FMye = 382 - INTEGER(IntKi), PARAMETER :: M7N5FMye = 383 - INTEGER(IntKi), PARAMETER :: M7N6FMye = 384 - INTEGER(IntKi), PARAMETER :: M7N7FMye = 385 - INTEGER(IntKi), PARAMETER :: M7N8FMye = 386 - INTEGER(IntKi), PARAMETER :: M7N9FMye = 387 - INTEGER(IntKi), PARAMETER :: M8N1FMye = 388 - INTEGER(IntKi), PARAMETER :: M8N2FMye = 389 - INTEGER(IntKi), PARAMETER :: M8N3FMye = 390 - INTEGER(IntKi), PARAMETER :: M8N4FMye = 391 - INTEGER(IntKi), PARAMETER :: M8N5FMye = 392 - INTEGER(IntKi), PARAMETER :: M8N6FMye = 393 - INTEGER(IntKi), PARAMETER :: M8N7FMye = 394 - INTEGER(IntKi), PARAMETER :: M8N8FMye = 395 - INTEGER(IntKi), PARAMETER :: M8N9FMye = 396 - INTEGER(IntKi), PARAMETER :: M9N1FMye = 397 - INTEGER(IntKi), PARAMETER :: M9N2FMye = 398 - INTEGER(IntKi), PARAMETER :: M9N3FMye = 399 - INTEGER(IntKi), PARAMETER :: M9N4FMye = 400 - INTEGER(IntKi), PARAMETER :: M9N5FMye = 401 - INTEGER(IntKi), PARAMETER :: M9N6FMye = 402 - INTEGER(IntKi), PARAMETER :: M9N7FMye = 403 - INTEGER(IntKi), PARAMETER :: M9N8FMye = 404 - INTEGER(IntKi), PARAMETER :: M9N9FMye = 405 - INTEGER(IntKi), PARAMETER :: M1N1FMze = 406 - INTEGER(IntKi), PARAMETER :: M1N2FMze = 407 - INTEGER(IntKi), PARAMETER :: M1N3FMze = 408 - INTEGER(IntKi), PARAMETER :: M1N4FMze = 409 - INTEGER(IntKi), PARAMETER :: M1N5FMze = 410 - INTEGER(IntKi), PARAMETER :: M1N6FMze = 411 - INTEGER(IntKi), PARAMETER :: M1N7FMze = 412 - INTEGER(IntKi), PARAMETER :: M1N8FMze = 413 - INTEGER(IntKi), PARAMETER :: M1N9FMze = 414 - INTEGER(IntKi), PARAMETER :: M2N1FMze = 415 - INTEGER(IntKi), PARAMETER :: M2N2FMze = 416 - INTEGER(IntKi), PARAMETER :: M2N3FMze = 417 - INTEGER(IntKi), PARAMETER :: M2N4FMze = 418 - INTEGER(IntKi), PARAMETER :: M2N5FMze = 419 - INTEGER(IntKi), PARAMETER :: M2N6FMze = 420 - INTEGER(IntKi), PARAMETER :: M2N7FMze = 421 - INTEGER(IntKi), PARAMETER :: M2N8FMze = 422 - INTEGER(IntKi), PARAMETER :: M2N9FMze = 423 - INTEGER(IntKi), PARAMETER :: M3N1FMze = 424 - INTEGER(IntKi), PARAMETER :: M3N2FMze = 425 - INTEGER(IntKi), PARAMETER :: M3N3FMze = 426 - INTEGER(IntKi), PARAMETER :: M3N4FMze = 427 - INTEGER(IntKi), PARAMETER :: M3N5FMze = 428 - INTEGER(IntKi), PARAMETER :: M3N6FMze = 429 - INTEGER(IntKi), PARAMETER :: M3N7FMze = 430 - INTEGER(IntKi), PARAMETER :: M3N8FMze = 431 - INTEGER(IntKi), PARAMETER :: M3N9FMze = 432 - INTEGER(IntKi), PARAMETER :: M4N1FMze = 433 - INTEGER(IntKi), PARAMETER :: M4N2FMze = 434 - INTEGER(IntKi), PARAMETER :: M4N3FMze = 435 - INTEGER(IntKi), PARAMETER :: M4N4FMze = 436 - INTEGER(IntKi), PARAMETER :: M4N5FMze = 437 - INTEGER(IntKi), PARAMETER :: M4N6FMze = 438 - INTEGER(IntKi), PARAMETER :: M4N7FMze = 439 - INTEGER(IntKi), PARAMETER :: M4N8FMze = 440 - INTEGER(IntKi), PARAMETER :: M4N9FMze = 441 - INTEGER(IntKi), PARAMETER :: M5N1FMze = 442 - INTEGER(IntKi), PARAMETER :: M5N2FMze = 443 - INTEGER(IntKi), PARAMETER :: M5N3FMze = 444 - INTEGER(IntKi), PARAMETER :: M5N4FMze = 445 - INTEGER(IntKi), PARAMETER :: M5N5FMze = 446 - INTEGER(IntKi), PARAMETER :: M5N6FMze = 447 - INTEGER(IntKi), PARAMETER :: M5N7FMze = 448 - INTEGER(IntKi), PARAMETER :: M5N8FMze = 449 - INTEGER(IntKi), PARAMETER :: M5N9FMze = 450 - INTEGER(IntKi), PARAMETER :: M6N1FMze = 451 - INTEGER(IntKi), PARAMETER :: M6N2FMze = 452 - INTEGER(IntKi), PARAMETER :: M6N3FMze = 453 - INTEGER(IntKi), PARAMETER :: M6N4FMze = 454 - INTEGER(IntKi), PARAMETER :: M6N5FMze = 455 - INTEGER(IntKi), PARAMETER :: M6N6FMze = 456 - INTEGER(IntKi), PARAMETER :: M6N7FMze = 457 - INTEGER(IntKi), PARAMETER :: M6N8FMze = 458 - INTEGER(IntKi), PARAMETER :: M6N9FMze = 459 - INTEGER(IntKi), PARAMETER :: M7N1FMze = 460 - INTEGER(IntKi), PARAMETER :: M7N2FMze = 461 - INTEGER(IntKi), PARAMETER :: M7N3FMze = 462 - INTEGER(IntKi), PARAMETER :: M7N4FMze = 463 - INTEGER(IntKi), PARAMETER :: M7N5FMze = 464 - INTEGER(IntKi), PARAMETER :: M7N6FMze = 465 - INTEGER(IntKi), PARAMETER :: M7N7FMze = 466 - INTEGER(IntKi), PARAMETER :: M7N8FMze = 467 - INTEGER(IntKi), PARAMETER :: M7N9FMze = 468 - INTEGER(IntKi), PARAMETER :: M8N1FMze = 469 - INTEGER(IntKi), PARAMETER :: M8N2FMze = 470 - INTEGER(IntKi), PARAMETER :: M8N3FMze = 471 - INTEGER(IntKi), PARAMETER :: M8N4FMze = 472 - INTEGER(IntKi), PARAMETER :: M8N5FMze = 473 - INTEGER(IntKi), PARAMETER :: M8N6FMze = 474 - INTEGER(IntKi), PARAMETER :: M8N7FMze = 475 - INTEGER(IntKi), PARAMETER :: M8N8FMze = 476 - INTEGER(IntKi), PARAMETER :: M8N9FMze = 477 - INTEGER(IntKi), PARAMETER :: M9N1FMze = 478 - INTEGER(IntKi), PARAMETER :: M9N2FMze = 479 - INTEGER(IntKi), PARAMETER :: M9N3FMze = 480 - INTEGER(IntKi), PARAMETER :: M9N4FMze = 481 - INTEGER(IntKi), PARAMETER :: M9N5FMze = 482 - INTEGER(IntKi), PARAMETER :: M9N6FMze = 483 - INTEGER(IntKi), PARAMETER :: M9N7FMze = 484 - INTEGER(IntKi), PARAMETER :: M9N8FMze = 485 - INTEGER(IntKi), PARAMETER :: M9N9FMze = 486 - INTEGER(IntKi), PARAMETER :: M1N1MKxe = 487 - INTEGER(IntKi), PARAMETER :: M1N2MKxe = 488 - INTEGER(IntKi), PARAMETER :: M1N3MKxe = 489 - INTEGER(IntKi), PARAMETER :: M1N4MKxe = 490 - INTEGER(IntKi), PARAMETER :: M1N5MKxe = 491 - INTEGER(IntKi), PARAMETER :: M1N6MKxe = 492 - INTEGER(IntKi), PARAMETER :: M1N7MKxe = 493 - INTEGER(IntKi), PARAMETER :: M1N8MKxe = 494 - INTEGER(IntKi), PARAMETER :: M1N9MKxe = 495 - INTEGER(IntKi), PARAMETER :: M2N1MKxe = 496 - INTEGER(IntKi), PARAMETER :: M2N2MKxe = 497 - INTEGER(IntKi), PARAMETER :: M2N3MKxe = 498 - INTEGER(IntKi), PARAMETER :: M2N4MKxe = 499 - INTEGER(IntKi), PARAMETER :: M2N5MKxe = 500 - INTEGER(IntKi), PARAMETER :: M2N6MKxe = 501 - INTEGER(IntKi), PARAMETER :: M2N7MKxe = 502 - INTEGER(IntKi), PARAMETER :: M2N8MKxe = 503 - INTEGER(IntKi), PARAMETER :: M2N9MKxe = 504 - INTEGER(IntKi), PARAMETER :: M3N1MKxe = 505 - INTEGER(IntKi), PARAMETER :: M3N2MKxe = 506 - INTEGER(IntKi), PARAMETER :: M3N3MKxe = 507 - INTEGER(IntKi), PARAMETER :: M3N4MKxe = 508 - INTEGER(IntKi), PARAMETER :: M3N5MKxe = 509 - INTEGER(IntKi), PARAMETER :: M3N6MKxe = 510 - INTEGER(IntKi), PARAMETER :: M3N7MKxe = 511 - INTEGER(IntKi), PARAMETER :: M3N8MKxe = 512 - INTEGER(IntKi), PARAMETER :: M3N9MKxe = 513 - INTEGER(IntKi), PARAMETER :: M4N1MKxe = 514 - INTEGER(IntKi), PARAMETER :: M4N2MKxe = 515 - INTEGER(IntKi), PARAMETER :: M4N3MKxe = 516 - INTEGER(IntKi), PARAMETER :: M4N4MKxe = 517 - INTEGER(IntKi), PARAMETER :: M4N5MKxe = 518 - INTEGER(IntKi), PARAMETER :: M4N6MKxe = 519 - INTEGER(IntKi), PARAMETER :: M4N7MKxe = 520 - INTEGER(IntKi), PARAMETER :: M4N8MKxe = 521 - INTEGER(IntKi), PARAMETER :: M4N9MKxe = 522 - INTEGER(IntKi), PARAMETER :: M5N1MKxe = 523 - INTEGER(IntKi), PARAMETER :: M5N2MKxe = 524 - INTEGER(IntKi), PARAMETER :: M5N3MKxe = 525 - INTEGER(IntKi), PARAMETER :: M5N4MKxe = 526 - INTEGER(IntKi), PARAMETER :: M5N5MKxe = 527 - INTEGER(IntKi), PARAMETER :: M5N6MKxe = 528 - INTEGER(IntKi), PARAMETER :: M5N7MKxe = 529 - INTEGER(IntKi), PARAMETER :: M5N8MKxe = 530 - INTEGER(IntKi), PARAMETER :: M5N9MKxe = 531 - INTEGER(IntKi), PARAMETER :: M6N1MKxe = 532 - INTEGER(IntKi), PARAMETER :: M6N2MKxe = 533 - INTEGER(IntKi), PARAMETER :: M6N3MKxe = 534 - INTEGER(IntKi), PARAMETER :: M6N4MKxe = 535 - INTEGER(IntKi), PARAMETER :: M6N5MKxe = 536 - INTEGER(IntKi), PARAMETER :: M6N6MKxe = 537 - INTEGER(IntKi), PARAMETER :: M6N7MKxe = 538 - INTEGER(IntKi), PARAMETER :: M6N8MKxe = 539 - INTEGER(IntKi), PARAMETER :: M6N9MKxe = 540 - INTEGER(IntKi), PARAMETER :: M7N1MKxe = 541 - INTEGER(IntKi), PARAMETER :: M7N2MKxe = 542 - INTEGER(IntKi), PARAMETER :: M7N3MKxe = 543 - INTEGER(IntKi), PARAMETER :: M7N4MKxe = 544 - INTEGER(IntKi), PARAMETER :: M7N5MKxe = 545 - INTEGER(IntKi), PARAMETER :: M7N6MKxe = 546 - INTEGER(IntKi), PARAMETER :: M7N7MKxe = 547 - INTEGER(IntKi), PARAMETER :: M7N8MKxe = 548 - INTEGER(IntKi), PARAMETER :: M7N9MKxe = 549 - INTEGER(IntKi), PARAMETER :: M8N1MKxe = 550 - INTEGER(IntKi), PARAMETER :: M8N2MKxe = 551 - INTEGER(IntKi), PARAMETER :: M8N3MKxe = 552 - INTEGER(IntKi), PARAMETER :: M8N4MKxe = 553 - INTEGER(IntKi), PARAMETER :: M8N5MKxe = 554 - INTEGER(IntKi), PARAMETER :: M8N6MKxe = 555 - INTEGER(IntKi), PARAMETER :: M8N7MKxe = 556 - INTEGER(IntKi), PARAMETER :: M8N8MKxe = 557 - INTEGER(IntKi), PARAMETER :: M8N9MKxe = 558 - INTEGER(IntKi), PARAMETER :: M9N1MKxe = 559 - INTEGER(IntKi), PARAMETER :: M9N2MKxe = 560 - INTEGER(IntKi), PARAMETER :: M9N3MKxe = 561 - INTEGER(IntKi), PARAMETER :: M9N4MKxe = 562 - INTEGER(IntKi), PARAMETER :: M9N5MKxe = 563 - INTEGER(IntKi), PARAMETER :: M9N6MKxe = 564 - INTEGER(IntKi), PARAMETER :: M9N7MKxe = 565 - INTEGER(IntKi), PARAMETER :: M9N8MKxe = 566 - INTEGER(IntKi), PARAMETER :: M9N9MKxe = 567 - INTEGER(IntKi), PARAMETER :: M1N1MKye = 568 - INTEGER(IntKi), PARAMETER :: M1N2MKye = 569 - INTEGER(IntKi), PARAMETER :: M1N3MKye = 570 - INTEGER(IntKi), PARAMETER :: M1N4MKye = 571 - INTEGER(IntKi), PARAMETER :: M1N5MKye = 572 - INTEGER(IntKi), PARAMETER :: M1N6MKye = 573 - INTEGER(IntKi), PARAMETER :: M1N7MKye = 574 - INTEGER(IntKi), PARAMETER :: M1N8MKye = 575 - INTEGER(IntKi), PARAMETER :: M1N9MKye = 576 - INTEGER(IntKi), PARAMETER :: M2N1MKye = 577 - INTEGER(IntKi), PARAMETER :: M2N2MKye = 578 - INTEGER(IntKi), PARAMETER :: M2N3MKye = 579 - INTEGER(IntKi), PARAMETER :: M2N4MKye = 580 - INTEGER(IntKi), PARAMETER :: M2N5MKye = 581 - INTEGER(IntKi), PARAMETER :: M2N6MKye = 582 - INTEGER(IntKi), PARAMETER :: M2N7MKye = 583 - INTEGER(IntKi), PARAMETER :: M2N8MKye = 584 - INTEGER(IntKi), PARAMETER :: M2N9MKye = 585 - INTEGER(IntKi), PARAMETER :: M3N1MKye = 586 - INTEGER(IntKi), PARAMETER :: M3N2MKye = 587 - INTEGER(IntKi), PARAMETER :: M3N3MKye = 588 - INTEGER(IntKi), PARAMETER :: M3N4MKye = 589 - INTEGER(IntKi), PARAMETER :: M3N5MKye = 590 - INTEGER(IntKi), PARAMETER :: M3N6MKye = 591 - INTEGER(IntKi), PARAMETER :: M3N7MKye = 592 - INTEGER(IntKi), PARAMETER :: M3N8MKye = 593 - INTEGER(IntKi), PARAMETER :: M3N9MKye = 594 - INTEGER(IntKi), PARAMETER :: M4N1MKye = 595 - INTEGER(IntKi), PARAMETER :: M4N2MKye = 596 - INTEGER(IntKi), PARAMETER :: M4N3MKye = 597 - INTEGER(IntKi), PARAMETER :: M4N4MKye = 598 - INTEGER(IntKi), PARAMETER :: M4N5MKye = 599 - INTEGER(IntKi), PARAMETER :: M4N6MKye = 600 - INTEGER(IntKi), PARAMETER :: M4N7MKye = 601 - INTEGER(IntKi), PARAMETER :: M4N8MKye = 602 - INTEGER(IntKi), PARAMETER :: M4N9MKye = 603 - INTEGER(IntKi), PARAMETER :: M5N1MKye = 604 - INTEGER(IntKi), PARAMETER :: M5N2MKye = 605 - INTEGER(IntKi), PARAMETER :: M5N3MKye = 606 - INTEGER(IntKi), PARAMETER :: M5N4MKye = 607 - INTEGER(IntKi), PARAMETER :: M5N5MKye = 608 - INTEGER(IntKi), PARAMETER :: M5N6MKye = 609 - INTEGER(IntKi), PARAMETER :: M5N7MKye = 610 - INTEGER(IntKi), PARAMETER :: M5N8MKye = 611 - INTEGER(IntKi), PARAMETER :: M5N9MKye = 612 - INTEGER(IntKi), PARAMETER :: M6N1MKye = 613 - INTEGER(IntKi), PARAMETER :: M6N2MKye = 614 - INTEGER(IntKi), PARAMETER :: M6N3MKye = 615 - INTEGER(IntKi), PARAMETER :: M6N4MKye = 616 - INTEGER(IntKi), PARAMETER :: M6N5MKye = 617 - INTEGER(IntKi), PARAMETER :: M6N6MKye = 618 - INTEGER(IntKi), PARAMETER :: M6N7MKye = 619 - INTEGER(IntKi), PARAMETER :: M6N8MKye = 620 - INTEGER(IntKi), PARAMETER :: M6N9MKye = 621 - INTEGER(IntKi), PARAMETER :: M7N1MKye = 622 - INTEGER(IntKi), PARAMETER :: M7N2MKye = 623 - INTEGER(IntKi), PARAMETER :: M7N3MKye = 624 - INTEGER(IntKi), PARAMETER :: M7N4MKye = 625 - INTEGER(IntKi), PARAMETER :: M7N5MKye = 626 - INTEGER(IntKi), PARAMETER :: M7N6MKye = 627 - INTEGER(IntKi), PARAMETER :: M7N7MKye = 628 - INTEGER(IntKi), PARAMETER :: M7N8MKye = 629 - INTEGER(IntKi), PARAMETER :: M7N9MKye = 630 - INTEGER(IntKi), PARAMETER :: M8N1MKye = 631 - INTEGER(IntKi), PARAMETER :: M8N2MKye = 632 - INTEGER(IntKi), PARAMETER :: M8N3MKye = 633 - INTEGER(IntKi), PARAMETER :: M8N4MKye = 634 - INTEGER(IntKi), PARAMETER :: M8N5MKye = 635 - INTEGER(IntKi), PARAMETER :: M8N6MKye = 636 - INTEGER(IntKi), PARAMETER :: M8N7MKye = 637 - INTEGER(IntKi), PARAMETER :: M8N8MKye = 638 - INTEGER(IntKi), PARAMETER :: M8N9MKye = 639 - INTEGER(IntKi), PARAMETER :: M9N1MKye = 640 - INTEGER(IntKi), PARAMETER :: M9N2MKye = 641 - INTEGER(IntKi), PARAMETER :: M9N3MKye = 642 - INTEGER(IntKi), PARAMETER :: M9N4MKye = 643 - INTEGER(IntKi), PARAMETER :: M9N5MKye = 644 - INTEGER(IntKi), PARAMETER :: M9N6MKye = 645 - INTEGER(IntKi), PARAMETER :: M9N7MKye = 646 - INTEGER(IntKi), PARAMETER :: M9N8MKye = 647 - INTEGER(IntKi), PARAMETER :: M9N9MKye = 648 - INTEGER(IntKi), PARAMETER :: M1N1MKze = 649 - INTEGER(IntKi), PARAMETER :: M1N2MKze = 650 - INTEGER(IntKi), PARAMETER :: M1N3MKze = 651 - INTEGER(IntKi), PARAMETER :: M1N4MKze = 652 - INTEGER(IntKi), PARAMETER :: M1N5MKze = 653 - INTEGER(IntKi), PARAMETER :: M1N6MKze = 654 - INTEGER(IntKi), PARAMETER :: M1N7MKze = 655 - INTEGER(IntKi), PARAMETER :: M1N8MKze = 656 - INTEGER(IntKi), PARAMETER :: M1N9MKze = 657 - INTEGER(IntKi), PARAMETER :: M2N1MKze = 658 - INTEGER(IntKi), PARAMETER :: M2N2MKze = 659 - INTEGER(IntKi), PARAMETER :: M2N3MKze = 660 - INTEGER(IntKi), PARAMETER :: M2N4MKze = 661 - INTEGER(IntKi), PARAMETER :: M2N5MKze = 662 - INTEGER(IntKi), PARAMETER :: M2N6MKze = 663 - INTEGER(IntKi), PARAMETER :: M2N7MKze = 664 - INTEGER(IntKi), PARAMETER :: M2N8MKze = 665 - INTEGER(IntKi), PARAMETER :: M2N9MKze = 666 - INTEGER(IntKi), PARAMETER :: M3N1MKze = 667 - INTEGER(IntKi), PARAMETER :: M3N2MKze = 668 - INTEGER(IntKi), PARAMETER :: M3N3MKze = 669 - INTEGER(IntKi), PARAMETER :: M3N4MKze = 670 - INTEGER(IntKi), PARAMETER :: M3N5MKze = 671 - INTEGER(IntKi), PARAMETER :: M3N6MKze = 672 - INTEGER(IntKi), PARAMETER :: M3N7MKze = 673 - INTEGER(IntKi), PARAMETER :: M3N8MKze = 674 - INTEGER(IntKi), PARAMETER :: M3N9MKze = 675 - INTEGER(IntKi), PARAMETER :: M4N1MKze = 676 - INTEGER(IntKi), PARAMETER :: M4N2MKze = 677 - INTEGER(IntKi), PARAMETER :: M4N3MKze = 678 - INTEGER(IntKi), PARAMETER :: M4N4MKze = 679 - INTEGER(IntKi), PARAMETER :: M4N5MKze = 680 - INTEGER(IntKi), PARAMETER :: M4N6MKze = 681 - INTEGER(IntKi), PARAMETER :: M4N7MKze = 682 - INTEGER(IntKi), PARAMETER :: M4N8MKze = 683 - INTEGER(IntKi), PARAMETER :: M4N9MKze = 684 - INTEGER(IntKi), PARAMETER :: M5N1MKze = 685 - INTEGER(IntKi), PARAMETER :: M5N2MKze = 686 - INTEGER(IntKi), PARAMETER :: M5N3MKze = 687 - INTEGER(IntKi), PARAMETER :: M5N4MKze = 688 - INTEGER(IntKi), PARAMETER :: M5N5MKze = 689 - INTEGER(IntKi), PARAMETER :: M5N6MKze = 690 - INTEGER(IntKi), PARAMETER :: M5N7MKze = 691 - INTEGER(IntKi), PARAMETER :: M5N8MKze = 692 - INTEGER(IntKi), PARAMETER :: M5N9MKze = 693 - INTEGER(IntKi), PARAMETER :: M6N1MKze = 694 - INTEGER(IntKi), PARAMETER :: M6N2MKze = 695 - INTEGER(IntKi), PARAMETER :: M6N3MKze = 696 - INTEGER(IntKi), PARAMETER :: M6N4MKze = 697 - INTEGER(IntKi), PARAMETER :: M6N5MKze = 698 - INTEGER(IntKi), PARAMETER :: M6N6MKze = 699 - INTEGER(IntKi), PARAMETER :: M6N7MKze = 700 - INTEGER(IntKi), PARAMETER :: M6N8MKze = 701 - INTEGER(IntKi), PARAMETER :: M6N9MKze = 702 - INTEGER(IntKi), PARAMETER :: M7N1MKze = 703 - INTEGER(IntKi), PARAMETER :: M7N2MKze = 704 - INTEGER(IntKi), PARAMETER :: M7N3MKze = 705 - INTEGER(IntKi), PARAMETER :: M7N4MKze = 706 - INTEGER(IntKi), PARAMETER :: M7N5MKze = 707 - INTEGER(IntKi), PARAMETER :: M7N6MKze = 708 - INTEGER(IntKi), PARAMETER :: M7N7MKze = 709 - INTEGER(IntKi), PARAMETER :: M7N8MKze = 710 - INTEGER(IntKi), PARAMETER :: M7N9MKze = 711 - INTEGER(IntKi), PARAMETER :: M8N1MKze = 712 - INTEGER(IntKi), PARAMETER :: M8N2MKze = 713 - INTEGER(IntKi), PARAMETER :: M8N3MKze = 714 - INTEGER(IntKi), PARAMETER :: M8N4MKze = 715 - INTEGER(IntKi), PARAMETER :: M8N5MKze = 716 - INTEGER(IntKi), PARAMETER :: M8N6MKze = 717 - INTEGER(IntKi), PARAMETER :: M8N7MKze = 718 - INTEGER(IntKi), PARAMETER :: M8N8MKze = 719 - INTEGER(IntKi), PARAMETER :: M8N9MKze = 720 - INTEGER(IntKi), PARAMETER :: M9N1MKze = 721 - INTEGER(IntKi), PARAMETER :: M9N2MKze = 722 - INTEGER(IntKi), PARAMETER :: M9N3MKze = 723 - INTEGER(IntKi), PARAMETER :: M9N4MKze = 724 - INTEGER(IntKi), PARAMETER :: M9N5MKze = 725 - INTEGER(IntKi), PARAMETER :: M9N6MKze = 726 - INTEGER(IntKi), PARAMETER :: M9N7MKze = 727 - INTEGER(IntKi), PARAMETER :: M9N8MKze = 728 - INTEGER(IntKi), PARAMETER :: M9N9MKze = 729 - INTEGER(IntKi), PARAMETER :: M1N1MMxe = 730 - INTEGER(IntKi), PARAMETER :: M1N2MMxe = 731 - INTEGER(IntKi), PARAMETER :: M1N3MMxe = 732 - INTEGER(IntKi), PARAMETER :: M1N4MMxe = 733 - INTEGER(IntKi), PARAMETER :: M1N5MMxe = 734 - INTEGER(IntKi), PARAMETER :: M1N6MMxe = 735 - INTEGER(IntKi), PARAMETER :: M1N7MMxe = 736 - INTEGER(IntKi), PARAMETER :: M1N8MMxe = 737 - INTEGER(IntKi), PARAMETER :: M1N9MMxe = 738 - INTEGER(IntKi), PARAMETER :: M2N1MMxe = 739 - INTEGER(IntKi), PARAMETER :: M2N2MMxe = 740 - INTEGER(IntKi), PARAMETER :: M2N3MMxe = 741 - INTEGER(IntKi), PARAMETER :: M2N4MMxe = 742 - INTEGER(IntKi), PARAMETER :: M2N5MMxe = 743 - INTEGER(IntKi), PARAMETER :: M2N6MMxe = 744 - INTEGER(IntKi), PARAMETER :: M2N7MMxe = 745 - INTEGER(IntKi), PARAMETER :: M2N8MMxe = 746 - INTEGER(IntKi), PARAMETER :: M2N9MMxe = 747 - INTEGER(IntKi), PARAMETER :: M3N1MMxe = 748 - INTEGER(IntKi), PARAMETER :: M3N2MMxe = 749 - INTEGER(IntKi), PARAMETER :: M3N3MMxe = 750 - INTEGER(IntKi), PARAMETER :: M3N4MMxe = 751 - INTEGER(IntKi), PARAMETER :: M3N5MMxe = 752 - INTEGER(IntKi), PARAMETER :: M3N6MMxe = 753 - INTEGER(IntKi), PARAMETER :: M3N7MMxe = 754 - INTEGER(IntKi), PARAMETER :: M3N8MMxe = 755 - INTEGER(IntKi), PARAMETER :: M3N9MMxe = 756 - INTEGER(IntKi), PARAMETER :: M4N1MMxe = 757 - INTEGER(IntKi), PARAMETER :: M4N2MMxe = 758 - INTEGER(IntKi), PARAMETER :: M4N3MMxe = 759 - INTEGER(IntKi), PARAMETER :: M4N4MMxe = 760 - INTEGER(IntKi), PARAMETER :: M4N5MMxe = 761 - INTEGER(IntKi), PARAMETER :: M4N6MMxe = 762 - INTEGER(IntKi), PARAMETER :: M4N7MMxe = 763 - INTEGER(IntKi), PARAMETER :: M4N8MMxe = 764 - INTEGER(IntKi), PARAMETER :: M4N9MMxe = 765 - INTEGER(IntKi), PARAMETER :: M5N1MMxe = 766 - INTEGER(IntKi), PARAMETER :: M5N2MMxe = 767 - INTEGER(IntKi), PARAMETER :: M5N3MMxe = 768 - INTEGER(IntKi), PARAMETER :: M5N4MMxe = 769 - INTEGER(IntKi), PARAMETER :: M5N5MMxe = 770 - INTEGER(IntKi), PARAMETER :: M5N6MMxe = 771 - INTEGER(IntKi), PARAMETER :: M5N7MMxe = 772 - INTEGER(IntKi), PARAMETER :: M5N8MMxe = 773 - INTEGER(IntKi), PARAMETER :: M5N9MMxe = 774 - INTEGER(IntKi), PARAMETER :: M6N1MMxe = 775 - INTEGER(IntKi), PARAMETER :: M6N2MMxe = 776 - INTEGER(IntKi), PARAMETER :: M6N3MMxe = 777 - INTEGER(IntKi), PARAMETER :: M6N4MMxe = 778 - INTEGER(IntKi), PARAMETER :: M6N5MMxe = 779 - INTEGER(IntKi), PARAMETER :: M6N6MMxe = 780 - INTEGER(IntKi), PARAMETER :: M6N7MMxe = 781 - INTEGER(IntKi), PARAMETER :: M6N8MMxe = 782 - INTEGER(IntKi), PARAMETER :: M6N9MMxe = 783 - INTEGER(IntKi), PARAMETER :: M7N1MMxe = 784 - INTEGER(IntKi), PARAMETER :: M7N2MMxe = 785 - INTEGER(IntKi), PARAMETER :: M7N3MMxe = 786 - INTEGER(IntKi), PARAMETER :: M7N4MMxe = 787 - INTEGER(IntKi), PARAMETER :: M7N5MMxe = 788 - INTEGER(IntKi), PARAMETER :: M7N6MMxe = 789 - INTEGER(IntKi), PARAMETER :: M7N7MMxe = 790 - INTEGER(IntKi), PARAMETER :: M7N8MMxe = 791 - INTEGER(IntKi), PARAMETER :: M7N9MMxe = 792 - INTEGER(IntKi), PARAMETER :: M8N1MMxe = 793 - INTEGER(IntKi), PARAMETER :: M8N2MMxe = 794 - INTEGER(IntKi), PARAMETER :: M8N3MMxe = 795 - INTEGER(IntKi), PARAMETER :: M8N4MMxe = 796 - INTEGER(IntKi), PARAMETER :: M8N5MMxe = 797 - INTEGER(IntKi), PARAMETER :: M8N6MMxe = 798 - INTEGER(IntKi), PARAMETER :: M8N7MMxe = 799 - INTEGER(IntKi), PARAMETER :: M8N8MMxe = 800 - INTEGER(IntKi), PARAMETER :: M8N9MMxe = 801 - INTEGER(IntKi), PARAMETER :: M9N1MMxe = 802 - INTEGER(IntKi), PARAMETER :: M9N2MMxe = 803 - INTEGER(IntKi), PARAMETER :: M9N3MMxe = 804 - INTEGER(IntKi), PARAMETER :: M9N4MMxe = 805 - INTEGER(IntKi), PARAMETER :: M9N5MMxe = 806 - INTEGER(IntKi), PARAMETER :: M9N6MMxe = 807 - INTEGER(IntKi), PARAMETER :: M9N7MMxe = 808 - INTEGER(IntKi), PARAMETER :: M9N8MMxe = 809 - INTEGER(IntKi), PARAMETER :: M9N9MMxe = 810 - INTEGER(IntKi), PARAMETER :: M1N1MMye = 811 - INTEGER(IntKi), PARAMETER :: M1N2MMye = 812 - INTEGER(IntKi), PARAMETER :: M1N3MMye = 813 - INTEGER(IntKi), PARAMETER :: M1N4MMye = 814 - INTEGER(IntKi), PARAMETER :: M1N5MMye = 815 - INTEGER(IntKi), PARAMETER :: M1N6MMye = 816 - INTEGER(IntKi), PARAMETER :: M1N7MMye = 817 - INTEGER(IntKi), PARAMETER :: M1N8MMye = 818 - INTEGER(IntKi), PARAMETER :: M1N9MMye = 819 - INTEGER(IntKi), PARAMETER :: M2N1MMye = 820 - INTEGER(IntKi), PARAMETER :: M2N2MMye = 821 - INTEGER(IntKi), PARAMETER :: M2N3MMye = 822 - INTEGER(IntKi), PARAMETER :: M2N4MMye = 823 - INTEGER(IntKi), PARAMETER :: M2N5MMye = 824 - INTEGER(IntKi), PARAMETER :: M2N6MMye = 825 - INTEGER(IntKi), PARAMETER :: M2N7MMye = 826 - INTEGER(IntKi), PARAMETER :: M2N8MMye = 827 - INTEGER(IntKi), PARAMETER :: M2N9MMye = 828 - INTEGER(IntKi), PARAMETER :: M3N1MMye = 829 - INTEGER(IntKi), PARAMETER :: M3N2MMye = 830 - INTEGER(IntKi), PARAMETER :: M3N3MMye = 831 - INTEGER(IntKi), PARAMETER :: M3N4MMye = 832 - INTEGER(IntKi), PARAMETER :: M3N5MMye = 833 - INTEGER(IntKi), PARAMETER :: M3N6MMye = 834 - INTEGER(IntKi), PARAMETER :: M3N7MMye = 835 - INTEGER(IntKi), PARAMETER :: M3N8MMye = 836 - INTEGER(IntKi), PARAMETER :: M3N9MMye = 837 - INTEGER(IntKi), PARAMETER :: M4N1MMye = 838 - INTEGER(IntKi), PARAMETER :: M4N2MMye = 839 - INTEGER(IntKi), PARAMETER :: M4N3MMye = 840 - INTEGER(IntKi), PARAMETER :: M4N4MMye = 841 - INTEGER(IntKi), PARAMETER :: M4N5MMye = 842 - INTEGER(IntKi), PARAMETER :: M4N6MMye = 843 - INTEGER(IntKi), PARAMETER :: M4N7MMye = 844 - INTEGER(IntKi), PARAMETER :: M4N8MMye = 845 - INTEGER(IntKi), PARAMETER :: M4N9MMye = 846 - INTEGER(IntKi), PARAMETER :: M5N1MMye = 847 - INTEGER(IntKi), PARAMETER :: M5N2MMye = 848 - INTEGER(IntKi), PARAMETER :: M5N3MMye = 849 - INTEGER(IntKi), PARAMETER :: M5N4MMye = 850 - INTEGER(IntKi), PARAMETER :: M5N5MMye = 851 - INTEGER(IntKi), PARAMETER :: M5N6MMye = 852 - INTEGER(IntKi), PARAMETER :: M5N7MMye = 853 - INTEGER(IntKi), PARAMETER :: M5N8MMye = 854 - INTEGER(IntKi), PARAMETER :: M5N9MMye = 855 - INTEGER(IntKi), PARAMETER :: M6N1MMye = 856 - INTEGER(IntKi), PARAMETER :: M6N2MMye = 857 - INTEGER(IntKi), PARAMETER :: M6N3MMye = 858 - INTEGER(IntKi), PARAMETER :: M6N4MMye = 859 - INTEGER(IntKi), PARAMETER :: M6N5MMye = 860 - INTEGER(IntKi), PARAMETER :: M6N6MMye = 861 - INTEGER(IntKi), PARAMETER :: M6N7MMye = 862 - INTEGER(IntKi), PARAMETER :: M6N8MMye = 863 - INTEGER(IntKi), PARAMETER :: M6N9MMye = 864 - INTEGER(IntKi), PARAMETER :: M7N1MMye = 865 - INTEGER(IntKi), PARAMETER :: M7N2MMye = 866 - INTEGER(IntKi), PARAMETER :: M7N3MMye = 867 - INTEGER(IntKi), PARAMETER :: M7N4MMye = 868 - INTEGER(IntKi), PARAMETER :: M7N5MMye = 869 - INTEGER(IntKi), PARAMETER :: M7N6MMye = 870 - INTEGER(IntKi), PARAMETER :: M7N7MMye = 871 - INTEGER(IntKi), PARAMETER :: M7N8MMye = 872 - INTEGER(IntKi), PARAMETER :: M7N9MMye = 873 - INTEGER(IntKi), PARAMETER :: M8N1MMye = 874 - INTEGER(IntKi), PARAMETER :: M8N2MMye = 875 - INTEGER(IntKi), PARAMETER :: M8N3MMye = 876 - INTEGER(IntKi), PARAMETER :: M8N4MMye = 877 - INTEGER(IntKi), PARAMETER :: M8N5MMye = 878 - INTEGER(IntKi), PARAMETER :: M8N6MMye = 879 - INTEGER(IntKi), PARAMETER :: M8N7MMye = 880 - INTEGER(IntKi), PARAMETER :: M8N8MMye = 881 - INTEGER(IntKi), PARAMETER :: M8N9MMye = 882 - INTEGER(IntKi), PARAMETER :: M9N1MMye = 883 - INTEGER(IntKi), PARAMETER :: M9N2MMye = 884 - INTEGER(IntKi), PARAMETER :: M9N3MMye = 885 - INTEGER(IntKi), PARAMETER :: M9N4MMye = 886 - INTEGER(IntKi), PARAMETER :: M9N5MMye = 887 - INTEGER(IntKi), PARAMETER :: M9N6MMye = 888 - INTEGER(IntKi), PARAMETER :: M9N7MMye = 889 - INTEGER(IntKi), PARAMETER :: M9N8MMye = 890 - INTEGER(IntKi), PARAMETER :: M9N9MMye = 891 - INTEGER(IntKi), PARAMETER :: M1N1MMze = 892 - INTEGER(IntKi), PARAMETER :: M1N2MMze = 893 - INTEGER(IntKi), PARAMETER :: M1N3MMze = 894 - INTEGER(IntKi), PARAMETER :: M1N4MMze = 895 - INTEGER(IntKi), PARAMETER :: M1N5MMze = 896 - INTEGER(IntKi), PARAMETER :: M1N6MMze = 897 - INTEGER(IntKi), PARAMETER :: M1N7MMze = 898 - INTEGER(IntKi), PARAMETER :: M1N8MMze = 899 - INTEGER(IntKi), PARAMETER :: M1N9MMze = 900 - INTEGER(IntKi), PARAMETER :: M2N1MMze = 901 - INTEGER(IntKi), PARAMETER :: M2N2MMze = 902 - INTEGER(IntKi), PARAMETER :: M2N3MMze = 903 - INTEGER(IntKi), PARAMETER :: M2N4MMze = 904 - INTEGER(IntKi), PARAMETER :: M2N5MMze = 905 - INTEGER(IntKi), PARAMETER :: M2N6MMze = 906 - INTEGER(IntKi), PARAMETER :: M2N7MMze = 907 - INTEGER(IntKi), PARAMETER :: M2N8MMze = 908 - INTEGER(IntKi), PARAMETER :: M2N9MMze = 909 - INTEGER(IntKi), PARAMETER :: M3N1MMze = 910 - INTEGER(IntKi), PARAMETER :: M3N2MMze = 911 - INTEGER(IntKi), PARAMETER :: M3N3MMze = 912 - INTEGER(IntKi), PARAMETER :: M3N4MMze = 913 - INTEGER(IntKi), PARAMETER :: M3N5MMze = 914 - INTEGER(IntKi), PARAMETER :: M3N6MMze = 915 - INTEGER(IntKi), PARAMETER :: M3N7MMze = 916 - INTEGER(IntKi), PARAMETER :: M3N8MMze = 917 - INTEGER(IntKi), PARAMETER :: M3N9MMze = 918 - INTEGER(IntKi), PARAMETER :: M4N1MMze = 919 - INTEGER(IntKi), PARAMETER :: M4N2MMze = 920 - INTEGER(IntKi), PARAMETER :: M4N3MMze = 921 - INTEGER(IntKi), PARAMETER :: M4N4MMze = 922 - INTEGER(IntKi), PARAMETER :: M4N5MMze = 923 - INTEGER(IntKi), PARAMETER :: M4N6MMze = 924 - INTEGER(IntKi), PARAMETER :: M4N7MMze = 925 - INTEGER(IntKi), PARAMETER :: M4N8MMze = 926 - INTEGER(IntKi), PARAMETER :: M4N9MMze = 927 - INTEGER(IntKi), PARAMETER :: M5N1MMze = 928 - INTEGER(IntKi), PARAMETER :: M5N2MMze = 929 - INTEGER(IntKi), PARAMETER :: M5N3MMze = 930 - INTEGER(IntKi), PARAMETER :: M5N4MMze = 931 - INTEGER(IntKi), PARAMETER :: M5N5MMze = 932 - INTEGER(IntKi), PARAMETER :: M5N6MMze = 933 - INTEGER(IntKi), PARAMETER :: M5N7MMze = 934 - INTEGER(IntKi), PARAMETER :: M5N8MMze = 935 - INTEGER(IntKi), PARAMETER :: M5N9MMze = 936 - INTEGER(IntKi), PARAMETER :: M6N1MMze = 937 - INTEGER(IntKi), PARAMETER :: M6N2MMze = 938 - INTEGER(IntKi), PARAMETER :: M6N3MMze = 939 - INTEGER(IntKi), PARAMETER :: M6N4MMze = 940 - INTEGER(IntKi), PARAMETER :: M6N5MMze = 941 - INTEGER(IntKi), PARAMETER :: M6N6MMze = 942 - INTEGER(IntKi), PARAMETER :: M6N7MMze = 943 - INTEGER(IntKi), PARAMETER :: M6N8MMze = 944 - INTEGER(IntKi), PARAMETER :: M6N9MMze = 945 - INTEGER(IntKi), PARAMETER :: M7N1MMze = 946 - INTEGER(IntKi), PARAMETER :: M7N2MMze = 947 - INTEGER(IntKi), PARAMETER :: M7N3MMze = 948 - INTEGER(IntKi), PARAMETER :: M7N4MMze = 949 - INTEGER(IntKi), PARAMETER :: M7N5MMze = 950 - INTEGER(IntKi), PARAMETER :: M7N6MMze = 951 - INTEGER(IntKi), PARAMETER :: M7N7MMze = 952 - INTEGER(IntKi), PARAMETER :: M7N8MMze = 953 - INTEGER(IntKi), PARAMETER :: M7N9MMze = 954 - INTEGER(IntKi), PARAMETER :: M8N1MMze = 955 - INTEGER(IntKi), PARAMETER :: M8N2MMze = 956 - INTEGER(IntKi), PARAMETER :: M8N3MMze = 957 - INTEGER(IntKi), PARAMETER :: M8N4MMze = 958 - INTEGER(IntKi), PARAMETER :: M8N5MMze = 959 - INTEGER(IntKi), PARAMETER :: M8N6MMze = 960 - INTEGER(IntKi), PARAMETER :: M8N7MMze = 961 - INTEGER(IntKi), PARAMETER :: M8N8MMze = 962 - INTEGER(IntKi), PARAMETER :: M8N9MMze = 963 - INTEGER(IntKi), PARAMETER :: M9N1MMze = 964 - INTEGER(IntKi), PARAMETER :: M9N2MMze = 965 - INTEGER(IntKi), PARAMETER :: M9N3MMze = 966 - INTEGER(IntKi), PARAMETER :: M9N4MMze = 967 - INTEGER(IntKi), PARAMETER :: M9N5MMze = 968 - INTEGER(IntKi), PARAMETER :: M9N6MMze = 969 - INTEGER(IntKi), PARAMETER :: M9N7MMze = 970 - INTEGER(IntKi), PARAMETER :: M9N8MMze = 971 - INTEGER(IntKi), PARAMETER :: M9N9MMze = 972 - - - ! Displacements: - - INTEGER(IntKi), PARAMETER :: M1N1TDxss = 973 - INTEGER(IntKi), PARAMETER :: M1N2TDxss = 974 - INTEGER(IntKi), PARAMETER :: M1N3TDxss = 975 - INTEGER(IntKi), PARAMETER :: M1N4TDxss = 976 - INTEGER(IntKi), PARAMETER :: M1N5TDxss = 977 - INTEGER(IntKi), PARAMETER :: M1N6TDxss = 978 - INTEGER(IntKi), PARAMETER :: M1N7TDxss = 979 - INTEGER(IntKi), PARAMETER :: M1N8TDxss = 980 - INTEGER(IntKi), PARAMETER :: M1N9TDxss = 981 - INTEGER(IntKi), PARAMETER :: M2N1TDxss = 982 - INTEGER(IntKi), PARAMETER :: M2N2TDxss = 983 - INTEGER(IntKi), PARAMETER :: M2N3TDxss = 984 - INTEGER(IntKi), PARAMETER :: M2N4TDxss = 985 - INTEGER(IntKi), PARAMETER :: M2N5TDxss = 986 - INTEGER(IntKi), PARAMETER :: M2N6TDxss = 987 - INTEGER(IntKi), PARAMETER :: M2N7TDxss = 988 - INTEGER(IntKi), PARAMETER :: M2N8TDxss = 989 - INTEGER(IntKi), PARAMETER :: M2N9TDxss = 990 - INTEGER(IntKi), PARAMETER :: M3N1TDxss = 991 - INTEGER(IntKi), PARAMETER :: M3N2TDxss = 992 - INTEGER(IntKi), PARAMETER :: M3N3TDxss = 993 - INTEGER(IntKi), PARAMETER :: M3N4TDxss = 994 - INTEGER(IntKi), PARAMETER :: M3N5TDxss = 995 - INTEGER(IntKi), PARAMETER :: M3N6TDxss = 996 - INTEGER(IntKi), PARAMETER :: M3N7TDxss = 997 - INTEGER(IntKi), PARAMETER :: M3N8TDxss = 998 - INTEGER(IntKi), PARAMETER :: M3N9TDxss = 999 - INTEGER(IntKi), PARAMETER :: M4N1TDxss = 1000 - INTEGER(IntKi), PARAMETER :: M4N2TDxss = 1001 - INTEGER(IntKi), PARAMETER :: M4N3TDxss = 1002 - INTEGER(IntKi), PARAMETER :: M4N4TDxss = 1003 - INTEGER(IntKi), PARAMETER :: M4N5TDxss = 1004 - INTEGER(IntKi), PARAMETER :: M4N6TDxss = 1005 - INTEGER(IntKi), PARAMETER :: M4N7TDxss = 1006 - INTEGER(IntKi), PARAMETER :: M4N8TDxss = 1007 - INTEGER(IntKi), PARAMETER :: M4N9TDxss = 1008 - INTEGER(IntKi), PARAMETER :: M5N1TDxss = 1009 - INTEGER(IntKi), PARAMETER :: M5N2TDxss = 1010 - INTEGER(IntKi), PARAMETER :: M5N3TDxss = 1011 - INTEGER(IntKi), PARAMETER :: M5N4TDxss = 1012 - INTEGER(IntKi), PARAMETER :: M5N5TDxss = 1013 - INTEGER(IntKi), PARAMETER :: M5N6TDxss = 1014 - INTEGER(IntKi), PARAMETER :: M5N7TDxss = 1015 - INTEGER(IntKi), PARAMETER :: M5N8TDxss = 1016 - INTEGER(IntKi), PARAMETER :: M5N9TDxss = 1017 - INTEGER(IntKi), PARAMETER :: M6N1TDxss = 1018 - INTEGER(IntKi), PARAMETER :: M6N2TDxss = 1019 - INTEGER(IntKi), PARAMETER :: M6N3TDxss = 1020 - INTEGER(IntKi), PARAMETER :: M6N4TDxss = 1021 - INTEGER(IntKi), PARAMETER :: M6N5TDxss = 1022 - INTEGER(IntKi), PARAMETER :: M6N6TDxss = 1023 - INTEGER(IntKi), PARAMETER :: M6N7TDxss = 1024 - INTEGER(IntKi), PARAMETER :: M6N8TDxss = 1025 - INTEGER(IntKi), PARAMETER :: M6N9TDxss = 1026 - INTEGER(IntKi), PARAMETER :: M7N1TDxss = 1027 - INTEGER(IntKi), PARAMETER :: M7N2TDxss = 1028 - INTEGER(IntKi), PARAMETER :: M7N3TDxss = 1029 - INTEGER(IntKi), PARAMETER :: M7N4TDxss = 1030 - INTEGER(IntKi), PARAMETER :: M7N5TDxss = 1031 - INTEGER(IntKi), PARAMETER :: M7N6TDxss = 1032 - INTEGER(IntKi), PARAMETER :: M7N7TDxss = 1033 - INTEGER(IntKi), PARAMETER :: M7N8TDxss = 1034 - INTEGER(IntKi), PARAMETER :: M7N9TDxss = 1035 - INTEGER(IntKi), PARAMETER :: M8N1TDxss = 1036 - INTEGER(IntKi), PARAMETER :: M8N2TDxss = 1037 - INTEGER(IntKi), PARAMETER :: M8N3TDxss = 1038 - INTEGER(IntKi), PARAMETER :: M8N4TDxss = 1039 - INTEGER(IntKi), PARAMETER :: M8N5TDxss = 1040 - INTEGER(IntKi), PARAMETER :: M8N6TDxss = 1041 - INTEGER(IntKi), PARAMETER :: M8N7TDxss = 1042 - INTEGER(IntKi), PARAMETER :: M8N8TDxss = 1043 - INTEGER(IntKi), PARAMETER :: M8N9TDxss = 1044 - INTEGER(IntKi), PARAMETER :: M9N1TDxss = 1045 - INTEGER(IntKi), PARAMETER :: M9N2TDxss = 1046 - INTEGER(IntKi), PARAMETER :: M9N3TDxss = 1047 - INTEGER(IntKi), PARAMETER :: M9N4TDxss = 1048 - INTEGER(IntKi), PARAMETER :: M9N5TDxss = 1049 - INTEGER(IntKi), PARAMETER :: M9N6TDxss = 1050 - INTEGER(IntKi), PARAMETER :: M9N7TDxss = 1051 - INTEGER(IntKi), PARAMETER :: M9N8TDxss = 1052 - INTEGER(IntKi), PARAMETER :: M9N9TDxss = 1053 - INTEGER(IntKi), PARAMETER :: M1N1TDyss = 1054 - INTEGER(IntKi), PARAMETER :: M1N2TDyss = 1055 - INTEGER(IntKi), PARAMETER :: M1N3TDyss = 1056 - INTEGER(IntKi), PARAMETER :: M1N4TDyss = 1057 - INTEGER(IntKi), PARAMETER :: M1N5TDyss = 1058 - INTEGER(IntKi), PARAMETER :: M1N6TDyss = 1059 - INTEGER(IntKi), PARAMETER :: M1N7TDyss = 1060 - INTEGER(IntKi), PARAMETER :: M1N8TDyss = 1061 - INTEGER(IntKi), PARAMETER :: M1N9TDyss = 1062 - INTEGER(IntKi), PARAMETER :: M2N1TDyss = 1063 - INTEGER(IntKi), PARAMETER :: M2N2TDyss = 1064 - INTEGER(IntKi), PARAMETER :: M2N3TDyss = 1065 - INTEGER(IntKi), PARAMETER :: M2N4TDyss = 1066 - INTEGER(IntKi), PARAMETER :: M2N5TDyss = 1067 - INTEGER(IntKi), PARAMETER :: M2N6TDyss = 1068 - INTEGER(IntKi), PARAMETER :: M2N7TDyss = 1069 - INTEGER(IntKi), PARAMETER :: M2N8TDyss = 1070 - INTEGER(IntKi), PARAMETER :: M2N9TDyss = 1071 - INTEGER(IntKi), PARAMETER :: M3N1TDyss = 1072 - INTEGER(IntKi), PARAMETER :: M3N2TDyss = 1073 - INTEGER(IntKi), PARAMETER :: M3N3TDyss = 1074 - INTEGER(IntKi), PARAMETER :: M3N4TDyss = 1075 - INTEGER(IntKi), PARAMETER :: M3N5TDyss = 1076 - INTEGER(IntKi), PARAMETER :: M3N6TDyss = 1077 - INTEGER(IntKi), PARAMETER :: M3N7TDyss = 1078 - INTEGER(IntKi), PARAMETER :: M3N8TDyss = 1079 - INTEGER(IntKi), PARAMETER :: M3N9TDyss = 1080 - INTEGER(IntKi), PARAMETER :: M4N1TDyss = 1081 - INTEGER(IntKi), PARAMETER :: M4N2TDyss = 1082 - INTEGER(IntKi), PARAMETER :: M4N3TDyss = 1083 - INTEGER(IntKi), PARAMETER :: M4N4TDyss = 1084 - INTEGER(IntKi), PARAMETER :: M4N5TDyss = 1085 - INTEGER(IntKi), PARAMETER :: M4N6TDyss = 1086 - INTEGER(IntKi), PARAMETER :: M4N7TDyss = 1087 - INTEGER(IntKi), PARAMETER :: M4N8TDyss = 1088 - INTEGER(IntKi), PARAMETER :: M4N9TDyss = 1089 - INTEGER(IntKi), PARAMETER :: M5N1TDyss = 1090 - INTEGER(IntKi), PARAMETER :: M5N2TDyss = 1091 - INTEGER(IntKi), PARAMETER :: M5N3TDyss = 1092 - INTEGER(IntKi), PARAMETER :: M5N4TDyss = 1093 - INTEGER(IntKi), PARAMETER :: M5N5TDyss = 1094 - INTEGER(IntKi), PARAMETER :: M5N6TDyss = 1095 - INTEGER(IntKi), PARAMETER :: M5N7TDyss = 1096 - INTEGER(IntKi), PARAMETER :: M5N8TDyss = 1097 - INTEGER(IntKi), PARAMETER :: M5N9TDyss = 1098 - INTEGER(IntKi), PARAMETER :: M6N1TDyss = 1099 - INTEGER(IntKi), PARAMETER :: M6N2TDyss = 1100 - INTEGER(IntKi), PARAMETER :: M6N3TDyss = 1101 - INTEGER(IntKi), PARAMETER :: M6N4TDyss = 1102 - INTEGER(IntKi), PARAMETER :: M6N5TDyss = 1103 - INTEGER(IntKi), PARAMETER :: M6N6TDyss = 1104 - INTEGER(IntKi), PARAMETER :: M6N7TDyss = 1105 - INTEGER(IntKi), PARAMETER :: M6N8TDyss = 1106 - INTEGER(IntKi), PARAMETER :: M6N9TDyss = 1107 - INTEGER(IntKi), PARAMETER :: M7N1TDyss = 1108 - INTEGER(IntKi), PARAMETER :: M7N2TDyss = 1109 - INTEGER(IntKi), PARAMETER :: M7N3TDyss = 1110 - INTEGER(IntKi), PARAMETER :: M7N4TDyss = 1111 - INTEGER(IntKi), PARAMETER :: M7N5TDyss = 1112 - INTEGER(IntKi), PARAMETER :: M7N6TDyss = 1113 - INTEGER(IntKi), PARAMETER :: M7N7TDyss = 1114 - INTEGER(IntKi), PARAMETER :: M7N8TDyss = 1115 - INTEGER(IntKi), PARAMETER :: M7N9TDyss = 1116 - INTEGER(IntKi), PARAMETER :: M8N1TDyss = 1117 - INTEGER(IntKi), PARAMETER :: M8N2TDyss = 1118 - INTEGER(IntKi), PARAMETER :: M8N3TDyss = 1119 - INTEGER(IntKi), PARAMETER :: M8N4TDyss = 1120 - INTEGER(IntKi), PARAMETER :: M8N5TDyss = 1121 - INTEGER(IntKi), PARAMETER :: M8N6TDyss = 1122 - INTEGER(IntKi), PARAMETER :: M8N7TDyss = 1123 - INTEGER(IntKi), PARAMETER :: M8N8TDyss = 1124 - INTEGER(IntKi), PARAMETER :: M8N9TDyss = 1125 - INTEGER(IntKi), PARAMETER :: M9N1TDyss = 1126 - INTEGER(IntKi), PARAMETER :: M9N2TDyss = 1127 - INTEGER(IntKi), PARAMETER :: M9N3TDyss = 1128 - INTEGER(IntKi), PARAMETER :: M9N4TDyss = 1129 - INTEGER(IntKi), PARAMETER :: M9N5TDyss = 1130 - INTEGER(IntKi), PARAMETER :: M9N6TDyss = 1131 - INTEGER(IntKi), PARAMETER :: M9N7TDyss = 1132 - INTEGER(IntKi), PARAMETER :: M9N8TDyss = 1133 - INTEGER(IntKi), PARAMETER :: M9N9TDyss = 1134 - INTEGER(IntKi), PARAMETER :: M1N1TDzss = 1135 - INTEGER(IntKi), PARAMETER :: M1N2TDzss = 1136 - INTEGER(IntKi), PARAMETER :: M1N3TDzss = 1137 - INTEGER(IntKi), PARAMETER :: M1N4TDzss = 1138 - INTEGER(IntKi), PARAMETER :: M1N5TDzss = 1139 - INTEGER(IntKi), PARAMETER :: M1N6TDzss = 1140 - INTEGER(IntKi), PARAMETER :: M1N7TDzss = 1141 - INTEGER(IntKi), PARAMETER :: M1N8TDzss = 1142 - INTEGER(IntKi), PARAMETER :: M1N9TDzss = 1143 - INTEGER(IntKi), PARAMETER :: M2N1TDzss = 1144 - INTEGER(IntKi), PARAMETER :: M2N2TDzss = 1145 - INTEGER(IntKi), PARAMETER :: M2N3TDzss = 1146 - INTEGER(IntKi), PARAMETER :: M2N4TDzss = 1147 - INTEGER(IntKi), PARAMETER :: M2N5TDzss = 1148 - INTEGER(IntKi), PARAMETER :: M2N6TDzss = 1149 - INTEGER(IntKi), PARAMETER :: M2N7TDzss = 1150 - INTEGER(IntKi), PARAMETER :: M2N8TDzss = 1151 - INTEGER(IntKi), PARAMETER :: M2N9TDzss = 1152 - INTEGER(IntKi), PARAMETER :: M3N1TDzss = 1153 - INTEGER(IntKi), PARAMETER :: M3N2TDzss = 1154 - INTEGER(IntKi), PARAMETER :: M3N3TDzss = 1155 - INTEGER(IntKi), PARAMETER :: M3N4TDzss = 1156 - INTEGER(IntKi), PARAMETER :: M3N5TDzss = 1157 - INTEGER(IntKi), PARAMETER :: M3N6TDzss = 1158 - INTEGER(IntKi), PARAMETER :: M3N7TDzss = 1159 - INTEGER(IntKi), PARAMETER :: M3N8TDzss = 1160 - INTEGER(IntKi), PARAMETER :: M3N9TDzss = 1161 - INTEGER(IntKi), PARAMETER :: M4N1TDzss = 1162 - INTEGER(IntKi), PARAMETER :: M4N2TDzss = 1163 - INTEGER(IntKi), PARAMETER :: M4N3TDzss = 1164 - INTEGER(IntKi), PARAMETER :: M4N4TDzss = 1165 - INTEGER(IntKi), PARAMETER :: M4N5TDzss = 1166 - INTEGER(IntKi), PARAMETER :: M4N6TDzss = 1167 - INTEGER(IntKi), PARAMETER :: M4N7TDzss = 1168 - INTEGER(IntKi), PARAMETER :: M4N8TDzss = 1169 - INTEGER(IntKi), PARAMETER :: M4N9TDzss = 1170 - INTEGER(IntKi), PARAMETER :: M5N1TDzss = 1171 - INTEGER(IntKi), PARAMETER :: M5N2TDzss = 1172 - INTEGER(IntKi), PARAMETER :: M5N3TDzss = 1173 - INTEGER(IntKi), PARAMETER :: M5N4TDzss = 1174 - INTEGER(IntKi), PARAMETER :: M5N5TDzss = 1175 - INTEGER(IntKi), PARAMETER :: M5N6TDzss = 1176 - INTEGER(IntKi), PARAMETER :: M5N7TDzss = 1177 - INTEGER(IntKi), PARAMETER :: M5N8TDzss = 1178 - INTEGER(IntKi), PARAMETER :: M5N9TDzss = 1179 - INTEGER(IntKi), PARAMETER :: M6N1TDzss = 1180 - INTEGER(IntKi), PARAMETER :: M6N2TDzss = 1181 - INTEGER(IntKi), PARAMETER :: M6N3TDzss = 1182 - INTEGER(IntKi), PARAMETER :: M6N4TDzss = 1183 - INTEGER(IntKi), PARAMETER :: M6N5TDzss = 1184 - INTEGER(IntKi), PARAMETER :: M6N6TDzss = 1185 - INTEGER(IntKi), PARAMETER :: M6N7TDzss = 1186 - INTEGER(IntKi), PARAMETER :: M6N8TDzss = 1187 - INTEGER(IntKi), PARAMETER :: M6N9TDzss = 1188 - INTEGER(IntKi), PARAMETER :: M7N1TDzss = 1189 - INTEGER(IntKi), PARAMETER :: M7N2TDzss = 1190 - INTEGER(IntKi), PARAMETER :: M7N3TDzss = 1191 - INTEGER(IntKi), PARAMETER :: M7N4TDzss = 1192 - INTEGER(IntKi), PARAMETER :: M7N5TDzss = 1193 - INTEGER(IntKi), PARAMETER :: M7N6TDzss = 1194 - INTEGER(IntKi), PARAMETER :: M7N7TDzss = 1195 - INTEGER(IntKi), PARAMETER :: M7N8TDzss = 1196 - INTEGER(IntKi), PARAMETER :: M7N9TDzss = 1197 - INTEGER(IntKi), PARAMETER :: M8N1TDzss = 1198 - INTEGER(IntKi), PARAMETER :: M8N2TDzss = 1199 - INTEGER(IntKi), PARAMETER :: M8N3TDzss = 1200 - INTEGER(IntKi), PARAMETER :: M8N4TDzss = 1201 - INTEGER(IntKi), PARAMETER :: M8N5TDzss = 1202 - INTEGER(IntKi), PARAMETER :: M8N6TDzss = 1203 - INTEGER(IntKi), PARAMETER :: M8N7TDzss = 1204 - INTEGER(IntKi), PARAMETER :: M8N8TDzss = 1205 - INTEGER(IntKi), PARAMETER :: M8N9TDzss = 1206 - INTEGER(IntKi), PARAMETER :: M9N1TDzss = 1207 - INTEGER(IntKi), PARAMETER :: M9N2TDzss = 1208 - INTEGER(IntKi), PARAMETER :: M9N3TDzss = 1209 - INTEGER(IntKi), PARAMETER :: M9N4TDzss = 1210 - INTEGER(IntKi), PARAMETER :: M9N5TDzss = 1211 - INTEGER(IntKi), PARAMETER :: M9N6TDzss = 1212 - INTEGER(IntKi), PARAMETER :: M9N7TDzss = 1213 - INTEGER(IntKi), PARAMETER :: M9N8TDzss = 1214 - INTEGER(IntKi), PARAMETER :: M9N9TDzss = 1215 - INTEGER(IntKi), PARAMETER :: M1N1RDxe = 1216 - INTEGER(IntKi), PARAMETER :: M1N2RDxe = 1217 - INTEGER(IntKi), PARAMETER :: M1N3RDxe = 1218 - INTEGER(IntKi), PARAMETER :: M1N4RDxe = 1219 - INTEGER(IntKi), PARAMETER :: M1N5RDxe = 1220 - INTEGER(IntKi), PARAMETER :: M1N6RDxe = 1221 - INTEGER(IntKi), PARAMETER :: M1N7RDxe = 1222 - INTEGER(IntKi), PARAMETER :: M1N8RDxe = 1223 - INTEGER(IntKi), PARAMETER :: M1N9RDxe = 1224 - INTEGER(IntKi), PARAMETER :: M2N1RDxe = 1225 - INTEGER(IntKi), PARAMETER :: M2N2RDxe = 1226 - INTEGER(IntKi), PARAMETER :: M2N3RDxe = 1227 - INTEGER(IntKi), PARAMETER :: M2N4RDxe = 1228 - INTEGER(IntKi), PARAMETER :: M2N5RDxe = 1229 - INTEGER(IntKi), PARAMETER :: M2N6RDxe = 1230 - INTEGER(IntKi), PARAMETER :: M2N7RDxe = 1231 - INTEGER(IntKi), PARAMETER :: M2N8RDxe = 1232 - INTEGER(IntKi), PARAMETER :: M2N9RDxe = 1233 - INTEGER(IntKi), PARAMETER :: M3N1RDxe = 1234 - INTEGER(IntKi), PARAMETER :: M3N2RDxe = 1235 - INTEGER(IntKi), PARAMETER :: M3N3RDxe = 1236 - INTEGER(IntKi), PARAMETER :: M3N4RDxe = 1237 - INTEGER(IntKi), PARAMETER :: M3N5RDxe = 1238 - INTEGER(IntKi), PARAMETER :: M3N6RDxe = 1239 - INTEGER(IntKi), PARAMETER :: M3N7RDxe = 1240 - INTEGER(IntKi), PARAMETER :: M3N8RDxe = 1241 - INTEGER(IntKi), PARAMETER :: M3N9RDxe = 1242 - INTEGER(IntKi), PARAMETER :: M4N1RDxe = 1243 - INTEGER(IntKi), PARAMETER :: M4N2RDxe = 1244 - INTEGER(IntKi), PARAMETER :: M4N3RDxe = 1245 - INTEGER(IntKi), PARAMETER :: M4N4RDxe = 1246 - INTEGER(IntKi), PARAMETER :: M4N5RDxe = 1247 - INTEGER(IntKi), PARAMETER :: M4N6RDxe = 1248 - INTEGER(IntKi), PARAMETER :: M4N7RDxe = 1249 - INTEGER(IntKi), PARAMETER :: M4N8RDxe = 1250 - INTEGER(IntKi), PARAMETER :: M4N9RDxe = 1251 - INTEGER(IntKi), PARAMETER :: M5N1RDxe = 1252 - INTEGER(IntKi), PARAMETER :: M5N2RDxe = 1253 - INTEGER(IntKi), PARAMETER :: M5N3RDxe = 1254 - INTEGER(IntKi), PARAMETER :: M5N4RDxe = 1255 - INTEGER(IntKi), PARAMETER :: M5N5RDxe = 1256 - INTEGER(IntKi), PARAMETER :: M5N6RDxe = 1257 - INTEGER(IntKi), PARAMETER :: M5N7RDxe = 1258 - INTEGER(IntKi), PARAMETER :: M5N8RDxe = 1259 - INTEGER(IntKi), PARAMETER :: M5N9RDxe = 1260 - INTEGER(IntKi), PARAMETER :: M6N1RDxe = 1261 - INTEGER(IntKi), PARAMETER :: M6N2RDxe = 1262 - INTEGER(IntKi), PARAMETER :: M6N3RDxe = 1263 - INTEGER(IntKi), PARAMETER :: M6N4RDxe = 1264 - INTEGER(IntKi), PARAMETER :: M6N5RDxe = 1265 - INTEGER(IntKi), PARAMETER :: M6N6RDxe = 1266 - INTEGER(IntKi), PARAMETER :: M6N7RDxe = 1267 - INTEGER(IntKi), PARAMETER :: M6N8RDxe = 1268 - INTEGER(IntKi), PARAMETER :: M6N9RDxe = 1269 - INTEGER(IntKi), PARAMETER :: M7N1RDxe = 1270 - INTEGER(IntKi), PARAMETER :: M7N2RDxe = 1271 - INTEGER(IntKi), PARAMETER :: M7N3RDxe = 1272 - INTEGER(IntKi), PARAMETER :: M7N4RDxe = 1273 - INTEGER(IntKi), PARAMETER :: M7N5RDxe = 1274 - INTEGER(IntKi), PARAMETER :: M7N6RDxe = 1275 - INTEGER(IntKi), PARAMETER :: M7N7RDxe = 1276 - INTEGER(IntKi), PARAMETER :: M7N8RDxe = 1277 - INTEGER(IntKi), PARAMETER :: M7N9RDxe = 1278 - INTEGER(IntKi), PARAMETER :: M8N1RDxe = 1279 - INTEGER(IntKi), PARAMETER :: M8N2RDxe = 1280 - INTEGER(IntKi), PARAMETER :: M8N3RDxe = 1281 - INTEGER(IntKi), PARAMETER :: M8N4RDxe = 1282 - INTEGER(IntKi), PARAMETER :: M8N5RDxe = 1283 - INTEGER(IntKi), PARAMETER :: M8N6RDxe = 1284 - INTEGER(IntKi), PARAMETER :: M8N7RDxe = 1285 - INTEGER(IntKi), PARAMETER :: M8N8RDxe = 1286 - INTEGER(IntKi), PARAMETER :: M8N9RDxe = 1287 - INTEGER(IntKi), PARAMETER :: M9N1RDxe = 1288 - INTEGER(IntKi), PARAMETER :: M9N2RDxe = 1289 - INTEGER(IntKi), PARAMETER :: M9N3RDxe = 1290 - INTEGER(IntKi), PARAMETER :: M9N4RDxe = 1291 - INTEGER(IntKi), PARAMETER :: M9N5RDxe = 1292 - INTEGER(IntKi), PARAMETER :: M9N6RDxe = 1293 - INTEGER(IntKi), PARAMETER :: M9N7RDxe = 1294 - INTEGER(IntKi), PARAMETER :: M9N8RDxe = 1295 - INTEGER(IntKi), PARAMETER :: M9N9RDxe = 1296 - INTEGER(IntKi), PARAMETER :: M1N1RDye = 1297 - INTEGER(IntKi), PARAMETER :: M1N2RDye = 1298 - INTEGER(IntKi), PARAMETER :: M1N3RDye = 1299 - INTEGER(IntKi), PARAMETER :: M1N4RDye = 1300 - INTEGER(IntKi), PARAMETER :: M1N5RDye = 1301 - INTEGER(IntKi), PARAMETER :: M1N6RDye = 1302 - INTEGER(IntKi), PARAMETER :: M1N7RDye = 1303 - INTEGER(IntKi), PARAMETER :: M1N8RDye = 1304 - INTEGER(IntKi), PARAMETER :: M1N9RDye = 1305 - INTEGER(IntKi), PARAMETER :: M2N1RDye = 1306 - INTEGER(IntKi), PARAMETER :: M2N2RDye = 1307 - INTEGER(IntKi), PARAMETER :: M2N3RDye = 1308 - INTEGER(IntKi), PARAMETER :: M2N4RDye = 1309 - INTEGER(IntKi), PARAMETER :: M2N5RDye = 1310 - INTEGER(IntKi), PARAMETER :: M2N6RDye = 1311 - INTEGER(IntKi), PARAMETER :: M2N7RDye = 1312 - INTEGER(IntKi), PARAMETER :: M2N8RDye = 1313 - INTEGER(IntKi), PARAMETER :: M2N9RDye = 1314 - INTEGER(IntKi), PARAMETER :: M3N1RDye = 1315 - INTEGER(IntKi), PARAMETER :: M3N2RDye = 1316 - INTEGER(IntKi), PARAMETER :: M3N3RDye = 1317 - INTEGER(IntKi), PARAMETER :: M3N4RDye = 1318 - INTEGER(IntKi), PARAMETER :: M3N5RDye = 1319 - INTEGER(IntKi), PARAMETER :: M3N6RDye = 1320 - INTEGER(IntKi), PARAMETER :: M3N7RDye = 1321 - INTEGER(IntKi), PARAMETER :: M3N8RDye = 1322 - INTEGER(IntKi), PARAMETER :: M3N9RDye = 1323 - INTEGER(IntKi), PARAMETER :: M4N1RDye = 1324 - INTEGER(IntKi), PARAMETER :: M4N2RDye = 1325 - INTEGER(IntKi), PARAMETER :: M4N3RDye = 1326 - INTEGER(IntKi), PARAMETER :: M4N4RDye = 1327 - INTEGER(IntKi), PARAMETER :: M4N5RDye = 1328 - INTEGER(IntKi), PARAMETER :: M4N6RDye = 1329 - INTEGER(IntKi), PARAMETER :: M4N7RDye = 1330 - INTEGER(IntKi), PARAMETER :: M4N8RDye = 1331 - INTEGER(IntKi), PARAMETER :: M4N9RDye = 1332 - INTEGER(IntKi), PARAMETER :: M5N1RDye = 1333 - INTEGER(IntKi), PARAMETER :: M5N2RDye = 1334 - INTEGER(IntKi), PARAMETER :: M5N3RDye = 1335 - INTEGER(IntKi), PARAMETER :: M5N4RDye = 1336 - INTEGER(IntKi), PARAMETER :: M5N5RDye = 1337 - INTEGER(IntKi), PARAMETER :: M5N6RDye = 1338 - INTEGER(IntKi), PARAMETER :: M5N7RDye = 1339 - INTEGER(IntKi), PARAMETER :: M5N8RDye = 1340 - INTEGER(IntKi), PARAMETER :: M5N9RDye = 1341 - INTEGER(IntKi), PARAMETER :: M6N1RDye = 1342 - INTEGER(IntKi), PARAMETER :: M6N2RDye = 1343 - INTEGER(IntKi), PARAMETER :: M6N3RDye = 1344 - INTEGER(IntKi), PARAMETER :: M6N4RDye = 1345 - INTEGER(IntKi), PARAMETER :: M6N5RDye = 1346 - INTEGER(IntKi), PARAMETER :: M6N6RDye = 1347 - INTEGER(IntKi), PARAMETER :: M6N7RDye = 1348 - INTEGER(IntKi), PARAMETER :: M6N8RDye = 1349 - INTEGER(IntKi), PARAMETER :: M6N9RDye = 1350 - INTEGER(IntKi), PARAMETER :: M7N1RDye = 1351 - INTEGER(IntKi), PARAMETER :: M7N2RDye = 1352 - INTEGER(IntKi), PARAMETER :: M7N3RDye = 1353 - INTEGER(IntKi), PARAMETER :: M7N4RDye = 1354 - INTEGER(IntKi), PARAMETER :: M7N5RDye = 1355 - INTEGER(IntKi), PARAMETER :: M7N6RDye = 1356 - INTEGER(IntKi), PARAMETER :: M7N7RDye = 1357 - INTEGER(IntKi), PARAMETER :: M7N8RDye = 1358 - INTEGER(IntKi), PARAMETER :: M7N9RDye = 1359 - INTEGER(IntKi), PARAMETER :: M8N1RDye = 1360 - INTEGER(IntKi), PARAMETER :: M8N2RDye = 1361 - INTEGER(IntKi), PARAMETER :: M8N3RDye = 1362 - INTEGER(IntKi), PARAMETER :: M8N4RDye = 1363 - INTEGER(IntKi), PARAMETER :: M8N5RDye = 1364 - INTEGER(IntKi), PARAMETER :: M8N6RDye = 1365 - INTEGER(IntKi), PARAMETER :: M8N7RDye = 1366 - INTEGER(IntKi), PARAMETER :: M8N8RDye = 1367 - INTEGER(IntKi), PARAMETER :: M8N9RDye = 1368 - INTEGER(IntKi), PARAMETER :: M9N1RDye = 1369 - INTEGER(IntKi), PARAMETER :: M9N2RDye = 1370 - INTEGER(IntKi), PARAMETER :: M9N3RDye = 1371 - INTEGER(IntKi), PARAMETER :: M9N4RDye = 1372 - INTEGER(IntKi), PARAMETER :: M9N5RDye = 1373 - INTEGER(IntKi), PARAMETER :: M9N6RDye = 1374 - INTEGER(IntKi), PARAMETER :: M9N7RDye = 1375 - INTEGER(IntKi), PARAMETER :: M9N8RDye = 1376 - INTEGER(IntKi), PARAMETER :: M9N9RDye = 1377 - INTEGER(IntKi), PARAMETER :: M1N1RDze = 1378 - INTEGER(IntKi), PARAMETER :: M1N2RDze = 1379 - INTEGER(IntKi), PARAMETER :: M1N3RDze = 1380 - INTEGER(IntKi), PARAMETER :: M1N4RDze = 1381 - INTEGER(IntKi), PARAMETER :: M1N5RDze = 1382 - INTEGER(IntKi), PARAMETER :: M1N6RDze = 1383 - INTEGER(IntKi), PARAMETER :: M1N7RDze = 1384 - INTEGER(IntKi), PARAMETER :: M1N8RDze = 1385 - INTEGER(IntKi), PARAMETER :: M1N9RDze = 1386 - INTEGER(IntKi), PARAMETER :: M2N1RDze = 1387 - INTEGER(IntKi), PARAMETER :: M2N2RDze = 1388 - INTEGER(IntKi), PARAMETER :: M2N3RDze = 1389 - INTEGER(IntKi), PARAMETER :: M2N4RDze = 1390 - INTEGER(IntKi), PARAMETER :: M2N5RDze = 1391 - INTEGER(IntKi), PARAMETER :: M2N6RDze = 1392 - INTEGER(IntKi), PARAMETER :: M2N7RDze = 1393 - INTEGER(IntKi), PARAMETER :: M2N8RDze = 1394 - INTEGER(IntKi), PARAMETER :: M2N9RDze = 1395 - INTEGER(IntKi), PARAMETER :: M3N1RDze = 1396 - INTEGER(IntKi), PARAMETER :: M3N2RDze = 1397 - INTEGER(IntKi), PARAMETER :: M3N3RDze = 1398 - INTEGER(IntKi), PARAMETER :: M3N4RDze = 1399 - INTEGER(IntKi), PARAMETER :: M3N5RDze = 1400 - INTEGER(IntKi), PARAMETER :: M3N6RDze = 1401 - INTEGER(IntKi), PARAMETER :: M3N7RDze = 1402 - INTEGER(IntKi), PARAMETER :: M3N8RDze = 1403 - INTEGER(IntKi), PARAMETER :: M3N9RDze = 1404 - INTEGER(IntKi), PARAMETER :: M4N1RDze = 1405 - INTEGER(IntKi), PARAMETER :: M4N2RDze = 1406 - INTEGER(IntKi), PARAMETER :: M4N3RDze = 1407 - INTEGER(IntKi), PARAMETER :: M4N4RDze = 1408 - INTEGER(IntKi), PARAMETER :: M4N5RDze = 1409 - INTEGER(IntKi), PARAMETER :: M4N6RDze = 1410 - INTEGER(IntKi), PARAMETER :: M4N7RDze = 1411 - INTEGER(IntKi), PARAMETER :: M4N8RDze = 1412 - INTEGER(IntKi), PARAMETER :: M4N9RDze = 1413 - INTEGER(IntKi), PARAMETER :: M5N1RDze = 1414 - INTEGER(IntKi), PARAMETER :: M5N2RDze = 1415 - INTEGER(IntKi), PARAMETER :: M5N3RDze = 1416 - INTEGER(IntKi), PARAMETER :: M5N4RDze = 1417 - INTEGER(IntKi), PARAMETER :: M5N5RDze = 1418 - INTEGER(IntKi), PARAMETER :: M5N6RDze = 1419 - INTEGER(IntKi), PARAMETER :: M5N7RDze = 1420 - INTEGER(IntKi), PARAMETER :: M5N8RDze = 1421 - INTEGER(IntKi), PARAMETER :: M5N9RDze = 1422 - INTEGER(IntKi), PARAMETER :: M6N1RDze = 1423 - INTEGER(IntKi), PARAMETER :: M6N2RDze = 1424 - INTEGER(IntKi), PARAMETER :: M6N3RDze = 1425 - INTEGER(IntKi), PARAMETER :: M6N4RDze = 1426 - INTEGER(IntKi), PARAMETER :: M6N5RDze = 1427 - INTEGER(IntKi), PARAMETER :: M6N6RDze = 1428 - INTEGER(IntKi), PARAMETER :: M6N7RDze = 1429 - INTEGER(IntKi), PARAMETER :: M6N8RDze = 1430 - INTEGER(IntKi), PARAMETER :: M6N9RDze = 1431 - INTEGER(IntKi), PARAMETER :: M7N1RDze = 1432 - INTEGER(IntKi), PARAMETER :: M7N2RDze = 1433 - INTEGER(IntKi), PARAMETER :: M7N3RDze = 1434 - INTEGER(IntKi), PARAMETER :: M7N4RDze = 1435 - INTEGER(IntKi), PARAMETER :: M7N5RDze = 1436 - INTEGER(IntKi), PARAMETER :: M7N6RDze = 1437 - INTEGER(IntKi), PARAMETER :: M7N7RDze = 1438 - INTEGER(IntKi), PARAMETER :: M7N8RDze = 1439 - INTEGER(IntKi), PARAMETER :: M7N9RDze = 1440 - INTEGER(IntKi), PARAMETER :: M8N1RDze = 1441 - INTEGER(IntKi), PARAMETER :: M8N2RDze = 1442 - INTEGER(IntKi), PARAMETER :: M8N3RDze = 1443 - INTEGER(IntKi), PARAMETER :: M8N4RDze = 1444 - INTEGER(IntKi), PARAMETER :: M8N5RDze = 1445 - INTEGER(IntKi), PARAMETER :: M8N6RDze = 1446 - INTEGER(IntKi), PARAMETER :: M8N7RDze = 1447 - INTEGER(IntKi), PARAMETER :: M8N8RDze = 1448 - INTEGER(IntKi), PARAMETER :: M8N9RDze = 1449 - INTEGER(IntKi), PARAMETER :: M9N1RDze = 1450 - INTEGER(IntKi), PARAMETER :: M9N2RDze = 1451 - INTEGER(IntKi), PARAMETER :: M9N3RDze = 1452 - INTEGER(IntKi), PARAMETER :: M9N4RDze = 1453 - INTEGER(IntKi), PARAMETER :: M9N5RDze = 1454 - INTEGER(IntKi), PARAMETER :: M9N6RDze = 1455 - INTEGER(IntKi), PARAMETER :: M9N7RDze = 1456 - INTEGER(IntKi), PARAMETER :: M9N8RDze = 1457 - INTEGER(IntKi), PARAMETER :: M9N9RDze = 1458 - - - ! Accelerations: - - INTEGER(IntKi), PARAMETER :: M1N1TAxe = 1459 - INTEGER(IntKi), PARAMETER :: M1N2TAxe = 1460 - INTEGER(IntKi), PARAMETER :: M1N3TAxe = 1461 - INTEGER(IntKi), PARAMETER :: M1N4TAxe = 1462 - INTEGER(IntKi), PARAMETER :: M1N5TAxe = 1463 - INTEGER(IntKi), PARAMETER :: M1N6TAxe = 1464 - INTEGER(IntKi), PARAMETER :: M1N7TAxe = 1465 - INTEGER(IntKi), PARAMETER :: M1N8TAxe = 1466 - INTEGER(IntKi), PARAMETER :: M1N9TAxe = 1467 - INTEGER(IntKi), PARAMETER :: M2N1TAxe = 1468 - INTEGER(IntKi), PARAMETER :: M2N2TAxe = 1469 - INTEGER(IntKi), PARAMETER :: M2N3TAxe = 1470 - INTEGER(IntKi), PARAMETER :: M2N4TAxe = 1471 - INTEGER(IntKi), PARAMETER :: M2N5TAxe = 1472 - INTEGER(IntKi), PARAMETER :: M2N6TAxe = 1473 - INTEGER(IntKi), PARAMETER :: M2N7TAxe = 1474 - INTEGER(IntKi), PARAMETER :: M2N8TAxe = 1475 - INTEGER(IntKi), PARAMETER :: M2N9TAxe = 1476 - INTEGER(IntKi), PARAMETER :: M3N1TAxe = 1477 - INTEGER(IntKi), PARAMETER :: M3N2TAxe = 1478 - INTEGER(IntKi), PARAMETER :: M3N3TAxe = 1479 - INTEGER(IntKi), PARAMETER :: M3N4TAxe = 1480 - INTEGER(IntKi), PARAMETER :: M3N5TAxe = 1481 - INTEGER(IntKi), PARAMETER :: M3N6TAxe = 1482 - INTEGER(IntKi), PARAMETER :: M3N7TAxe = 1483 - INTEGER(IntKi), PARAMETER :: M3N8TAxe = 1484 - INTEGER(IntKi), PARAMETER :: M3N9TAxe = 1485 - INTEGER(IntKi), PARAMETER :: M4N1TAxe = 1486 - INTEGER(IntKi), PARAMETER :: M4N2TAxe = 1487 - INTEGER(IntKi), PARAMETER :: M4N3TAxe = 1488 - INTEGER(IntKi), PARAMETER :: M4N4TAxe = 1489 - INTEGER(IntKi), PARAMETER :: M4N5TAxe = 1490 - INTEGER(IntKi), PARAMETER :: M4N6TAxe = 1491 - INTEGER(IntKi), PARAMETER :: M4N7TAxe = 1492 - INTEGER(IntKi), PARAMETER :: M4N8TAxe = 1493 - INTEGER(IntKi), PARAMETER :: M4N9TAxe = 1494 - INTEGER(IntKi), PARAMETER :: M5N1TAxe = 1495 - INTEGER(IntKi), PARAMETER :: M5N2TAxe = 1496 - INTEGER(IntKi), PARAMETER :: M5N3TAxe = 1497 - INTEGER(IntKi), PARAMETER :: M5N4TAxe = 1498 - INTEGER(IntKi), PARAMETER :: M5N5TAxe = 1499 - INTEGER(IntKi), PARAMETER :: M5N6TAxe = 1500 - INTEGER(IntKi), PARAMETER :: M5N7TAxe = 1501 - INTEGER(IntKi), PARAMETER :: M5N8TAxe = 1502 - INTEGER(IntKi), PARAMETER :: M5N9TAxe = 1503 - INTEGER(IntKi), PARAMETER :: M6N1TAxe = 1504 - INTEGER(IntKi), PARAMETER :: M6N2TAxe = 1505 - INTEGER(IntKi), PARAMETER :: M6N3TAxe = 1506 - INTEGER(IntKi), PARAMETER :: M6N4TAxe = 1507 - INTEGER(IntKi), PARAMETER :: M6N5TAxe = 1508 - INTEGER(IntKi), PARAMETER :: M6N6TAxe = 1509 - INTEGER(IntKi), PARAMETER :: M6N7TAxe = 1510 - INTEGER(IntKi), PARAMETER :: M6N8TAxe = 1511 - INTEGER(IntKi), PARAMETER :: M6N9TAxe = 1512 - INTEGER(IntKi), PARAMETER :: M7N1TAxe = 1513 - INTEGER(IntKi), PARAMETER :: M7N2TAxe = 1514 - INTEGER(IntKi), PARAMETER :: M7N3TAxe = 1515 - INTEGER(IntKi), PARAMETER :: M7N4TAxe = 1516 - INTEGER(IntKi), PARAMETER :: M7N5TAxe = 1517 - INTEGER(IntKi), PARAMETER :: M7N6TAxe = 1518 - INTEGER(IntKi), PARAMETER :: M7N7TAxe = 1519 - INTEGER(IntKi), PARAMETER :: M7N8TAxe = 1520 - INTEGER(IntKi), PARAMETER :: M7N9TAxe = 1521 - INTEGER(IntKi), PARAMETER :: M8N1TAxe = 1522 - INTEGER(IntKi), PARAMETER :: M8N2TAxe = 1523 - INTEGER(IntKi), PARAMETER :: M8N3TAxe = 1524 - INTEGER(IntKi), PARAMETER :: M8N4TAxe = 1525 - INTEGER(IntKi), PARAMETER :: M8N5TAxe = 1526 - INTEGER(IntKi), PARAMETER :: M8N6TAxe = 1527 - INTEGER(IntKi), PARAMETER :: M8N7TAxe = 1528 - INTEGER(IntKi), PARAMETER :: M8N8TAxe = 1529 - INTEGER(IntKi), PARAMETER :: M8N9TAxe = 1530 - INTEGER(IntKi), PARAMETER :: M9N1TAxe = 1531 - INTEGER(IntKi), PARAMETER :: M9N2TAxe = 1532 - INTEGER(IntKi), PARAMETER :: M9N3TAxe = 1533 - INTEGER(IntKi), PARAMETER :: M9N4TAxe = 1534 - INTEGER(IntKi), PARAMETER :: M9N5TAxe = 1535 - INTEGER(IntKi), PARAMETER :: M9N6TAxe = 1536 - INTEGER(IntKi), PARAMETER :: M9N7TAxe = 1537 - INTEGER(IntKi), PARAMETER :: M9N8TAxe = 1538 - INTEGER(IntKi), PARAMETER :: M9N9TAxe = 1539 - INTEGER(IntKi), PARAMETER :: M1N1TAye = 1540 - INTEGER(IntKi), PARAMETER :: M1N2TAye = 1541 - INTEGER(IntKi), PARAMETER :: M1N3TAye = 1542 - INTEGER(IntKi), PARAMETER :: M1N4TAye = 1543 - INTEGER(IntKi), PARAMETER :: M1N5TAye = 1544 - INTEGER(IntKi), PARAMETER :: M1N6TAye = 1545 - INTEGER(IntKi), PARAMETER :: M1N7TAye = 1546 - INTEGER(IntKi), PARAMETER :: M1N8TAye = 1547 - INTEGER(IntKi), PARAMETER :: M1N9TAye = 1548 - INTEGER(IntKi), PARAMETER :: M2N1TAye = 1549 - INTEGER(IntKi), PARAMETER :: M2N2TAye = 1550 - INTEGER(IntKi), PARAMETER :: M2N3TAye = 1551 - INTEGER(IntKi), PARAMETER :: M2N4TAye = 1552 - INTEGER(IntKi), PARAMETER :: M2N5TAye = 1553 - INTEGER(IntKi), PARAMETER :: M2N6TAye = 1554 - INTEGER(IntKi), PARAMETER :: M2N7TAye = 1555 - INTEGER(IntKi), PARAMETER :: M2N8TAye = 1556 - INTEGER(IntKi), PARAMETER :: M2N9TAye = 1557 - INTEGER(IntKi), PARAMETER :: M3N1TAye = 1558 - INTEGER(IntKi), PARAMETER :: M3N2TAye = 1559 - INTEGER(IntKi), PARAMETER :: M3N3TAye = 1560 - INTEGER(IntKi), PARAMETER :: M3N4TAye = 1561 - INTEGER(IntKi), PARAMETER :: M3N5TAye = 1562 - INTEGER(IntKi), PARAMETER :: M3N6TAye = 1563 - INTEGER(IntKi), PARAMETER :: M3N7TAye = 1564 - INTEGER(IntKi), PARAMETER :: M3N8TAye = 1565 - INTEGER(IntKi), PARAMETER :: M3N9TAye = 1566 - INTEGER(IntKi), PARAMETER :: M4N1TAye = 1567 - INTEGER(IntKi), PARAMETER :: M4N2TAye = 1568 - INTEGER(IntKi), PARAMETER :: M4N3TAye = 1569 - INTEGER(IntKi), PARAMETER :: M4N4TAye = 1570 - INTEGER(IntKi), PARAMETER :: M4N5TAye = 1571 - INTEGER(IntKi), PARAMETER :: M4N6TAye = 1572 - INTEGER(IntKi), PARAMETER :: M4N7TAye = 1573 - INTEGER(IntKi), PARAMETER :: M4N8TAye = 1574 - INTEGER(IntKi), PARAMETER :: M4N9TAye = 1575 - INTEGER(IntKi), PARAMETER :: M5N1TAye = 1576 - INTEGER(IntKi), PARAMETER :: M5N2TAye = 1577 - INTEGER(IntKi), PARAMETER :: M5N3TAye = 1578 - INTEGER(IntKi), PARAMETER :: M5N4TAye = 1579 - INTEGER(IntKi), PARAMETER :: M5N5TAye = 1580 - INTEGER(IntKi), PARAMETER :: M5N6TAye = 1581 - INTEGER(IntKi), PARAMETER :: M5N7TAye = 1582 - INTEGER(IntKi), PARAMETER :: M5N8TAye = 1583 - INTEGER(IntKi), PARAMETER :: M5N9TAye = 1584 - INTEGER(IntKi), PARAMETER :: M6N1TAye = 1585 - INTEGER(IntKi), PARAMETER :: M6N2TAye = 1586 - INTEGER(IntKi), PARAMETER :: M6N3TAye = 1587 - INTEGER(IntKi), PARAMETER :: M6N4TAye = 1588 - INTEGER(IntKi), PARAMETER :: M6N5TAye = 1589 - INTEGER(IntKi), PARAMETER :: M6N6TAye = 1590 - INTEGER(IntKi), PARAMETER :: M6N7TAye = 1591 - INTEGER(IntKi), PARAMETER :: M6N8TAye = 1592 - INTEGER(IntKi), PARAMETER :: M6N9TAye = 1593 - INTEGER(IntKi), PARAMETER :: M7N1TAye = 1594 - INTEGER(IntKi), PARAMETER :: M7N2TAye = 1595 - INTEGER(IntKi), PARAMETER :: M7N3TAye = 1596 - INTEGER(IntKi), PARAMETER :: M7N4TAye = 1597 - INTEGER(IntKi), PARAMETER :: M7N5TAye = 1598 - INTEGER(IntKi), PARAMETER :: M7N6TAye = 1599 - INTEGER(IntKi), PARAMETER :: M7N7TAye = 1600 - INTEGER(IntKi), PARAMETER :: M7N8TAye = 1601 - INTEGER(IntKi), PARAMETER :: M7N9TAye = 1602 - INTEGER(IntKi), PARAMETER :: M8N1TAye = 1603 - INTEGER(IntKi), PARAMETER :: M8N2TAye = 1604 - INTEGER(IntKi), PARAMETER :: M8N3TAye = 1605 - INTEGER(IntKi), PARAMETER :: M8N4TAye = 1606 - INTEGER(IntKi), PARAMETER :: M8N5TAye = 1607 - INTEGER(IntKi), PARAMETER :: M8N6TAye = 1608 - INTEGER(IntKi), PARAMETER :: M8N7TAye = 1609 - INTEGER(IntKi), PARAMETER :: M8N8TAye = 1610 - INTEGER(IntKi), PARAMETER :: M8N9TAye = 1611 - INTEGER(IntKi), PARAMETER :: M9N1TAye = 1612 - INTEGER(IntKi), PARAMETER :: M9N2TAye = 1613 - INTEGER(IntKi), PARAMETER :: M9N3TAye = 1614 - INTEGER(IntKi), PARAMETER :: M9N4TAye = 1615 - INTEGER(IntKi), PARAMETER :: M9N5TAye = 1616 - INTEGER(IntKi), PARAMETER :: M9N6TAye = 1617 - INTEGER(IntKi), PARAMETER :: M9N7TAye = 1618 - INTEGER(IntKi), PARAMETER :: M9N8TAye = 1619 - INTEGER(IntKi), PARAMETER :: M9N9TAye = 1620 - INTEGER(IntKi), PARAMETER :: M1N1TAze = 1621 - INTEGER(IntKi), PARAMETER :: M1N2TAze = 1622 - INTEGER(IntKi), PARAMETER :: M1N3TAze = 1623 - INTEGER(IntKi), PARAMETER :: M1N4TAze = 1624 - INTEGER(IntKi), PARAMETER :: M1N5TAze = 1625 - INTEGER(IntKi), PARAMETER :: M1N6TAze = 1626 - INTEGER(IntKi), PARAMETER :: M1N7TAze = 1627 - INTEGER(IntKi), PARAMETER :: M1N8TAze = 1628 - INTEGER(IntKi), PARAMETER :: M1N9TAze = 1629 - INTEGER(IntKi), PARAMETER :: M2N1TAze = 1630 - INTEGER(IntKi), PARAMETER :: M2N2TAze = 1631 - INTEGER(IntKi), PARAMETER :: M2N3TAze = 1632 - INTEGER(IntKi), PARAMETER :: M2N4TAze = 1633 - INTEGER(IntKi), PARAMETER :: M2N5TAze = 1634 - INTEGER(IntKi), PARAMETER :: M2N6TAze = 1635 - INTEGER(IntKi), PARAMETER :: M2N7TAze = 1636 - INTEGER(IntKi), PARAMETER :: M2N8TAze = 1637 - INTEGER(IntKi), PARAMETER :: M2N9TAze = 1638 - INTEGER(IntKi), PARAMETER :: M3N1TAze = 1639 - INTEGER(IntKi), PARAMETER :: M3N2TAze = 1640 - INTEGER(IntKi), PARAMETER :: M3N3TAze = 1641 - INTEGER(IntKi), PARAMETER :: M3N4TAze = 1642 - INTEGER(IntKi), PARAMETER :: M3N5TAze = 1643 - INTEGER(IntKi), PARAMETER :: M3N6TAze = 1644 - INTEGER(IntKi), PARAMETER :: M3N7TAze = 1645 - INTEGER(IntKi), PARAMETER :: M3N8TAze = 1646 - INTEGER(IntKi), PARAMETER :: M3N9TAze = 1647 - INTEGER(IntKi), PARAMETER :: M4N1TAze = 1648 - INTEGER(IntKi), PARAMETER :: M4N2TAze = 1649 - INTEGER(IntKi), PARAMETER :: M4N3TAze = 1650 - INTEGER(IntKi), PARAMETER :: M4N4TAze = 1651 - INTEGER(IntKi), PARAMETER :: M4N5TAze = 1652 - INTEGER(IntKi), PARAMETER :: M4N6TAze = 1653 - INTEGER(IntKi), PARAMETER :: M4N7TAze = 1654 - INTEGER(IntKi), PARAMETER :: M4N8TAze = 1655 - INTEGER(IntKi), PARAMETER :: M4N9TAze = 1656 - INTEGER(IntKi), PARAMETER :: M5N1TAze = 1657 - INTEGER(IntKi), PARAMETER :: M5N2TAze = 1658 - INTEGER(IntKi), PARAMETER :: M5N3TAze = 1659 - INTEGER(IntKi), PARAMETER :: M5N4TAze = 1660 - INTEGER(IntKi), PARAMETER :: M5N5TAze = 1661 - INTEGER(IntKi), PARAMETER :: M5N6TAze = 1662 - INTEGER(IntKi), PARAMETER :: M5N7TAze = 1663 - INTEGER(IntKi), PARAMETER :: M5N8TAze = 1664 - INTEGER(IntKi), PARAMETER :: M5N9TAze = 1665 - INTEGER(IntKi), PARAMETER :: M6N1TAze = 1666 - INTEGER(IntKi), PARAMETER :: M6N2TAze = 1667 - INTEGER(IntKi), PARAMETER :: M6N3TAze = 1668 - INTEGER(IntKi), PARAMETER :: M6N4TAze = 1669 - INTEGER(IntKi), PARAMETER :: M6N5TAze = 1670 - INTEGER(IntKi), PARAMETER :: M6N6TAze = 1671 - INTEGER(IntKi), PARAMETER :: M6N7TAze = 1672 - INTEGER(IntKi), PARAMETER :: M6N8TAze = 1673 - INTEGER(IntKi), PARAMETER :: M6N9TAze = 1674 - INTEGER(IntKi), PARAMETER :: M7N1TAze = 1675 - INTEGER(IntKi), PARAMETER :: M7N2TAze = 1676 - INTEGER(IntKi), PARAMETER :: M7N3TAze = 1677 - INTEGER(IntKi), PARAMETER :: M7N4TAze = 1678 - INTEGER(IntKi), PARAMETER :: M7N5TAze = 1679 - INTEGER(IntKi), PARAMETER :: M7N6TAze = 1680 - INTEGER(IntKi), PARAMETER :: M7N7TAze = 1681 - INTEGER(IntKi), PARAMETER :: M7N8TAze = 1682 - INTEGER(IntKi), PARAMETER :: M7N9TAze = 1683 - INTEGER(IntKi), PARAMETER :: M8N1TAze = 1684 - INTEGER(IntKi), PARAMETER :: M8N2TAze = 1685 - INTEGER(IntKi), PARAMETER :: M8N3TAze = 1686 - INTEGER(IntKi), PARAMETER :: M8N4TAze = 1687 - INTEGER(IntKi), PARAMETER :: M8N5TAze = 1688 - INTEGER(IntKi), PARAMETER :: M8N6TAze = 1689 - INTEGER(IntKi), PARAMETER :: M8N7TAze = 1690 - INTEGER(IntKi), PARAMETER :: M8N8TAze = 1691 - INTEGER(IntKi), PARAMETER :: M8N9TAze = 1692 - INTEGER(IntKi), PARAMETER :: M9N1TAze = 1693 - INTEGER(IntKi), PARAMETER :: M9N2TAze = 1694 - INTEGER(IntKi), PARAMETER :: M9N3TAze = 1695 - INTEGER(IntKi), PARAMETER :: M9N4TAze = 1696 - INTEGER(IntKi), PARAMETER :: M9N5TAze = 1697 - INTEGER(IntKi), PARAMETER :: M9N6TAze = 1698 - INTEGER(IntKi), PARAMETER :: M9N7TAze = 1699 - INTEGER(IntKi), PARAMETER :: M9N8TAze = 1700 - INTEGER(IntKi), PARAMETER :: M9N9TAze = 1701 - INTEGER(IntKi), PARAMETER :: M1N1RAxe = 1702 - INTEGER(IntKi), PARAMETER :: M1N2RAxe = 1703 - INTEGER(IntKi), PARAMETER :: M1N3RAxe = 1704 - INTEGER(IntKi), PARAMETER :: M1N4RAxe = 1705 - INTEGER(IntKi), PARAMETER :: M1N5RAxe = 1706 - INTEGER(IntKi), PARAMETER :: M1N6RAxe = 1707 - INTEGER(IntKi), PARAMETER :: M1N7RAxe = 1708 - INTEGER(IntKi), PARAMETER :: M1N8RAxe = 1709 - INTEGER(IntKi), PARAMETER :: M1N9RAxe = 1710 - INTEGER(IntKi), PARAMETER :: M2N1RAxe = 1711 - INTEGER(IntKi), PARAMETER :: M2N2RAxe = 1712 - INTEGER(IntKi), PARAMETER :: M2N3RAxe = 1713 - INTEGER(IntKi), PARAMETER :: M2N4RAxe = 1714 - INTEGER(IntKi), PARAMETER :: M2N5RAxe = 1715 - INTEGER(IntKi), PARAMETER :: M2N6RAxe = 1716 - INTEGER(IntKi), PARAMETER :: M2N7RAxe = 1717 - INTEGER(IntKi), PARAMETER :: M2N8RAxe = 1718 - INTEGER(IntKi), PARAMETER :: M2N9RAxe = 1719 - INTEGER(IntKi), PARAMETER :: M3N1RAxe = 1720 - INTEGER(IntKi), PARAMETER :: M3N2RAxe = 1721 - INTEGER(IntKi), PARAMETER :: M3N3RAxe = 1722 - INTEGER(IntKi), PARAMETER :: M3N4RAxe = 1723 - INTEGER(IntKi), PARAMETER :: M3N5RAxe = 1724 - INTEGER(IntKi), PARAMETER :: M3N6RAxe = 1725 - INTEGER(IntKi), PARAMETER :: M3N7RAxe = 1726 - INTEGER(IntKi), PARAMETER :: M3N8RAxe = 1727 - INTEGER(IntKi), PARAMETER :: M3N9RAxe = 1728 - INTEGER(IntKi), PARAMETER :: M4N1RAxe = 1729 - INTEGER(IntKi), PARAMETER :: M4N2RAxe = 1730 - INTEGER(IntKi), PARAMETER :: M4N3RAxe = 1731 - INTEGER(IntKi), PARAMETER :: M4N4RAxe = 1732 - INTEGER(IntKi), PARAMETER :: M4N5RAxe = 1733 - INTEGER(IntKi), PARAMETER :: M4N6RAxe = 1734 - INTEGER(IntKi), PARAMETER :: M4N7RAxe = 1735 - INTEGER(IntKi), PARAMETER :: M4N8RAxe = 1736 - INTEGER(IntKi), PARAMETER :: M4N9RAxe = 1737 - INTEGER(IntKi), PARAMETER :: M5N1RAxe = 1738 - INTEGER(IntKi), PARAMETER :: M5N2RAxe = 1739 - INTEGER(IntKi), PARAMETER :: M5N3RAxe = 1740 - INTEGER(IntKi), PARAMETER :: M5N4RAxe = 1741 - INTEGER(IntKi), PARAMETER :: M5N5RAxe = 1742 - INTEGER(IntKi), PARAMETER :: M5N6RAxe = 1743 - INTEGER(IntKi), PARAMETER :: M5N7RAxe = 1744 - INTEGER(IntKi), PARAMETER :: M5N8RAxe = 1745 - INTEGER(IntKi), PARAMETER :: M5N9RAxe = 1746 - INTEGER(IntKi), PARAMETER :: M6N1RAxe = 1747 - INTEGER(IntKi), PARAMETER :: M6N2RAxe = 1748 - INTEGER(IntKi), PARAMETER :: M6N3RAxe = 1749 - INTEGER(IntKi), PARAMETER :: M6N4RAxe = 1750 - INTEGER(IntKi), PARAMETER :: M6N5RAxe = 1751 - INTEGER(IntKi), PARAMETER :: M6N6RAxe = 1752 - INTEGER(IntKi), PARAMETER :: M6N7RAxe = 1753 - INTEGER(IntKi), PARAMETER :: M6N8RAxe = 1754 - INTEGER(IntKi), PARAMETER :: M6N9RAxe = 1755 - INTEGER(IntKi), PARAMETER :: M7N1RAxe = 1756 - INTEGER(IntKi), PARAMETER :: M7N2RAxe = 1757 - INTEGER(IntKi), PARAMETER :: M7N3RAxe = 1758 - INTEGER(IntKi), PARAMETER :: M7N4RAxe = 1759 - INTEGER(IntKi), PARAMETER :: M7N5RAxe = 1760 - INTEGER(IntKi), PARAMETER :: M7N6RAxe = 1761 - INTEGER(IntKi), PARAMETER :: M7N7RAxe = 1762 - INTEGER(IntKi), PARAMETER :: M7N8RAxe = 1763 - INTEGER(IntKi), PARAMETER :: M7N9RAxe = 1764 - INTEGER(IntKi), PARAMETER :: M8N1RAxe = 1765 - INTEGER(IntKi), PARAMETER :: M8N2RAxe = 1766 - INTEGER(IntKi), PARAMETER :: M8N3RAxe = 1767 - INTEGER(IntKi), PARAMETER :: M8N4RAxe = 1768 - INTEGER(IntKi), PARAMETER :: M8N5RAxe = 1769 - INTEGER(IntKi), PARAMETER :: M8N6RAxe = 1770 - INTEGER(IntKi), PARAMETER :: M8N7RAxe = 1771 - INTEGER(IntKi), PARAMETER :: M8N8RAxe = 1772 - INTEGER(IntKi), PARAMETER :: M8N9RAxe = 1773 - INTEGER(IntKi), PARAMETER :: M9N1RAxe = 1774 - INTEGER(IntKi), PARAMETER :: M9N2RAxe = 1775 - INTEGER(IntKi), PARAMETER :: M9N3RAxe = 1776 - INTEGER(IntKi), PARAMETER :: M9N4RAxe = 1777 - INTEGER(IntKi), PARAMETER :: M9N5RAxe = 1778 - INTEGER(IntKi), PARAMETER :: M9N6RAxe = 1779 - INTEGER(IntKi), PARAMETER :: M9N7RAxe = 1780 - INTEGER(IntKi), PARAMETER :: M9N8RAxe = 1781 - INTEGER(IntKi), PARAMETER :: M9N9RAxe = 1782 - INTEGER(IntKi), PARAMETER :: M1N1RAye = 1783 - INTEGER(IntKi), PARAMETER :: M1N2RAye = 1784 - INTEGER(IntKi), PARAMETER :: M1N3RAye = 1785 - INTEGER(IntKi), PARAMETER :: M1N4RAye = 1786 - INTEGER(IntKi), PARAMETER :: M1N5RAye = 1787 - INTEGER(IntKi), PARAMETER :: M1N6RAye = 1788 - INTEGER(IntKi), PARAMETER :: M1N7RAye = 1789 - INTEGER(IntKi), PARAMETER :: M1N8RAye = 1790 - INTEGER(IntKi), PARAMETER :: M1N9RAye = 1791 - INTEGER(IntKi), PARAMETER :: M2N1RAye = 1792 - INTEGER(IntKi), PARAMETER :: M2N2RAye = 1793 - INTEGER(IntKi), PARAMETER :: M2N3RAye = 1794 - INTEGER(IntKi), PARAMETER :: M2N4RAye = 1795 - INTEGER(IntKi), PARAMETER :: M2N5RAye = 1796 - INTEGER(IntKi), PARAMETER :: M2N6RAye = 1797 - INTEGER(IntKi), PARAMETER :: M2N7RAye = 1798 - INTEGER(IntKi), PARAMETER :: M2N8RAye = 1799 - INTEGER(IntKi), PARAMETER :: M2N9RAye = 1800 - INTEGER(IntKi), PARAMETER :: M3N1RAye = 1801 - INTEGER(IntKi), PARAMETER :: M3N2RAye = 1802 - INTEGER(IntKi), PARAMETER :: M3N3RAye = 1803 - INTEGER(IntKi), PARAMETER :: M3N4RAye = 1804 - INTEGER(IntKi), PARAMETER :: M3N5RAye = 1805 - INTEGER(IntKi), PARAMETER :: M3N6RAye = 1806 - INTEGER(IntKi), PARAMETER :: M3N7RAye = 1807 - INTEGER(IntKi), PARAMETER :: M3N8RAye = 1808 - INTEGER(IntKi), PARAMETER :: M3N9RAye = 1809 - INTEGER(IntKi), PARAMETER :: M4N1RAye = 1810 - INTEGER(IntKi), PARAMETER :: M4N2RAye = 1811 - INTEGER(IntKi), PARAMETER :: M4N3RAye = 1812 - INTEGER(IntKi), PARAMETER :: M4N4RAye = 1813 - INTEGER(IntKi), PARAMETER :: M4N5RAye = 1814 - INTEGER(IntKi), PARAMETER :: M4N6RAye = 1815 - INTEGER(IntKi), PARAMETER :: M4N7RAye = 1816 - INTEGER(IntKi), PARAMETER :: M4N8RAye = 1817 - INTEGER(IntKi), PARAMETER :: M4N9RAye = 1818 - INTEGER(IntKi), PARAMETER :: M5N1RAye = 1819 - INTEGER(IntKi), PARAMETER :: M5N2RAye = 1820 - INTEGER(IntKi), PARAMETER :: M5N3RAye = 1821 - INTEGER(IntKi), PARAMETER :: M5N4RAye = 1822 - INTEGER(IntKi), PARAMETER :: M5N5RAye = 1823 - INTEGER(IntKi), PARAMETER :: M5N6RAye = 1824 - INTEGER(IntKi), PARAMETER :: M5N7RAye = 1825 - INTEGER(IntKi), PARAMETER :: M5N8RAye = 1826 - INTEGER(IntKi), PARAMETER :: M5N9RAye = 1827 - INTEGER(IntKi), PARAMETER :: M6N1RAye = 1828 - INTEGER(IntKi), PARAMETER :: M6N2RAye = 1829 - INTEGER(IntKi), PARAMETER :: M6N3RAye = 1830 - INTEGER(IntKi), PARAMETER :: M6N4RAye = 1831 - INTEGER(IntKi), PARAMETER :: M6N5RAye = 1832 - INTEGER(IntKi), PARAMETER :: M6N6RAye = 1833 - INTEGER(IntKi), PARAMETER :: M6N7RAye = 1834 - INTEGER(IntKi), PARAMETER :: M6N8RAye = 1835 - INTEGER(IntKi), PARAMETER :: M6N9RAye = 1836 - INTEGER(IntKi), PARAMETER :: M7N1RAye = 1837 - INTEGER(IntKi), PARAMETER :: M7N2RAye = 1838 - INTEGER(IntKi), PARAMETER :: M7N3RAye = 1839 - INTEGER(IntKi), PARAMETER :: M7N4RAye = 1840 - INTEGER(IntKi), PARAMETER :: M7N5RAye = 1841 - INTEGER(IntKi), PARAMETER :: M7N6RAye = 1842 - INTEGER(IntKi), PARAMETER :: M7N7RAye = 1843 - INTEGER(IntKi), PARAMETER :: M7N8RAye = 1844 - INTEGER(IntKi), PARAMETER :: M7N9RAye = 1845 - INTEGER(IntKi), PARAMETER :: M8N1RAye = 1846 - INTEGER(IntKi), PARAMETER :: M8N2RAye = 1847 - INTEGER(IntKi), PARAMETER :: M8N3RAye = 1848 - INTEGER(IntKi), PARAMETER :: M8N4RAye = 1849 - INTEGER(IntKi), PARAMETER :: M8N5RAye = 1850 - INTEGER(IntKi), PARAMETER :: M8N6RAye = 1851 - INTEGER(IntKi), PARAMETER :: M8N7RAye = 1852 - INTEGER(IntKi), PARAMETER :: M8N8RAye = 1853 - INTEGER(IntKi), PARAMETER :: M8N9RAye = 1854 - INTEGER(IntKi), PARAMETER :: M9N1RAye = 1855 - INTEGER(IntKi), PARAMETER :: M9N2RAye = 1856 - INTEGER(IntKi), PARAMETER :: M9N3RAye = 1857 - INTEGER(IntKi), PARAMETER :: M9N4RAye = 1858 - INTEGER(IntKi), PARAMETER :: M9N5RAye = 1859 - INTEGER(IntKi), PARAMETER :: M9N6RAye = 1860 - INTEGER(IntKi), PARAMETER :: M9N7RAye = 1861 - INTEGER(IntKi), PARAMETER :: M9N8RAye = 1862 - INTEGER(IntKi), PARAMETER :: M9N9RAye = 1863 - INTEGER(IntKi), PARAMETER :: M1N1RAze = 1864 - INTEGER(IntKi), PARAMETER :: M1N2RAze = 1865 - INTEGER(IntKi), PARAMETER :: M1N3RAze = 1866 - INTEGER(IntKi), PARAMETER :: M1N4RAze = 1867 - INTEGER(IntKi), PARAMETER :: M1N5RAze = 1868 - INTEGER(IntKi), PARAMETER :: M1N6RAze = 1869 - INTEGER(IntKi), PARAMETER :: M1N7RAze = 1870 - INTEGER(IntKi), PARAMETER :: M1N8RAze = 1871 - INTEGER(IntKi), PARAMETER :: M1N9RAze = 1872 - INTEGER(IntKi), PARAMETER :: M2N1RAze = 1873 - INTEGER(IntKi), PARAMETER :: M2N2RAze = 1874 - INTEGER(IntKi), PARAMETER :: M2N3RAze = 1875 - INTEGER(IntKi), PARAMETER :: M2N4RAze = 1876 - INTEGER(IntKi), PARAMETER :: M2N5RAze = 1877 - INTEGER(IntKi), PARAMETER :: M2N6RAze = 1878 - INTEGER(IntKi), PARAMETER :: M2N7RAze = 1879 - INTEGER(IntKi), PARAMETER :: M2N8RAze = 1880 - INTEGER(IntKi), PARAMETER :: M2N9RAze = 1881 - INTEGER(IntKi), PARAMETER :: M3N1RAze = 1882 - INTEGER(IntKi), PARAMETER :: M3N2RAze = 1883 - INTEGER(IntKi), PARAMETER :: M3N3RAze = 1884 - INTEGER(IntKi), PARAMETER :: M3N4RAze = 1885 - INTEGER(IntKi), PARAMETER :: M3N5RAze = 1886 - INTEGER(IntKi), PARAMETER :: M3N6RAze = 1887 - INTEGER(IntKi), PARAMETER :: M3N7RAze = 1888 - INTEGER(IntKi), PARAMETER :: M3N8RAze = 1889 - INTEGER(IntKi), PARAMETER :: M3N9RAze = 1890 - INTEGER(IntKi), PARAMETER :: M4N1RAze = 1891 - INTEGER(IntKi), PARAMETER :: M4N2RAze = 1892 - INTEGER(IntKi), PARAMETER :: M4N3RAze = 1893 - INTEGER(IntKi), PARAMETER :: M4N4RAze = 1894 - INTEGER(IntKi), PARAMETER :: M4N5RAze = 1895 - INTEGER(IntKi), PARAMETER :: M4N6RAze = 1896 - INTEGER(IntKi), PARAMETER :: M4N7RAze = 1897 - INTEGER(IntKi), PARAMETER :: M4N8RAze = 1898 - INTEGER(IntKi), PARAMETER :: M4N9RAze = 1899 - INTEGER(IntKi), PARAMETER :: M5N1RAze = 1900 - INTEGER(IntKi), PARAMETER :: M5N2RAze = 1901 - INTEGER(IntKi), PARAMETER :: M5N3RAze = 1902 - INTEGER(IntKi), PARAMETER :: M5N4RAze = 1903 - INTEGER(IntKi), PARAMETER :: M5N5RAze = 1904 - INTEGER(IntKi), PARAMETER :: M5N6RAze = 1905 - INTEGER(IntKi), PARAMETER :: M5N7RAze = 1906 - INTEGER(IntKi), PARAMETER :: M5N8RAze = 1907 - INTEGER(IntKi), PARAMETER :: M5N9RAze = 1908 - INTEGER(IntKi), PARAMETER :: M6N1RAze = 1909 - INTEGER(IntKi), PARAMETER :: M6N2RAze = 1910 - INTEGER(IntKi), PARAMETER :: M6N3RAze = 1911 - INTEGER(IntKi), PARAMETER :: M6N4RAze = 1912 - INTEGER(IntKi), PARAMETER :: M6N5RAze = 1913 - INTEGER(IntKi), PARAMETER :: M6N6RAze = 1914 - INTEGER(IntKi), PARAMETER :: M6N7RAze = 1915 - INTEGER(IntKi), PARAMETER :: M6N8RAze = 1916 - INTEGER(IntKi), PARAMETER :: M6N9RAze = 1917 - INTEGER(IntKi), PARAMETER :: M7N1RAze = 1918 - INTEGER(IntKi), PARAMETER :: M7N2RAze = 1919 - INTEGER(IntKi), PARAMETER :: M7N3RAze = 1920 - INTEGER(IntKi), PARAMETER :: M7N4RAze = 1921 - INTEGER(IntKi), PARAMETER :: M7N5RAze = 1922 - INTEGER(IntKi), PARAMETER :: M7N6RAze = 1923 - INTEGER(IntKi), PARAMETER :: M7N7RAze = 1924 - INTEGER(IntKi), PARAMETER :: M7N8RAze = 1925 - INTEGER(IntKi), PARAMETER :: M7N9RAze = 1926 - INTEGER(IntKi), PARAMETER :: M8N1RAze = 1927 - INTEGER(IntKi), PARAMETER :: M8N2RAze = 1928 - INTEGER(IntKi), PARAMETER :: M8N3RAze = 1929 - INTEGER(IntKi), PARAMETER :: M8N4RAze = 1930 - INTEGER(IntKi), PARAMETER :: M8N5RAze = 1931 - INTEGER(IntKi), PARAMETER :: M8N6RAze = 1932 - INTEGER(IntKi), PARAMETER :: M8N7RAze = 1933 - INTEGER(IntKi), PARAMETER :: M8N8RAze = 1934 - INTEGER(IntKi), PARAMETER :: M8N9RAze = 1935 - INTEGER(IntKi), PARAMETER :: M9N1RAze = 1936 - INTEGER(IntKi), PARAMETER :: M9N2RAze = 1937 - INTEGER(IntKi), PARAMETER :: M9N3RAze = 1938 - INTEGER(IntKi), PARAMETER :: M9N4RAze = 1939 - INTEGER(IntKi), PARAMETER :: M9N5RAze = 1940 - INTEGER(IntKi), PARAMETER :: M9N6RAze = 1941 - INTEGER(IntKi), PARAMETER :: M9N7RAze = 1942 - INTEGER(IntKi), PARAMETER :: M9N8RAze = 1943 - INTEGER(IntKi), PARAMETER :: M9N9RAze = 1944 - - - ! Reactions: - - INTEGER(IntKi), PARAMETER :: ReactFXss = 1945 - INTEGER(IntKi), PARAMETER :: ReactFYss = 1946 - INTEGER(IntKi), PARAMETER :: ReactFZss = 1947 - INTEGER(IntKi), PARAMETER :: ReactMXss = 1948 - INTEGER(IntKi), PARAMETER :: ReactMYss = 1949 - INTEGER(IntKi), PARAMETER :: ReactMZss = 1950 - INTEGER(IntKi), PARAMETER :: IntfFXss = 1951 - INTEGER(IntKi), PARAMETER :: IntfFYss = 1952 - INTEGER(IntKi), PARAMETER :: IntfFZss = 1953 - INTEGER(IntKi), PARAMETER :: IntfMXss = 1954 - INTEGER(IntKi), PARAMETER :: IntfMYss = 1955 - INTEGER(IntKi), PARAMETER :: IntfMZss = 1956 - - - ! Interface Deflections: - - INTEGER(IntKi), PARAMETER :: IntfTDXss = 1957 - INTEGER(IntKi), PARAMETER :: IntfTDYss = 1958 - INTEGER(IntKi), PARAMETER :: IntfTDZss = 1959 - INTEGER(IntKi), PARAMETER :: IntfRDXss = 1960 - INTEGER(IntKi), PARAMETER :: IntfRDYss = 1961 - INTEGER(IntKi), PARAMETER :: IntfRDZss = 1962 - - - ! Interface Accelerations: - - INTEGER(IntKi), PARAMETER :: IntfTAXss = 1963 - INTEGER(IntKi), PARAMETER :: IntfTAYss = 1964 - INTEGER(IntKi), PARAMETER :: IntfTAZss = 1965 - INTEGER(IntKi), PARAMETER :: IntfRAXss = 1966 - INTEGER(IntKi), PARAMETER :: IntfRAYss = 1967 - INTEGER(IntKi), PARAMETER :: IntfRAZss = 1968 - - - ! Modal Parameters: - - INTEGER(IntKi), PARAMETER :: SSqm01 = 1969 - INTEGER(IntKi), PARAMETER :: SSqm02 = 1970 - INTEGER(IntKi), PARAMETER :: SSqm03 = 1971 - INTEGER(IntKi), PARAMETER :: SSqm04 = 1972 - INTEGER(IntKi), PARAMETER :: SSqm05 = 1973 - INTEGER(IntKi), PARAMETER :: SSqm06 = 1974 - INTEGER(IntKi), PARAMETER :: SSqm07 = 1975 - INTEGER(IntKi), PARAMETER :: SSqm08 = 1976 - INTEGER(IntKi), PARAMETER :: SSqm09 = 1977 - INTEGER(IntKi), PARAMETER :: SSqm10 = 1978 - INTEGER(IntKi), PARAMETER :: SSqm11 = 1979 - INTEGER(IntKi), PARAMETER :: SSqm12 = 1980 - INTEGER(IntKi), PARAMETER :: SSqm13 = 1981 - INTEGER(IntKi), PARAMETER :: SSqm14 = 1982 - INTEGER(IntKi), PARAMETER :: SSqm15 = 1983 - INTEGER(IntKi), PARAMETER :: SSqm16 = 1984 - INTEGER(IntKi), PARAMETER :: SSqm17 = 1985 - INTEGER(IntKi), PARAMETER :: SSqm18 = 1986 - INTEGER(IntKi), PARAMETER :: SSqm19 = 1987 - INTEGER(IntKi), PARAMETER :: SSqm20 = 1988 - INTEGER(IntKi), PARAMETER :: SSqm21 = 1989 - INTEGER(IntKi), PARAMETER :: SSqm22 = 1990 - INTEGER(IntKi), PARAMETER :: SSqm23 = 1991 - INTEGER(IntKi), PARAMETER :: SSqm24 = 1992 - INTEGER(IntKi), PARAMETER :: SSqm25 = 1993 - INTEGER(IntKi), PARAMETER :: SSqm26 = 1994 - INTEGER(IntKi), PARAMETER :: SSqm27 = 1995 - INTEGER(IntKi), PARAMETER :: SSqm28 = 1996 - INTEGER(IntKi), PARAMETER :: SSqm29 = 1997 - INTEGER(IntKi), PARAMETER :: SSqm30 = 1998 - INTEGER(IntKi), PARAMETER :: SSqm31 = 1999 - INTEGER(IntKi), PARAMETER :: SSqm32 = 2000 - INTEGER(IntKi), PARAMETER :: SSqm33 = 2001 - INTEGER(IntKi), PARAMETER :: SSqm34 = 2002 - INTEGER(IntKi), PARAMETER :: SSqm35 = 2003 - INTEGER(IntKi), PARAMETER :: SSqm36 = 2004 - INTEGER(IntKi), PARAMETER :: SSqm37 = 2005 - INTEGER(IntKi), PARAMETER :: SSqm38 = 2006 - INTEGER(IntKi), PARAMETER :: SSqm39 = 2007 - INTEGER(IntKi), PARAMETER :: SSqm40 = 2008 - INTEGER(IntKi), PARAMETER :: SSqm41 = 2009 - INTEGER(IntKi), PARAMETER :: SSqm42 = 2010 - INTEGER(IntKi), PARAMETER :: SSqm43 = 2011 - INTEGER(IntKi), PARAMETER :: SSqm44 = 2012 - INTEGER(IntKi), PARAMETER :: SSqm45 = 2013 - INTEGER(IntKi), PARAMETER :: SSqm46 = 2014 - INTEGER(IntKi), PARAMETER :: SSqm47 = 2015 - INTEGER(IntKi), PARAMETER :: SSqm48 = 2016 - INTEGER(IntKi), PARAMETER :: SSqm49 = 2017 - INTEGER(IntKi), PARAMETER :: SSqm50 = 2018 - INTEGER(IntKi), PARAMETER :: SSqm51 = 2019 - INTEGER(IntKi), PARAMETER :: SSqm52 = 2020 - INTEGER(IntKi), PARAMETER :: SSqm53 = 2021 - INTEGER(IntKi), PARAMETER :: SSqm54 = 2022 - INTEGER(IntKi), PARAMETER :: SSqm55 = 2023 - INTEGER(IntKi), PARAMETER :: SSqm56 = 2024 - INTEGER(IntKi), PARAMETER :: SSqm57 = 2025 - INTEGER(IntKi), PARAMETER :: SSqm58 = 2026 - INTEGER(IntKi), PARAMETER :: SSqm59 = 2027 - INTEGER(IntKi), PARAMETER :: SSqm60 = 2028 - INTEGER(IntKi), PARAMETER :: SSqm61 = 2029 - INTEGER(IntKi), PARAMETER :: SSqm62 = 2030 - INTEGER(IntKi), PARAMETER :: SSqm63 = 2031 - INTEGER(IntKi), PARAMETER :: SSqm64 = 2032 - INTEGER(IntKi), PARAMETER :: SSqm65 = 2033 - INTEGER(IntKi), PARAMETER :: SSqm66 = 2034 - INTEGER(IntKi), PARAMETER :: SSqm67 = 2035 - INTEGER(IntKi), PARAMETER :: SSqm68 = 2036 - INTEGER(IntKi), PARAMETER :: SSqm69 = 2037 - INTEGER(IntKi), PARAMETER :: SSqm70 = 2038 - INTEGER(IntKi), PARAMETER :: SSqm71 = 2039 - INTEGER(IntKi), PARAMETER :: SSqm72 = 2040 - INTEGER(IntKi), PARAMETER :: SSqm73 = 2041 - INTEGER(IntKi), PARAMETER :: SSqm74 = 2042 - INTEGER(IntKi), PARAMETER :: SSqm75 = 2043 - INTEGER(IntKi), PARAMETER :: SSqm76 = 2044 - INTEGER(IntKi), PARAMETER :: SSqm77 = 2045 - INTEGER(IntKi), PARAMETER :: SSqm78 = 2046 - INTEGER(IntKi), PARAMETER :: SSqm79 = 2047 - INTEGER(IntKi), PARAMETER :: SSqm80 = 2048 - INTEGER(IntKi), PARAMETER :: SSqm81 = 2049 - INTEGER(IntKi), PARAMETER :: SSqm82 = 2050 - INTEGER(IntKi), PARAMETER :: SSqm83 = 2051 - INTEGER(IntKi), PARAMETER :: SSqm84 = 2052 - INTEGER(IntKi), PARAMETER :: SSqm85 = 2053 - INTEGER(IntKi), PARAMETER :: SSqm86 = 2054 - INTEGER(IntKi), PARAMETER :: SSqm87 = 2055 - INTEGER(IntKi), PARAMETER :: SSqm88 = 2056 - INTEGER(IntKi), PARAMETER :: SSqm89 = 2057 - INTEGER(IntKi), PARAMETER :: SSqm90 = 2058 - INTEGER(IntKi), PARAMETER :: SSqm91 = 2059 - INTEGER(IntKi), PARAMETER :: SSqm92 = 2060 - INTEGER(IntKi), PARAMETER :: SSqm93 = 2061 - INTEGER(IntKi), PARAMETER :: SSqm94 = 2062 - INTEGER(IntKi), PARAMETER :: SSqm95 = 2063 - INTEGER(IntKi), PARAMETER :: SSqm96 = 2064 - INTEGER(IntKi), PARAMETER :: SSqm97 = 2065 - INTEGER(IntKi), PARAMETER :: SSqm98 = 2066 - INTEGER(IntKi), PARAMETER :: SSqm99 = 2067 - INTEGER(IntKi), PARAMETER :: SSqmd01 = 2068 - INTEGER(IntKi), PARAMETER :: SSqmd02 = 2069 - INTEGER(IntKi), PARAMETER :: SSqmd03 = 2070 - INTEGER(IntKi), PARAMETER :: SSqmd04 = 2071 - INTEGER(IntKi), PARAMETER :: SSqmd05 = 2072 - INTEGER(IntKi), PARAMETER :: SSqmd06 = 2073 - INTEGER(IntKi), PARAMETER :: SSqmd07 = 2074 - INTEGER(IntKi), PARAMETER :: SSqmd08 = 2075 - INTEGER(IntKi), PARAMETER :: SSqmd09 = 2076 - INTEGER(IntKi), PARAMETER :: SSqmd10 = 2077 - INTEGER(IntKi), PARAMETER :: SSqmd11 = 2078 - INTEGER(IntKi), PARAMETER :: SSqmd12 = 2079 - INTEGER(IntKi), PARAMETER :: SSqmd13 = 2080 - INTEGER(IntKi), PARAMETER :: SSqmd14 = 2081 - INTEGER(IntKi), PARAMETER :: SSqmd15 = 2082 - INTEGER(IntKi), PARAMETER :: SSqmd16 = 2083 - INTEGER(IntKi), PARAMETER :: SSqmd17 = 2084 - INTEGER(IntKi), PARAMETER :: SSqmd18 = 2085 - INTEGER(IntKi), PARAMETER :: SSqmd19 = 2086 - INTEGER(IntKi), PARAMETER :: SSqmd20 = 2087 - INTEGER(IntKi), PARAMETER :: SSqmd21 = 2088 - INTEGER(IntKi), PARAMETER :: SSqmd22 = 2089 - INTEGER(IntKi), PARAMETER :: SSqmd23 = 2090 - INTEGER(IntKi), PARAMETER :: SSqmd24 = 2091 - INTEGER(IntKi), PARAMETER :: SSqmd25 = 2092 - INTEGER(IntKi), PARAMETER :: SSqmd26 = 2093 - INTEGER(IntKi), PARAMETER :: SSqmd27 = 2094 - INTEGER(IntKi), PARAMETER :: SSqmd28 = 2095 - INTEGER(IntKi), PARAMETER :: SSqmd29 = 2096 - INTEGER(IntKi), PARAMETER :: SSqmd30 = 2097 - INTEGER(IntKi), PARAMETER :: SSqmd31 = 2098 - INTEGER(IntKi), PARAMETER :: SSqmd32 = 2099 - INTEGER(IntKi), PARAMETER :: SSqmd33 = 2100 - INTEGER(IntKi), PARAMETER :: SSqmd34 = 2101 - INTEGER(IntKi), PARAMETER :: SSqmd35 = 2102 - INTEGER(IntKi), PARAMETER :: SSqmd36 = 2103 - INTEGER(IntKi), PARAMETER :: SSqmd37 = 2104 - INTEGER(IntKi), PARAMETER :: SSqmd38 = 2105 - INTEGER(IntKi), PARAMETER :: SSqmd39 = 2106 - INTEGER(IntKi), PARAMETER :: SSqmd40 = 2107 - INTEGER(IntKi), PARAMETER :: SSqmd41 = 2108 - INTEGER(IntKi), PARAMETER :: SSqmd42 = 2109 - INTEGER(IntKi), PARAMETER :: SSqmd43 = 2110 - INTEGER(IntKi), PARAMETER :: SSqmd44 = 2111 - INTEGER(IntKi), PARAMETER :: SSqmd45 = 2112 - INTEGER(IntKi), PARAMETER :: SSqmd46 = 2113 - INTEGER(IntKi), PARAMETER :: SSqmd47 = 2114 - INTEGER(IntKi), PARAMETER :: SSqmd48 = 2115 - INTEGER(IntKi), PARAMETER :: SSqmd49 = 2116 - INTEGER(IntKi), PARAMETER :: SSqmd50 = 2117 - INTEGER(IntKi), PARAMETER :: SSqmd51 = 2118 - INTEGER(IntKi), PARAMETER :: SSqmd52 = 2119 - INTEGER(IntKi), PARAMETER :: SSqmd53 = 2120 - INTEGER(IntKi), PARAMETER :: SSqmd54 = 2121 - INTEGER(IntKi), PARAMETER :: SSqmd55 = 2122 - INTEGER(IntKi), PARAMETER :: SSqmd56 = 2123 - INTEGER(IntKi), PARAMETER :: SSqmd57 = 2124 - INTEGER(IntKi), PARAMETER :: SSqmd58 = 2125 - INTEGER(IntKi), PARAMETER :: SSqmd59 = 2126 - INTEGER(IntKi), PARAMETER :: SSqmd60 = 2127 - INTEGER(IntKi), PARAMETER :: SSqmd61 = 2128 - INTEGER(IntKi), PARAMETER :: SSqmd62 = 2129 - INTEGER(IntKi), PARAMETER :: SSqmd63 = 2130 - INTEGER(IntKi), PARAMETER :: SSqmd64 = 2131 - INTEGER(IntKi), PARAMETER :: SSqmd65 = 2132 - INTEGER(IntKi), PARAMETER :: SSqmd66 = 2133 - INTEGER(IntKi), PARAMETER :: SSqmd67 = 2134 - INTEGER(IntKi), PARAMETER :: SSqmd68 = 2135 - INTEGER(IntKi), PARAMETER :: SSqmd69 = 2136 - INTEGER(IntKi), PARAMETER :: SSqmd70 = 2137 - INTEGER(IntKi), PARAMETER :: SSqmd71 = 2138 - INTEGER(IntKi), PARAMETER :: SSqmd72 = 2139 - INTEGER(IntKi), PARAMETER :: SSqmd73 = 2140 - INTEGER(IntKi), PARAMETER :: SSqmd74 = 2141 - INTEGER(IntKi), PARAMETER :: SSqmd75 = 2142 - INTEGER(IntKi), PARAMETER :: SSqmd76 = 2143 - INTEGER(IntKi), PARAMETER :: SSqmd77 = 2144 - INTEGER(IntKi), PARAMETER :: SSqmd78 = 2145 - INTEGER(IntKi), PARAMETER :: SSqmd79 = 2146 - INTEGER(IntKi), PARAMETER :: SSqmd80 = 2147 - INTEGER(IntKi), PARAMETER :: SSqmd81 = 2148 - INTEGER(IntKi), PARAMETER :: SSqmd82 = 2149 - INTEGER(IntKi), PARAMETER :: SSqmd83 = 2150 - INTEGER(IntKi), PARAMETER :: SSqmd84 = 2151 - INTEGER(IntKi), PARAMETER :: SSqmd85 = 2152 - INTEGER(IntKi), PARAMETER :: SSqmd86 = 2153 - INTEGER(IntKi), PARAMETER :: SSqmd87 = 2154 - INTEGER(IntKi), PARAMETER :: SSqmd88 = 2155 - INTEGER(IntKi), PARAMETER :: SSqmd89 = 2156 - INTEGER(IntKi), PARAMETER :: SSqmd90 = 2157 - INTEGER(IntKi), PARAMETER :: SSqmd91 = 2158 - INTEGER(IntKi), PARAMETER :: SSqmd92 = 2159 - INTEGER(IntKi), PARAMETER :: SSqmd93 = 2160 - INTEGER(IntKi), PARAMETER :: SSqmd94 = 2161 - INTEGER(IntKi), PARAMETER :: SSqmd95 = 2162 - INTEGER(IntKi), PARAMETER :: SSqmd96 = 2163 - INTEGER(IntKi), PARAMETER :: SSqmd97 = 2164 - INTEGER(IntKi), PARAMETER :: SSqmd98 = 2165 - INTEGER(IntKi), PARAMETER :: SSqmd99 = 2166 - INTEGER(IntKi), PARAMETER :: SSqmdd01 = 2167 - INTEGER(IntKi), PARAMETER :: SSqmdd02 = 2168 - INTEGER(IntKi), PARAMETER :: SSqmdd03 = 2169 - INTEGER(IntKi), PARAMETER :: SSqmdd04 = 2170 - INTEGER(IntKi), PARAMETER :: SSqmdd05 = 2171 - INTEGER(IntKi), PARAMETER :: SSqmdd06 = 2172 - INTEGER(IntKi), PARAMETER :: SSqmdd07 = 2173 - INTEGER(IntKi), PARAMETER :: SSqmdd08 = 2174 - INTEGER(IntKi), PARAMETER :: SSqmdd09 = 2175 - INTEGER(IntKi), PARAMETER :: SSqmdd10 = 2176 - INTEGER(IntKi), PARAMETER :: SSqmdd11 = 2177 - INTEGER(IntKi), PARAMETER :: SSqmdd12 = 2178 - INTEGER(IntKi), PARAMETER :: SSqmdd13 = 2179 - INTEGER(IntKi), PARAMETER :: SSqmdd14 = 2180 - INTEGER(IntKi), PARAMETER :: SSqmdd15 = 2181 - INTEGER(IntKi), PARAMETER :: SSqmdd16 = 2182 - INTEGER(IntKi), PARAMETER :: SSqmdd17 = 2183 - INTEGER(IntKi), PARAMETER :: SSqmdd18 = 2184 - INTEGER(IntKi), PARAMETER :: SSqmdd19 = 2185 - INTEGER(IntKi), PARAMETER :: SSqmdd20 = 2186 - INTEGER(IntKi), PARAMETER :: SSqmdd21 = 2187 - INTEGER(IntKi), PARAMETER :: SSqmdd22 = 2188 - INTEGER(IntKi), PARAMETER :: SSqmdd23 = 2189 - INTEGER(IntKi), PARAMETER :: SSqmdd24 = 2190 - INTEGER(IntKi), PARAMETER :: SSqmdd25 = 2191 - INTEGER(IntKi), PARAMETER :: SSqmdd26 = 2192 - INTEGER(IntKi), PARAMETER :: SSqmdd27 = 2193 - INTEGER(IntKi), PARAMETER :: SSqmdd28 = 2194 - INTEGER(IntKi), PARAMETER :: SSqmdd29 = 2195 - INTEGER(IntKi), PARAMETER :: SSqmdd30 = 2196 - INTEGER(IntKi), PARAMETER :: SSqmdd31 = 2197 - INTEGER(IntKi), PARAMETER :: SSqmdd32 = 2198 - INTEGER(IntKi), PARAMETER :: SSqmdd33 = 2199 - INTEGER(IntKi), PARAMETER :: SSqmdd34 = 2200 - INTEGER(IntKi), PARAMETER :: SSqmdd35 = 2201 - INTEGER(IntKi), PARAMETER :: SSqmdd36 = 2202 - INTEGER(IntKi), PARAMETER :: SSqmdd37 = 2203 - INTEGER(IntKi), PARAMETER :: SSqmdd38 = 2204 - INTEGER(IntKi), PARAMETER :: SSqmdd39 = 2205 - INTEGER(IntKi), PARAMETER :: SSqmdd40 = 2206 - INTEGER(IntKi), PARAMETER :: SSqmdd41 = 2207 - INTEGER(IntKi), PARAMETER :: SSqmdd42 = 2208 - INTEGER(IntKi), PARAMETER :: SSqmdd43 = 2209 - INTEGER(IntKi), PARAMETER :: SSqmdd44 = 2210 - INTEGER(IntKi), PARAMETER :: SSqmdd45 = 2211 - INTEGER(IntKi), PARAMETER :: SSqmdd46 = 2212 - INTEGER(IntKi), PARAMETER :: SSqmdd47 = 2213 - INTEGER(IntKi), PARAMETER :: SSqmdd48 = 2214 - INTEGER(IntKi), PARAMETER :: SSqmdd49 = 2215 - INTEGER(IntKi), PARAMETER :: SSqmdd50 = 2216 - INTEGER(IntKi), PARAMETER :: SSqmdd51 = 2217 - INTEGER(IntKi), PARAMETER :: SSqmdd52 = 2218 - INTEGER(IntKi), PARAMETER :: SSqmdd53 = 2219 - INTEGER(IntKi), PARAMETER :: SSqmdd54 = 2220 - INTEGER(IntKi), PARAMETER :: SSqmdd55 = 2221 - INTEGER(IntKi), PARAMETER :: SSqmdd56 = 2222 - INTEGER(IntKi), PARAMETER :: SSqmdd57 = 2223 - INTEGER(IntKi), PARAMETER :: SSqmdd58 = 2224 - INTEGER(IntKi), PARAMETER :: SSqmdd59 = 2225 - INTEGER(IntKi), PARAMETER :: SSqmdd60 = 2226 - INTEGER(IntKi), PARAMETER :: SSqmdd61 = 2227 - INTEGER(IntKi), PARAMETER :: SSqmdd62 = 2228 - INTEGER(IntKi), PARAMETER :: SSqmdd63 = 2229 - INTEGER(IntKi), PARAMETER :: SSqmdd64 = 2230 - INTEGER(IntKi), PARAMETER :: SSqmdd65 = 2231 - INTEGER(IntKi), PARAMETER :: SSqmdd66 = 2232 - INTEGER(IntKi), PARAMETER :: SSqmdd67 = 2233 - INTEGER(IntKi), PARAMETER :: SSqmdd68 = 2234 - INTEGER(IntKi), PARAMETER :: SSqmdd69 = 2235 - INTEGER(IntKi), PARAMETER :: SSqmdd70 = 2236 - INTEGER(IntKi), PARAMETER :: SSqmdd71 = 2237 - INTEGER(IntKi), PARAMETER :: SSqmdd72 = 2238 - INTEGER(IntKi), PARAMETER :: SSqmdd73 = 2239 - INTEGER(IntKi), PARAMETER :: SSqmdd74 = 2240 - INTEGER(IntKi), PARAMETER :: SSqmdd75 = 2241 - INTEGER(IntKi), PARAMETER :: SSqmdd76 = 2242 - INTEGER(IntKi), PARAMETER :: SSqmdd77 = 2243 - INTEGER(IntKi), PARAMETER :: SSqmdd78 = 2244 - INTEGER(IntKi), PARAMETER :: SSqmdd79 = 2245 - INTEGER(IntKi), PARAMETER :: SSqmdd80 = 2246 - INTEGER(IntKi), PARAMETER :: SSqmdd81 = 2247 - INTEGER(IntKi), PARAMETER :: SSqmdd82 = 2248 - INTEGER(IntKi), PARAMETER :: SSqmdd83 = 2249 - INTEGER(IntKi), PARAMETER :: SSqmdd84 = 2250 - INTEGER(IntKi), PARAMETER :: SSqmdd85 = 2251 - INTEGER(IntKi), PARAMETER :: SSqmdd86 = 2252 - INTEGER(IntKi), PARAMETER :: SSqmdd87 = 2253 - INTEGER(IntKi), PARAMETER :: SSqmdd88 = 2254 - INTEGER(IntKi), PARAMETER :: SSqmdd89 = 2255 - INTEGER(IntKi), PARAMETER :: SSqmdd90 = 2256 - INTEGER(IntKi), PARAMETER :: SSqmdd91 = 2257 - INTEGER(IntKi), PARAMETER :: SSqmdd92 = 2258 - INTEGER(IntKi), PARAMETER :: SSqmdd93 = 2259 - INTEGER(IntKi), PARAMETER :: SSqmdd94 = 2260 - INTEGER(IntKi), PARAMETER :: SSqmdd95 = 2261 - INTEGER(IntKi), PARAMETER :: SSqmdd96 = 2262 - INTEGER(IntKi), PARAMETER :: SSqmdd97 = 2263 - INTEGER(IntKi), PARAMETER :: SSqmdd98 = 2264 - INTEGER(IntKi), PARAMETER :: SSqmdd99 = 2265 - - - ! The maximum number of output channels which can be output by the code. - !INTEGER(IntKi), PARAMETER :: MaxOutPts = 2265 - -!End of code generated by Matlab script - - INTEGER, PARAMETER :: MNfmKe(6,9,9) = reshape((/ M1N1FKxe,M1N1FKye,M1N1FKze,M1N1MKxe,M1N1MKye,M1N1MKze, & - M1N2FKxe,M1N2FKye,M1N2FKze,M1N2MKxe,M1N2MKye,M1N2MKze, & - M1N3FKxe,M1N3FKye,M1N3FKze,M1N3MKxe,M1N3MKye,M1N3MKze, & - M1N4FKxe,M1N4FKye,M1N4FKze,M1N4MKxe,M1N4MKye,M1N4MKze, & - M1N5FKxe,M1N5FKye,M1N5FKze,M1N5MKxe,M1N5MKye,M1N5MKze, & - M1N6FKxe,M1N6FKye,M1N6FKze,M1N6MKxe,M1N6MKye,M1N6MKze, & - M1N7FKxe,M1N7FKye,M1N7FKze,M1N7MKxe,M1N7MKye,M1N7MKze, & - M1N8FKxe,M1N8FKye,M1N8FKze,M1N8MKxe,M1N8MKye,M1N8MKze, & - M1N9FKxe,M1N9FKye,M1N9FKze,M1N9MKxe,M1N9MKye,M1N9MKze, & - M2N1FKxe,M2N1FKye,M2N1FKze,M2N1MKxe,M2N1MKye,M2N1MKze, & - M2N2FKxe,M2N2FKye,M2N2FKze,M2N2MKxe,M2N2MKye,M2N2MKze, & - M2N3FKxe,M2N3FKye,M2N3FKze,M2N3MKxe,M2N3MKye,M2N3MKze, & - M2N4FKxe,M2N4FKye,M2N4FKze,M2N4MKxe,M2N4MKye,M2N4MKze, & - M2N5FKxe,M2N5FKye,M2N5FKze,M2N5MKxe,M2N5MKye,M2N5MKze, & - M2N6FKxe,M2N6FKye,M2N6FKze,M2N6MKxe,M2N6MKye,M2N6MKze, & - M2N7FKxe,M2N7FKye,M2N7FKze,M2N7MKxe,M2N7MKye,M2N7MKze, & - M2N8FKxe,M2N8FKye,M2N8FKze,M2N8MKxe,M2N8MKye,M2N8MKze, & - M2N9FKxe,M2N9FKye,M2N9FKze,M2N9MKxe,M2N9MKye,M2N9MKze, & - M3N1FKxe,M3N1FKye,M3N1FKze,M3N1MKxe,M3N1MKye,M3N1MKze, & - M3N2FKxe,M3N2FKye,M3N2FKze,M3N2MKxe,M3N2MKye,M3N2MKze, & - M3N3FKxe,M3N3FKye,M3N3FKze,M3N3MKxe,M3N3MKye,M3N3MKze, & - M3N4FKxe,M3N4FKye,M3N4FKze,M3N4MKxe,M3N4MKye,M3N4MKze, & - M3N5FKxe,M3N5FKye,M3N5FKze,M3N5MKxe,M3N5MKye,M3N5MKze, & - M3N6FKxe,M3N6FKye,M3N6FKze,M3N6MKxe,M3N6MKye,M3N6MKze, & - M3N7FKxe,M3N7FKye,M3N7FKze,M3N7MKxe,M3N7MKye,M3N7MKze, & - M3N8FKxe,M3N8FKye,M3N8FKze,M3N8MKxe,M3N8MKye,M3N8MKze, & - M3N9FKxe,M3N9FKye,M3N9FKze,M3N9MKxe,M3N9MKye,M3N9MKze, & - M4N1FKxe,M4N1FKye,M4N1FKze,M4N1MKxe,M4N1MKye,M4N1MKze, & - M4N2FKxe,M4N2FKye,M4N2FKze,M4N2MKxe,M4N2MKye,M4N2MKze, & - M4N3FKxe,M4N3FKye,M4N3FKze,M4N3MKxe,M4N3MKye,M4N3MKze, & - M4N4FKxe,M4N4FKye,M4N4FKze,M4N4MKxe,M4N4MKye,M4N4MKze, & - M4N5FKxe,M4N5FKye,M4N5FKze,M4N5MKxe,M4N5MKye,M4N5MKze, & - M4N6FKxe,M4N6FKye,M4N6FKze,M4N6MKxe,M4N6MKye,M4N6MKze, & - M4N7FKxe,M4N7FKye,M4N7FKze,M4N7MKxe,M4N7MKye,M4N7MKze, & - M4N8FKxe,M4N8FKye,M4N8FKze,M4N8MKxe,M4N8MKye,M4N8MKze, & - M4N9FKxe,M4N9FKye,M4N9FKze,M4N9MKxe,M4N9MKye,M4N9MKze, & - M5N1FKxe,M5N1FKye,M5N1FKze,M5N1MKxe,M5N1MKye,M5N1MKze, & - M5N2FKxe,M5N2FKye,M5N2FKze,M5N2MKxe,M5N2MKye,M5N2MKze, & - M5N3FKxe,M5N3FKye,M5N3FKze,M5N3MKxe,M5N3MKye,M5N3MKze, & - M5N4FKxe,M5N4FKye,M5N4FKze,M5N4MKxe,M5N4MKye,M5N4MKze, & - M5N5FKxe,M5N5FKye,M5N5FKze,M5N5MKxe,M5N5MKye,M5N5MKze, & - M5N6FKxe,M5N6FKye,M5N6FKze,M5N6MKxe,M5N6MKye,M5N6MKze, & - M5N7FKxe,M5N7FKye,M5N7FKze,M5N7MKxe,M5N7MKye,M5N7MKze, & - M5N8FKxe,M5N8FKye,M5N8FKze,M5N8MKxe,M5N8MKye,M5N8MKze, & - M5N9FKxe,M5N9FKye,M5N9FKze,M5N9MKxe,M5N9MKye,M5N9MKze, & - M6N1FKxe,M6N1FKye,M6N1FKze,M6N1MKxe,M6N1MKye,M6N1MKze, & - M6N2FKxe,M6N2FKye,M6N2FKze,M6N2MKxe,M6N2MKye,M6N2MKze, & - M6N3FKxe,M6N3FKye,M6N3FKze,M6N3MKxe,M6N3MKye,M6N3MKze, & - M6N4FKxe,M6N4FKye,M6N4FKze,M6N4MKxe,M6N4MKye,M6N4MKze, & - M6N5FKxe,M6N5FKye,M6N5FKze,M6N5MKxe,M6N5MKye,M6N5MKze, & - M6N6FKxe,M6N6FKye,M6N6FKze,M6N6MKxe,M6N6MKye,M6N6MKze, & - M6N7FKxe,M6N7FKye,M6N7FKze,M6N7MKxe,M6N7MKye,M6N7MKze, & - M6N8FKxe,M6N8FKye,M6N8FKze,M6N8MKxe,M6N8MKye,M6N8MKze, & - M6N9FKxe,M6N9FKye,M6N9FKze,M6N9MKxe,M6N9MKye,M6N9MKze, & - M7N1FKxe,M7N1FKye,M7N1FKze,M7N1MKxe,M7N1MKye,M7N1MKze, & - M7N2FKxe,M7N2FKye,M7N2FKze,M7N2MKxe,M7N2MKye,M7N2MKze, & - M7N3FKxe,M7N3FKye,M7N3FKze,M7N3MKxe,M7N3MKye,M7N3MKze, & - M7N4FKxe,M7N4FKye,M7N4FKze,M7N4MKxe,M7N4MKye,M7N4MKze, & - M7N5FKxe,M7N5FKye,M7N5FKze,M7N5MKxe,M7N5MKye,M7N5MKze, & - M7N6FKxe,M7N6FKye,M7N6FKze,M7N6MKxe,M7N6MKye,M7N6MKze, & - M7N7FKxe,M7N7FKye,M7N7FKze,M7N7MKxe,M7N7MKye,M7N7MKze, & - M7N8FKxe,M7N8FKye,M7N8FKze,M7N8MKxe,M7N8MKye,M7N8MKze, & - M7N9FKxe,M7N9FKye,M7N9FKze,M7N9MKxe,M7N9MKye,M7N9MKze, & - M8N1FKxe,M8N1FKye,M8N1FKze,M8N1MKxe,M8N1MKye,M8N1MKze, & - M8N2FKxe,M8N2FKye,M8N2FKze,M8N2MKxe,M8N2MKye,M8N2MKze, & - M8N3FKxe,M8N3FKye,M8N3FKze,M8N3MKxe,M8N3MKye,M8N3MKze, & - M8N4FKxe,M8N4FKye,M8N4FKze,M8N4MKxe,M8N4MKye,M8N4MKze, & - M8N5FKxe,M8N5FKye,M8N5FKze,M8N5MKxe,M8N5MKye,M8N5MKze, & - M8N6FKxe,M8N6FKye,M8N6FKze,M8N6MKxe,M8N6MKye,M8N6MKze, & - M8N7FKxe,M8N7FKye,M8N7FKze,M8N7MKxe,M8N7MKye,M8N7MKze, & - M8N8FKxe,M8N8FKye,M8N8FKze,M8N8MKxe,M8N8MKye,M8N8MKze, & - M8N9FKxe,M8N9FKye,M8N9FKze,M8N9MKxe,M8N9MKye,M8N9MKze, & - M9N1FKxe,M9N1FKye,M9N1FKze,M9N1MKxe,M9N1MKye,M9N1MKze, & - M9N2FKxe,M9N2FKye,M9N2FKze,M9N2MKxe,M9N2MKye,M9N2MKze, & - M9N3FKxe,M9N3FKye,M9N3FKze,M9N3MKxe,M9N3MKye,M9N3MKze, & - M9N4FKxe,M9N4FKye,M9N4FKze,M9N4MKxe,M9N4MKye,M9N4MKze, & - M9N5FKxe,M9N5FKye,M9N5FKze,M9N5MKxe,M9N5MKye,M9N5MKze, & - M9N6FKxe,M9N6FKye,M9N6FKze,M9N6MKxe,M9N6MKye,M9N6MKze, & - M9N7FKxe,M9N7FKye,M9N7FKze,M9N7MKxe,M9N7MKye,M9N7MKze, & - M9N8FKxe,M9N8FKye,M9N8FKze,M9N8MKxe,M9N8MKye,M9N8MKze, & - M9N9FKxe,M9N9FKye,M9N9FKze,M9N9MKxe,M9N9MKye,M9N9MKze /),(/6,9,9/)) - - - - INTEGER, PARAMETER :: MNfmMe(6,9,9) = reshape((/ M1N1FMxe,M1N1FMye,M1N1FMze,M1N1MMxe,M1N1MMye,M1N1MMze, & - M1N2FMxe,M1N2FMye,M1N2FMze,M1N2MMxe,M1N2MMye,M1N2MMze, & - M1N3FMxe,M1N3FMye,M1N3FMze,M1N3MMxe,M1N3MMye,M1N3MMze, & - M1N4FMxe,M1N4FMye,M1N4FMze,M1N4MMxe,M1N4MMye,M1N4MMze, & - M1N5FMxe,M1N5FMye,M1N5FMze,M1N5MMxe,M1N5MMye,M1N5MMze, & - M1N6FMxe,M1N6FMye,M1N6FMze,M1N6MMxe,M1N6MMye,M1N6MMze, & - M1N7FMxe,M1N7FMye,M1N7FMze,M1N7MMxe,M1N7MMye,M1N7MMze, & - M1N8FMxe,M1N8FMye,M1N8FMze,M1N8MMxe,M1N8MMye,M1N8MMze, & - M1N9FMxe,M1N9FMye,M1N9FMze,M1N9MMxe,M1N9MMye,M1N9MMze, & - M2N1FMxe,M2N1FMye,M2N1FMze,M2N1MMxe,M2N1MMye,M2N1MMze, & - M2N2FMxe,M2N2FMye,M2N2FMze,M2N2MMxe,M2N2MMye,M2N2MMze, & - M2N3FMxe,M2N3FMye,M2N3FMze,M2N3MMxe,M2N3MMye,M2N3MMze, & - M2N4FMxe,M2N4FMye,M2N4FMze,M2N4MMxe,M2N4MMye,M2N4MMze, & - M2N5FMxe,M2N5FMye,M2N5FMze,M2N5MMxe,M2N5MMye,M2N5MMze, & - M2N6FMxe,M2N6FMye,M2N6FMze,M2N6MMxe,M2N6MMye,M2N6MMze, & - M2N7FMxe,M2N7FMye,M2N7FMze,M2N7MMxe,M2N7MMye,M2N7MMze, & - M2N8FMxe,M2N8FMye,M2N8FMze,M2N8MMxe,M2N8MMye,M2N8MMze, & - M2N9FMxe,M2N9FMye,M2N9FMze,M2N9MMxe,M2N9MMye,M2N9MMze, & - M3N1FMxe,M3N1FMye,M3N1FMze,M3N1MMxe,M3N1MMye,M3N1MMze, & - M3N2FMxe,M3N2FMye,M3N2FMze,M3N2MMxe,M3N2MMye,M3N2MMze, & - M3N3FMxe,M3N3FMye,M3N3FMze,M3N3MMxe,M3N3MMye,M3N3MMze, & - M3N4FMxe,M3N4FMye,M3N4FMze,M3N4MMxe,M3N4MMye,M3N4MMze, & - M3N5FMxe,M3N5FMye,M3N5FMze,M3N5MMxe,M3N5MMye,M3N5MMze, & - M3N6FMxe,M3N6FMye,M3N6FMze,M3N6MMxe,M3N6MMye,M3N6MMze, & - M3N7FMxe,M3N7FMye,M3N7FMze,M3N7MMxe,M3N7MMye,M3N7MMze, & - M3N8FMxe,M3N8FMye,M3N8FMze,M3N8MMxe,M3N8MMye,M3N8MMze, & - M3N9FMxe,M3N9FMye,M3N9FMze,M3N9MMxe,M3N9MMye,M3N9MMze, & - M4N1FMxe,M4N1FMye,M4N1FMze,M4N1MMxe,M4N1MMye,M4N1MMze, & - M4N2FMxe,M4N2FMye,M4N2FMze,M4N2MMxe,M4N2MMye,M4N2MMze, & - M4N3FMxe,M4N3FMye,M4N3FMze,M4N3MMxe,M4N3MMye,M4N3MMze, & - M4N4FMxe,M4N4FMye,M4N4FMze,M4N4MMxe,M4N4MMye,M4N4MMze, & - M4N5FMxe,M4N5FMye,M4N5FMze,M4N5MMxe,M4N5MMye,M4N5MMze, & - M4N6FMxe,M4N6FMye,M4N6FMze,M4N6MMxe,M4N6MMye,M4N6MMze, & - M4N7FMxe,M4N7FMye,M4N7FMze,M4N7MMxe,M4N7MMye,M4N7MMze, & - M4N8FMxe,M4N8FMye,M4N8FMze,M4N8MMxe,M4N8MMye,M4N8MMze, & - M4N9FMxe,M4N9FMye,M4N9FMze,M4N9MMxe,M4N9MMye,M4N9MMze, & - M5N1FMxe,M5N1FMye,M5N1FMze,M5N1MMxe,M5N1MMye,M5N1MMze, & - M5N2FMxe,M5N2FMye,M5N2FMze,M5N2MMxe,M5N2MMye,M5N2MMze, & - M5N3FMxe,M5N3FMye,M5N3FMze,M5N3MMxe,M5N3MMye,M5N3MMze, & - M5N4FMxe,M5N4FMye,M5N4FMze,M5N4MMxe,M5N4MMye,M5N4MMze, & - M5N5FMxe,M5N5FMye,M5N5FMze,M5N5MMxe,M5N5MMye,M5N5MMze, & - M5N6FMxe,M5N6FMye,M5N6FMze,M5N6MMxe,M5N6MMye,M5N6MMze, & - M5N7FMxe,M5N7FMye,M5N7FMze,M5N7MMxe,M5N7MMye,M5N7MMze, & - M5N8FMxe,M5N8FMye,M5N8FMze,M5N8MMxe,M5N8MMye,M5N8MMze, & - M5N9FMxe,M5N9FMye,M5N9FMze,M5N9MMxe,M5N9MMye,M5N9MMze, & - M6N1FMxe,M6N1FMye,M6N1FMze,M6N1MMxe,M6N1MMye,M6N1MMze, & - M6N2FMxe,M6N2FMye,M6N2FMze,M6N2MMxe,M6N2MMye,M6N2MMze, & - M6N3FMxe,M6N3FMye,M6N3FMze,M6N3MMxe,M6N3MMye,M6N3MMze, & - M6N4FMxe,M6N4FMye,M6N4FMze,M6N4MMxe,M6N4MMye,M6N4MMze, & - M6N5FMxe,M6N5FMye,M6N5FMze,M6N5MMxe,M6N5MMye,M6N5MMze, & - M6N6FMxe,M6N6FMye,M6N6FMze,M6N6MMxe,M6N6MMye,M6N6MMze, & - M6N7FMxe,M6N7FMye,M6N7FMze,M6N7MMxe,M6N7MMye,M6N7MMze, & - M6N8FMxe,M6N8FMye,M6N8FMze,M6N8MMxe,M6N8MMye,M6N8MMze, & - M6N9FMxe,M6N9FMye,M6N9FMze,M6N9MMxe,M6N9MMye,M6N9MMze, & - M7N1FMxe,M7N1FMye,M7N1FMze,M7N1MMxe,M7N1MMye,M7N1MMze, & - M7N2FMxe,M7N2FMye,M7N2FMze,M7N2MMxe,M7N2MMye,M7N2MMze, & - M7N3FMxe,M7N3FMye,M7N3FMze,M7N3MMxe,M7N3MMye,M7N3MMze, & - M7N4FMxe,M7N4FMye,M7N4FMze,M7N4MMxe,M7N4MMye,M7N4MMze, & - M7N5FMxe,M7N5FMye,M7N5FMze,M7N5MMxe,M7N5MMye,M7N5MMze, & - M7N6FMxe,M7N6FMye,M7N6FMze,M7N6MMxe,M7N6MMye,M7N6MMze, & - M7N7FMxe,M7N7FMye,M7N7FMze,M7N7MMxe,M7N7MMye,M7N7MMze, & - M7N8FMxe,M7N8FMye,M7N8FMze,M7N8MMxe,M7N8MMye,M7N8MMze, & - M7N9FMxe,M7N9FMye,M7N9FMze,M7N9MMxe,M7N9MMye,M7N9MMze, & - M8N1FMxe,M8N1FMye,M8N1FMze,M8N1MMxe,M8N1MMye,M8N1MMze, & - M8N2FMxe,M8N2FMye,M8N2FMze,M8N2MMxe,M8N2MMye,M8N2MMze, & - M8N3FMxe,M8N3FMye,M8N3FMze,M8N3MMxe,M8N3MMye,M8N3MMze, & - M8N4FMxe,M8N4FMye,M8N4FMze,M8N4MMxe,M8N4MMye,M8N4MMze, & - M8N5FMxe,M8N5FMye,M8N5FMze,M8N5MMxe,M8N5MMye,M8N5MMze, & - M8N6FMxe,M8N6FMye,M8N6FMze,M8N6MMxe,M8N6MMye,M8N6MMze, & - M8N7FMxe,M8N7FMye,M8N7FMze,M8N7MMxe,M8N7MMye,M8N7MMze, & - M8N8FMxe,M8N8FMye,M8N8FMze,M8N8MMxe,M8N8MMye,M8N8MMze, & - M8N9FMxe,M8N9FMye,M8N9FMze,M8N9MMxe,M8N9MMye,M8N9MMze, & - M9N1FMxe,M9N1FMye,M9N1FMze,M9N1MMxe,M9N1MMye,M9N1MMze, & - M9N2FMxe,M9N2FMye,M9N2FMze,M9N2MMxe,M9N2MMye,M9N2MMze, & - M9N3FMxe,M9N3FMye,M9N3FMze,M9N3MMxe,M9N3MMye,M9N3MMze, & - M9N4FMxe,M9N4FMye,M9N4FMze,M9N4MMxe,M9N4MMye,M9N4MMze, & - M9N5FMxe,M9N5FMye,M9N5FMze,M9N5MMxe,M9N5MMye,M9N5MMze, & - M9N6FMxe,M9N6FMye,M9N6FMze,M9N6MMxe,M9N6MMye,M9N6MMze, & - M9N7FMxe,M9N7FMye,M9N7FMze,M9N7MMxe,M9N7MMye,M9N7MMze, & - M9N8FMxe,M9N8FMye,M9N8FMze,M9N8MMxe,M9N8MMye,M9N8MMze, & - M9N9FMxe,M9N9FMye,M9N9FMze,M9N9MMxe,M9N9MMye,M9N9MMze /),(/6,9,9/)) - - INTEGER, PARAMETER :: MNTDss(3,9,9) = reshape((/M1N1TDxss,M1N1TDyss,M1N1TDzss, & - M1N2TDxss,M1N2TDyss,M1N2TDzss, & - M1N3TDxss,M1N3TDyss,M1N3TDzss, & - M1N4TDxss,M1N4TDyss,M1N4TDzss, & - M1N5TDxss,M1N5TDyss,M1N5TDzss, & - M1N6TDxss,M1N6TDyss,M1N6TDzss, & - M1N7TDxss,M1N7TDyss,M1N7TDzss, & - M1N8TDxss,M1N8TDyss,M1N8TDzss, & - M1N9TDxss,M1N9TDyss,M1N9TDzss, & - M2N1TDxss,M2N1TDyss,M2N1TDzss, & - M2N2TDxss,M2N2TDyss,M2N2TDzss, & - M2N3TDxss,M2N3TDyss,M2N3TDzss, & - M2N4TDxss,M2N4TDyss,M2N4TDzss, & - M2N5TDxss,M2N5TDyss,M2N5TDzss, & - M2N6TDxss,M2N6TDyss,M2N6TDzss, & - M2N7TDxss,M2N7TDyss,M2N7TDzss, & - M2N8TDxss,M2N8TDyss,M2N8TDzss, & - M2N9TDxss,M2N9TDyss,M2N9TDzss, & - M3N1TDxss,M3N1TDyss,M3N1TDzss, & - M3N2TDxss,M3N2TDyss,M3N2TDzss, & - M3N3TDxss,M3N3TDyss,M3N3TDzss, & - M3N4TDxss,M3N4TDyss,M3N4TDzss, & - M3N5TDxss,M3N5TDyss,M3N5TDzss, & - M3N6TDxss,M3N6TDyss,M3N6TDzss, & - M3N7TDxss,M3N7TDyss,M3N7TDzss, & - M3N8TDxss,M3N8TDyss,M3N8TDzss, & - M3N9TDxss,M3N9TDyss,M3N9TDzss, & - M4N1TDxss,M4N1TDyss,M4N1TDzss, & - M4N2TDxss,M4N2TDyss,M4N2TDzss, & - M4N3TDxss,M4N3TDyss,M4N3TDzss, & - M4N4TDxss,M4N4TDyss,M4N4TDzss, & - M4N5TDxss,M4N5TDyss,M4N5TDzss, & - M4N6TDxss,M4N6TDyss,M4N6TDzss, & - M4N7TDxss,M4N7TDyss,M4N7TDzss, & - M4N8TDxss,M4N8TDyss,M4N8TDzss, & - M4N9TDxss,M4N9TDyss,M4N9TDzss, & - M5N1TDxss,M5N1TDyss,M5N1TDzss, & - M5N2TDxss,M5N2TDyss,M5N2TDzss, & - M5N3TDxss,M5N3TDyss,M5N3TDzss, & - M5N4TDxss,M5N4TDyss,M5N4TDzss, & - M5N5TDxss,M5N5TDyss,M5N5TDzss, & - M5N6TDxss,M5N6TDyss,M5N6TDzss, & - M5N7TDxss,M5N7TDyss,M5N7TDzss, & - M5N8TDxss,M5N8TDyss,M5N8TDzss, & - M5N9TDxss,M5N9TDyss,M5N9TDzss, & - M6N1TDxss,M6N1TDyss,M6N1TDzss, & - M6N2TDxss,M6N2TDyss,M6N2TDzss, & - M6N3TDxss,M6N3TDyss,M6N3TDzss, & - M6N4TDxss,M6N4TDyss,M6N4TDzss, & - M6N5TDxss,M6N5TDyss,M6N5TDzss, & - M6N6TDxss,M6N6TDyss,M6N6TDzss, & - M6N7TDxss,M6N7TDyss,M6N7TDzss, & - M6N8TDxss,M6N8TDyss,M6N8TDzss, & - M6N9TDxss,M6N9TDyss,M6N9TDzss, & - M7N1TDxss,M7N1TDyss,M7N1TDzss, & - M7N2TDxss,M7N2TDyss,M7N2TDzss, & - M7N3TDxss,M7N3TDyss,M7N3TDzss, & - M7N4TDxss,M7N4TDyss,M7N4TDzss, & - M7N5TDxss,M7N5TDyss,M7N5TDzss, & - M7N6TDxss,M7N6TDyss,M7N6TDzss, & - M7N7TDxss,M7N7TDyss,M7N7TDzss, & - M7N8TDxss,M7N8TDyss,M7N8TDzss, & - M7N9TDxss,M7N9TDyss,M7N9TDzss, & - M8N1TDxss,M8N1TDyss,M8N1TDzss, & - M8N2TDxss,M8N2TDyss,M8N2TDzss, & - M8N3TDxss,M8N3TDyss,M8N3TDzss, & - M8N4TDxss,M8N4TDyss,M8N4TDzss, & - M8N5TDxss,M8N5TDyss,M8N5TDzss, & - M8N6TDxss,M8N6TDyss,M8N6TDzss, & - M8N7TDxss,M8N7TDyss,M8N7TDzss, & - M8N8TDxss,M8N8TDyss,M8N8TDzss, & - M8N9TDxss,M8N9TDyss,M8N9TDzss, & - M9N1TDxss,M9N1TDyss,M9N1TDzss, & - M9N2TDxss,M9N2TDyss,M9N2TDzss, & - M9N3TDxss,M9N3TDyss,M9N3TDzss, & - M9N4TDxss,M9N4TDyss,M9N4TDzss, & - M9N5TDxss,M9N5TDyss,M9N5TDzss, & - M9N6TDxss,M9N6TDyss,M9N6TDzss, & - M9N7TDxss,M9N7TDyss,M9N7TDzss, & - M9N8TDxss,M9N8TDyss,M9N8TDzss, & - M9N9TDxss,M9N9TDyss,M9N9TDzss/), (/3,9,9/)) - -INTEGER, PARAMETER :: MNRDe (3,9,9) = reshape((/M1N1RDxe,M1N1RDye,M1N1RDze, & - M1N2RDxe,M1N2RDye,M1N2RDze, & - M1N3RDxe,M1N3RDye,M1N3RDze, & - M1N4RDxe,M1N4RDye,M1N4RDze, & - M1N5RDxe,M1N5RDye,M1N5RDze, & - M1N6RDxe,M1N6RDye,M1N6RDze, & - M1N7RDxe,M1N7RDye,M1N7RDze, & - M1N8RDxe,M1N8RDye,M1N8RDze, & - M1N9RDxe,M1N9RDye,M1N9RDze, & - M2N1RDxe,M2N1RDye,M2N1RDze, & - M2N2RDxe,M2N2RDye,M2N2RDze, & - M2N3RDxe,M2N3RDye,M2N3RDze, & - M2N4RDxe,M2N4RDye,M2N4RDze, & - M2N5RDxe,M2N5RDye,M2N5RDze, & - M2N6RDxe,M2N6RDye,M2N6RDze, & - M2N7RDxe,M2N7RDye,M2N7RDze, & - M2N8RDxe,M2N8RDye,M2N8RDze, & - M2N9RDxe,M2N9RDye,M2N9RDze, & - M3N1RDxe,M3N1RDye,M3N1RDze, & - M3N2RDxe,M3N2RDye,M3N2RDze, & - M3N3RDxe,M3N3RDye,M3N3RDze, & - M3N4RDxe,M3N4RDye,M3N4RDze, & - M3N5RDxe,M3N5RDye,M3N5RDze, & - M3N6RDxe,M3N6RDye,M3N6RDze, & - M3N7RDxe,M3N7RDye,M3N7RDze, & - M3N8RDxe,M3N8RDye,M3N8RDze, & - M3N9RDxe,M3N9RDye,M3N9RDze, & - M4N1RDxe,M4N1RDye,M4N1RDze, & - M4N2RDxe,M4N2RDye,M4N2RDze, & - M4N3RDxe,M4N3RDye,M4N3RDze, & - M4N4RDxe,M4N4RDye,M4N4RDze, & - M4N5RDxe,M4N5RDye,M4N5RDze, & - M4N6RDxe,M4N6RDye,M4N6RDze, & - M4N7RDxe,M4N7RDye,M4N7RDze, & - M4N8RDxe,M4N8RDye,M4N8RDze, & - M4N9RDxe,M4N9RDye,M4N9RDze, & - M5N1RDxe,M5N1RDye,M5N1RDze, & - M5N2RDxe,M5N2RDye,M5N2RDze, & - M5N3RDxe,M5N3RDye,M5N3RDze, & - M5N4RDxe,M5N4RDye,M5N4RDze, & - M5N5RDxe,M5N5RDye,M5N5RDze, & - M5N6RDxe,M5N6RDye,M5N6RDze, & - M5N7RDxe,M5N7RDye,M5N7RDze, & - M5N8RDxe,M5N8RDye,M5N8RDze, & - M5N9RDxe,M5N9RDye,M5N9RDze, & - M6N1RDxe,M6N1RDye,M6N1RDze, & - M6N2RDxe,M6N2RDye,M6N2RDze, & - M6N3RDxe,M6N3RDye,M6N3RDze, & - M6N4RDxe,M6N4RDye,M6N4RDze, & - M6N5RDxe,M6N5RDye,M6N5RDze, & - M6N6RDxe,M6N6RDye,M6N6RDze, & - M6N7RDxe,M6N7RDye,M6N7RDze, & - M6N8RDxe,M6N8RDye,M6N8RDze, & - M6N9RDxe,M6N9RDye,M6N9RDze, & - M7N1RDxe,M7N1RDye,M7N1RDze, & - M7N2RDxe,M7N2RDye,M7N2RDze, & - M7N3RDxe,M7N3RDye,M7N3RDze, & - M7N4RDxe,M7N4RDye,M7N4RDze, & - M7N5RDxe,M7N5RDye,M7N5RDze, & - M7N6RDxe,M7N6RDye,M7N6RDze, & - M7N7RDxe,M7N7RDye,M7N7RDze, & - M7N8RDxe,M7N8RDye,M7N8RDze, & - M7N9RDxe,M7N9RDye,M7N9RDze, & - M8N1RDxe,M8N1RDye,M8N1RDze, & - M8N2RDxe,M8N2RDye,M8N2RDze, & - M8N3RDxe,M8N3RDye,M8N3RDze, & - M8N4RDxe,M8N4RDye,M8N4RDze, & - M8N5RDxe,M8N5RDye,M8N5RDze, & - M8N6RDxe,M8N6RDye,M8N6RDze, & - M8N7RDxe,M8N7RDye,M8N7RDze, & - M8N8RDxe,M8N8RDye,M8N8RDze, & - M8N9RDxe,M8N9RDye,M8N9RDze, & - M9N1RDxe,M9N1RDye,M9N1RDze, & - M9N2RDxe,M9N2RDye,M9N2RDze, & - M9N3RDxe,M9N3RDye,M9N3RDze, & - M9N4RDxe,M9N4RDye,M9N4RDze, & - M9N5RDxe,M9N5RDye,M9N5RDze, & - M9N6RDxe,M9N6RDye,M9N6RDze, & - M9N7RDxe,M9N7RDye,M9N7RDze, & - M9N8RDxe,M9N8RDye,M9N8RDze, & - M9N9RDxe,M9N9RDye,M9N9RDze/), (/3,9,9/)) - - - INTEGER, PARAMETER :: MNTRAe(6,9,9) = reshape( (/M1N1TAxe,M1N1TAye,M1N1TAze,M1N1RAxe,M1N1RAye,M1N1RAze, & - M1N2TAxe,M1N2TAye,M1N2TAze,M1N2RAxe,M1N2RAye,M1N2RAze, & - M1N3TAxe,M1N3TAye,M1N3TAze,M1N3RAxe,M1N3RAye,M1N3RAze, & - M1N4TAxe,M1N4TAye,M1N4TAze,M1N4RAxe,M1N4RAye,M1N4RAze, & - M1N5TAxe,M1N5TAye,M1N5TAze,M1N5RAxe,M1N5RAye,M1N5RAze, & - M1N6TAxe,M1N6TAye,M1N6TAze,M1N6RAxe,M1N6RAye,M1N6RAze, & - M1N7TAxe,M1N7TAye,M1N7TAze,M1N7RAxe,M1N7RAye,M1N7RAze, & - M1N8TAxe,M1N8TAye,M1N8TAze,M1N8RAxe,M1N8RAye,M1N8RAze, & - M1N9TAxe,M1N9TAye,M1N9TAze,M1N9RAxe,M1N9RAye,M1N9RAze, & - M2N1TAxe,M2N1TAye,M2N1TAze,M2N1RAxe,M2N1RAye,M2N1RAze, & - M2N2TAxe,M2N2TAye,M2N2TAze,M2N2RAxe,M2N2RAye,M2N2RAze, & - M2N3TAxe,M2N3TAye,M2N3TAze,M2N3RAxe,M2N3RAye,M2N3RAze, & - M2N4TAxe,M2N4TAye,M2N4TAze,M2N4RAxe,M2N4RAye,M2N4RAze, & - M2N5TAxe,M2N5TAye,M2N5TAze,M2N5RAxe,M2N5RAye,M2N5RAze, & - M2N6TAxe,M2N6TAye,M2N6TAze,M2N6RAxe,M2N6RAye,M2N6RAze, & - M2N7TAxe,M2N7TAye,M2N7TAze,M2N7RAxe,M2N7RAye,M2N7RAze, & - M2N8TAxe,M2N8TAye,M2N8TAze,M2N8RAxe,M2N8RAye,M2N8RAze, & - M2N9TAxe,M2N9TAye,M2N9TAze,M2N9RAxe,M2N9RAye,M2N9RAze, & - M3N1TAxe,M3N1TAye,M3N1TAze,M3N1RAxe,M3N1RAye,M3N1RAze, & - M3N2TAxe,M3N2TAye,M3N2TAze,M3N2RAxe,M3N2RAye,M3N2RAze, & - M3N3TAxe,M3N3TAye,M3N3TAze,M3N3RAxe,M3N3RAye,M3N3RAze, & - M3N4TAxe,M3N4TAye,M3N4TAze,M3N4RAxe,M3N4RAye,M3N4RAze, & - M3N5TAxe,M3N5TAye,M3N5TAze,M3N5RAxe,M3N5RAye,M3N5RAze, & - M3N6TAxe,M3N6TAye,M3N6TAze,M3N6RAxe,M3N6RAye,M3N6RAze, & - M3N7TAxe,M3N7TAye,M3N7TAze,M3N7RAxe,M3N7RAye,M3N7RAze, & - M3N8TAxe,M3N8TAye,M3N8TAze,M3N8RAxe,M3N8RAye,M3N8RAze, & - M3N9TAxe,M3N9TAye,M3N9TAze,M3N9RAxe,M3N9RAye,M3N9RAze, & - M4N1TAxe,M4N1TAye,M4N1TAze,M4N1RAxe,M4N1RAye,M4N1RAze, & - M4N2TAxe,M4N2TAye,M4N2TAze,M4N2RAxe,M4N2RAye,M4N2RAze, & - M4N3TAxe,M4N3TAye,M4N3TAze,M4N3RAxe,M4N3RAye,M4N3RAze, & - M4N4TAxe,M4N4TAye,M4N4TAze,M4N4RAxe,M4N4RAye,M4N4RAze, & - M4N5TAxe,M4N5TAye,M4N5TAze,M4N5RAxe,M4N5RAye,M4N5RAze, & - M4N6TAxe,M4N6TAye,M4N6TAze,M4N6RAxe,M4N6RAye,M4N6RAze, & - M4N7TAxe,M4N7TAye,M4N7TAze,M4N7RAxe,M4N7RAye,M4N7RAze, & - M4N8TAxe,M4N8TAye,M4N8TAze,M4N8RAxe,M4N8RAye,M4N8RAze, & - M4N9TAxe,M4N9TAye,M4N9TAze,M4N9RAxe,M4N9RAye,M4N9RAze, & - M5N1TAxe,M5N1TAye,M5N1TAze,M5N1RAxe,M5N1RAye,M5N1RAze, & - M5N2TAxe,M5N2TAye,M5N2TAze,M5N2RAxe,M5N2RAye,M5N2RAze, & - M5N3TAxe,M5N3TAye,M5N3TAze,M5N3RAxe,M5N3RAye,M5N3RAze, & - M5N4TAxe,M5N4TAye,M5N4TAze,M5N4RAxe,M5N4RAye,M5N4RAze, & - M5N5TAxe,M5N5TAye,M5N5TAze,M5N5RAxe,M5N5RAye,M5N5RAze, & - M5N6TAxe,M5N6TAye,M5N6TAze,M5N6RAxe,M5N6RAye,M5N6RAze, & - M5N7TAxe,M5N7TAye,M5N7TAze,M5N7RAxe,M5N7RAye,M5N7RAze, & - M5N8TAxe,M5N8TAye,M5N8TAze,M5N8RAxe,M5N8RAye,M5N8RAze, & - M5N9TAxe,M5N9TAye,M5N9TAze,M5N9RAxe,M5N9RAye,M5N9RAze, & - M6N1TAxe,M6N1TAye,M6N1TAze,M6N1RAxe,M6N1RAye,M6N1RAze, & - M6N2TAxe,M6N2TAye,M6N2TAze,M6N2RAxe,M6N2RAye,M6N2RAze, & - M6N3TAxe,M6N3TAye,M6N3TAze,M6N3RAxe,M6N3RAye,M6N3RAze, & - M6N4TAxe,M6N4TAye,M6N4TAze,M6N4RAxe,M6N4RAye,M6N4RAze, & - M6N5TAxe,M6N5TAye,M6N5TAze,M6N5RAxe,M6N5RAye,M6N5RAze, & - M6N6TAxe,M6N6TAye,M6N6TAze,M6N6RAxe,M6N6RAye,M6N6RAze, & - M6N7TAxe,M6N7TAye,M6N7TAze,M6N7RAxe,M6N7RAye,M6N7RAze, & - M6N8TAxe,M6N8TAye,M6N8TAze,M6N8RAxe,M6N8RAye,M6N8RAze, & - M6N9TAxe,M6N9TAye,M6N9TAze,M6N9RAxe,M6N9RAye,M6N9RAze, & - M7N1TAxe,M7N1TAye,M7N1TAze,M7N1RAxe,M7N1RAye,M7N1RAze, & - M7N2TAxe,M7N2TAye,M7N2TAze,M7N2RAxe,M7N2RAye,M7N2RAze, & - M7N3TAxe,M7N3TAye,M7N3TAze,M7N3RAxe,M7N3RAye,M7N3RAze, & - M7N4TAxe,M7N4TAye,M7N4TAze,M7N4RAxe,M7N4RAye,M7N4RAze, & - M7N5TAxe,M7N5TAye,M7N5TAze,M7N5RAxe,M7N5RAye,M7N5RAze, & - M7N6TAxe,M7N6TAye,M7N6TAze,M7N6RAxe,M7N6RAye,M7N6RAze, & - M7N7TAxe,M7N7TAye,M7N7TAze,M7N7RAxe,M7N7RAye,M7N7RAze, & - M7N8TAxe,M7N8TAye,M7N8TAze,M7N8RAxe,M7N8RAye,M7N8RAze, & - M7N9TAxe,M7N9TAye,M7N9TAze,M7N9RAxe,M7N9RAye,M7N9RAze, & - M8N1TAxe,M8N1TAye,M8N1TAze,M8N1RAxe,M8N1RAye,M8N1RAze, & - M8N2TAxe,M8N2TAye,M8N2TAze,M8N2RAxe,M8N2RAye,M8N2RAze, & - M8N3TAxe,M8N3TAye,M8N3TAze,M8N3RAxe,M8N3RAye,M8N3RAze, & - M8N4TAxe,M8N4TAye,M8N4TAze,M8N4RAxe,M8N4RAye,M8N4RAze, & - M8N5TAxe,M8N5TAye,M8N5TAze,M8N5RAxe,M8N5RAye,M8N5RAze, & - M8N6TAxe,M8N6TAye,M8N6TAze,M8N6RAxe,M8N6RAye,M8N6RAze, & - M8N7TAxe,M8N7TAye,M8N7TAze,M8N7RAxe,M8N7RAye,M8N7RAze, & - M8N8TAxe,M8N8TAye,M8N8TAze,M8N8RAxe,M8N8RAye,M8N8RAze, & - M8N9TAxe,M8N9TAye,M8N9TAze,M8N9RAxe,M8N9RAye,M8N9RAze, & - M9N1TAxe,M9N1TAye,M9N1TAze,M9N1RAxe,M9N1RAye,M9N1RAze, & - M9N2TAxe,M9N2TAye,M9N2TAze,M9N2RAxe,M9N2RAye,M9N2RAze, & - M9N3TAxe,M9N3TAye,M9N3TAze,M9N3RAxe,M9N3RAye,M9N3RAze, & - M9N4TAxe,M9N4TAye,M9N4TAze,M9N4RAxe,M9N4RAye,M9N4RAze, & - M9N5TAxe,M9N5TAye,M9N5TAze,M9N5RAxe,M9N5RAye,M9N5RAze, & - M9N6TAxe,M9N6TAye,M9N6TAze,M9N6RAxe,M9N6RAye,M9N6RAze, & - M9N7TAxe,M9N7TAye,M9N7TAze,M9N7RAxe,M9N7RAye,M9N7RAze, & - M9N8TAxe,M9N8TAye,M9N8TAze,M9N8RAxe,M9N8RAye,M9N8RAze, & - M9N9TAxe,M9N9TAye,M9N9TAze,M9N9RAxe,M9N9RAye,M9N9RAze/), (/6,9,9/)) - - INTEGER, PARAMETER :: ReactSS(6) = (/ReactFXss, ReactFYss, ReactFZss , & - ReactMXss, ReactMYss, ReactMZss/) - - INTEGER, PARAMETER :: IntfSS(6) = (/IntfFXss, IntfFYss, IntfFZss , & - IntfMXss, IntfMYss, IntfMZss/) - - - INTEGER, PARAMETER :: IntfTRss(6) = (/IntfTDXss, IntfTDYss, IntfTDZss , & - IntfRDXss, IntfRDYss, IntfRDZss/) - - INTEGER, PARAMETER :: IntfTRAss(6) = (/IntfTAXss, IntfTAYss, IntfTAZss , & - IntfRAXss, IntfRAYss, IntfRAZss/) - - - - - - - - CHARACTER(10), PARAMETER :: ValidParamAry(2265) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically - "INTFFXSS ","INTFFYSS ","INTFFZSS ","INTFMXSS ","INTFMYSS ","INTFMZSS ","INTFRAXSS", & - "INTFRAYSS","INTFRAZSS","INTFRDXSS","INTFRDYSS","INTFRDZSS","INTFTAXSS","INTFTAYSS", & - "INTFTAZSS","INTFTDXSS","INTFTDYSS","INTFTDZSS","M1N1FKXE ","M1N1FKYE ","M1N1FKZE ", & - "M1N1FMXE ","M1N1FMYE ","M1N1FMZE ","M1N1MKXE ","M1N1MKYE ","M1N1MKZE ","M1N1MMXE ", & - "M1N1MMYE ","M1N1MMZE ","M1N1RAXE ","M1N1RAYE ","M1N1RAZE ","M1N1RDXE ","M1N1RDYE ", & - "M1N1RDZE ","M1N1TAXE ","M1N1TAYE ","M1N1TAZE ","M1N1TDXSS","M1N1TDYSS","M1N1TDZSS", & - "M1N2FKXE ","M1N2FKYE ","M1N2FKZE ","M1N2FMXE ","M1N2FMYE ","M1N2FMZE ","M1N2MKXE ", & - "M1N2MKYE ","M1N2MKZE ","M1N2MMXE ","M1N2MMYE ","M1N2MMZE ","M1N2RAXE ","M1N2RAYE ", & - "M1N2RAZE ","M1N2RDXE ","M1N2RDYE ","M1N2RDZE ","M1N2TAXE ","M1N2TAYE ","M1N2TAZE ", & - "M1N2TDXSS","M1N2TDYSS","M1N2TDZSS","M1N3FKXE ","M1N3FKYE ","M1N3FKZE ","M1N3FMXE ", & - "M1N3FMYE ","M1N3FMZE ","M1N3MKXE ","M1N3MKYE ","M1N3MKZE ","M1N3MMXE ","M1N3MMYE ", & - "M1N3MMZE ","M1N3RAXE ","M1N3RAYE ","M1N3RAZE ","M1N3RDXE ","M1N3RDYE ","M1N3RDZE ", & - "M1N3TAXE ","M1N3TAYE ","M1N3TAZE ","M1N3TDXSS","M1N3TDYSS","M1N3TDZSS","M1N4FKXE ", & - "M1N4FKYE ","M1N4FKZE ","M1N4FMXE ","M1N4FMYE ","M1N4FMZE ","M1N4MKXE ","M1N4MKYE ", & - "M1N4MKZE ","M1N4MMXE ","M1N4MMYE ","M1N4MMZE ","M1N4RAXE ","M1N4RAYE ","M1N4RAZE ", & - "M1N4RDXE ","M1N4RDYE ","M1N4RDZE ","M1N4TAXE ","M1N4TAYE ","M1N4TAZE ","M1N4TDXSS", & - "M1N4TDYSS","M1N4TDZSS","M1N5FKXE ","M1N5FKYE ","M1N5FKZE ","M1N5FMXE ","M1N5FMYE ", & - "M1N5FMZE ","M1N5MKXE ","M1N5MKYE ","M1N5MKZE ","M1N5MMXE ","M1N5MMYE ","M1N5MMZE ", & - "M1N5RAXE ","M1N5RAYE ","M1N5RAZE ","M1N5RDXE ","M1N5RDYE ","M1N5RDZE ","M1N5TAXE ", & - "M1N5TAYE ","M1N5TAZE ","M1N5TDXSS","M1N5TDYSS","M1N5TDZSS","M1N6FKXE ","M1N6FKYE ", & - "M1N6FKZE ","M1N6FMXE ","M1N6FMYE ","M1N6FMZE ","M1N6MKXE ","M1N6MKYE ","M1N6MKZE ", & - "M1N6MMXE ","M1N6MMYE ","M1N6MMZE ","M1N6RAXE ","M1N6RAYE ","M1N6RAZE ","M1N6RDXE ", & - "M1N6RDYE ","M1N6RDZE ","M1N6TAXE ","M1N6TAYE ","M1N6TAZE ","M1N6TDXSS","M1N6TDYSS", & - "M1N6TDZSS","M1N7FKXE ","M1N7FKYE ","M1N7FKZE ","M1N7FMXE ","M1N7FMYE ","M1N7FMZE ", & - "M1N7MKXE ","M1N7MKYE ","M1N7MKZE ","M1N7MMXE ","M1N7MMYE ","M1N7MMZE ","M1N7RAXE ", & - "M1N7RAYE ","M1N7RAZE ","M1N7RDXE ","M1N7RDYE ","M1N7RDZE ","M1N7TAXE ","M1N7TAYE ", & - "M1N7TAZE ","M1N7TDXSS","M1N7TDYSS","M1N7TDZSS","M1N8FKXE ","M1N8FKYE ","M1N8FKZE ", & - "M1N8FMXE ","M1N8FMYE ","M1N8FMZE ","M1N8MKXE ","M1N8MKYE ","M1N8MKZE ","M1N8MMXE ", & - "M1N8MMYE ","M1N8MMZE ","M1N8RAXE ","M1N8RAYE ","M1N8RAZE ","M1N8RDXE ","M1N8RDYE ", & - "M1N8RDZE ","M1N8TAXE ","M1N8TAYE ","M1N8TAZE ","M1N8TDXSS","M1N8TDYSS","M1N8TDZSS", & - "M1N9FKXE ","M1N9FKYE ","M1N9FKZE ","M1N9FMXE ","M1N9FMYE ","M1N9FMZE ","M1N9MKXE ", & - "M1N9MKYE ","M1N9MKZE ","M1N9MMXE ","M1N9MMYE ","M1N9MMZE ","M1N9RAXE ","M1N9RAYE ", & - "M1N9RAZE ","M1N9RDXE ","M1N9RDYE ","M1N9RDZE ","M1N9TAXE ","M1N9TAYE ","M1N9TAZE ", & - "M1N9TDXSS","M1N9TDYSS","M1N9TDZSS","M2N1FKXE ","M2N1FKYE ","M2N1FKZE ","M2N1FMXE ", & - "M2N1FMYE ","M2N1FMZE ","M2N1MKXE ","M2N1MKYE ","M2N1MKZE ","M2N1MMXE ","M2N1MMYE ", & - "M2N1MMZE ","M2N1RAXE ","M2N1RAYE ","M2N1RAZE ","M2N1RDXE ","M2N1RDYE ","M2N1RDZE ", & - "M2N1TAXE ","M2N1TAYE ","M2N1TAZE ","M2N1TDXSS","M2N1TDYSS","M2N1TDZSS","M2N2FKXE ", & - "M2N2FKYE ","M2N2FKZE ","M2N2FMXE ","M2N2FMYE ","M2N2FMZE ","M2N2MKXE ","M2N2MKYE ", & - "M2N2MKZE ","M2N2MMXE ","M2N2MMYE ","M2N2MMZE ","M2N2RAXE ","M2N2RAYE ","M2N2RAZE ", & - "M2N2RDXE ","M2N2RDYE ","M2N2RDZE ","M2N2TAXE ","M2N2TAYE ","M2N2TAZE ","M2N2TDXSS", & - "M2N2TDYSS","M2N2TDZSS","M2N3FKXE ","M2N3FKYE ","M2N3FKZE ","M2N3FMXE ","M2N3FMYE ", & - "M2N3FMZE ","M2N3MKXE ","M2N3MKYE ","M2N3MKZE ","M2N3MMXE ","M2N3MMYE ","M2N3MMZE ", & - "M2N3RAXE ","M2N3RAYE ","M2N3RAZE ","M2N3RDXE ","M2N3RDYE ","M2N3RDZE ","M2N3TAXE ", & - "M2N3TAYE ","M2N3TAZE ","M2N3TDXSS","M2N3TDYSS","M2N3TDZSS","M2N4FKXE ","M2N4FKYE ", & - "M2N4FKZE ","M2N4FMXE ","M2N4FMYE ","M2N4FMZE ","M2N4MKXE ","M2N4MKYE ","M2N4MKZE ", & - "M2N4MMXE ","M2N4MMYE ","M2N4MMZE ","M2N4RAXE ","M2N4RAYE ","M2N4RAZE ","M2N4RDXE ", & - "M2N4RDYE ","M2N4RDZE ","M2N4TAXE ","M2N4TAYE ","M2N4TAZE ","M2N4TDXSS","M2N4TDYSS", & - "M2N4TDZSS","M2N5FKXE ","M2N5FKYE ","M2N5FKZE ","M2N5FMXE ","M2N5FMYE ","M2N5FMZE ", & - "M2N5MKXE ","M2N5MKYE ","M2N5MKZE ","M2N5MMXE ","M2N5MMYE ","M2N5MMZE ","M2N5RAXE ", & - "M2N5RAYE ","M2N5RAZE ","M2N5RDXE ","M2N5RDYE ","M2N5RDZE ","M2N5TAXE ","M2N5TAYE ", & - "M2N5TAZE ","M2N5TDXSS","M2N5TDYSS","M2N5TDZSS","M2N6FKXE ","M2N6FKYE ","M2N6FKZE ", & - "M2N6FMXE ","M2N6FMYE ","M2N6FMZE ","M2N6MKXE ","M2N6MKYE ","M2N6MKZE ","M2N6MMXE ", & - "M2N6MMYE ","M2N6MMZE ","M2N6RAXE ","M2N6RAYE ","M2N6RAZE ","M2N6RDXE ","M2N6RDYE ", & - "M2N6RDZE ","M2N6TAXE ","M2N6TAYE ","M2N6TAZE ","M2N6TDXSS","M2N6TDYSS","M2N6TDZSS", & - "M2N7FKXE ","M2N7FKYE ","M2N7FKZE ","M2N7FMXE ","M2N7FMYE ","M2N7FMZE ","M2N7MKXE ", & - "M2N7MKYE ","M2N7MKZE ","M2N7MMXE ","M2N7MMYE ","M2N7MMZE ","M2N7RAXE ","M2N7RAYE ", & - "M2N7RAZE ","M2N7RDXE ","M2N7RDYE ","M2N7RDZE ","M2N7TAXE ","M2N7TAYE ","M2N7TAZE ", & - "M2N7TDXSS","M2N7TDYSS","M2N7TDZSS","M2N8FKXE ","M2N8FKYE ","M2N8FKZE ","M2N8FMXE ", & - "M2N8FMYE ","M2N8FMZE ","M2N8MKXE ","M2N8MKYE ","M2N8MKZE ","M2N8MMXE ","M2N8MMYE ", & - "M2N8MMZE ","M2N8RAXE ","M2N8RAYE ","M2N8RAZE ","M2N8RDXE ","M2N8RDYE ","M2N8RDZE ", & - "M2N8TAXE ","M2N8TAYE ","M2N8TAZE ","M2N8TDXSS","M2N8TDYSS","M2N8TDZSS","M2N9FKXE ", & - "M2N9FKYE ","M2N9FKZE ","M2N9FMXE ","M2N9FMYE ","M2N9FMZE ","M2N9MKXE ","M2N9MKYE ", & - "M2N9MKZE ","M2N9MMXE ","M2N9MMYE ","M2N9MMZE ","M2N9RAXE ","M2N9RAYE ","M2N9RAZE ", & - "M2N9RDXE ","M2N9RDYE ","M2N9RDZE ","M2N9TAXE ","M2N9TAYE ","M2N9TAZE ","M2N9TDXSS", & - "M2N9TDYSS","M2N9TDZSS","M3N1FKXE ","M3N1FKYE ","M3N1FKZE ","M3N1FMXE ","M3N1FMYE ", & - "M3N1FMZE ","M3N1MKXE ","M3N1MKYE ","M3N1MKZE ","M3N1MMXE ","M3N1MMYE ","M3N1MMZE ", & - "M3N1RAXE ","M3N1RAYE ","M3N1RAZE ","M3N1RDXE ","M3N1RDYE ","M3N1RDZE ","M3N1TAXE ", & - "M3N1TAYE ","M3N1TAZE ","M3N1TDXSS","M3N1TDYSS","M3N1TDZSS","M3N2FKXE ","M3N2FKYE ", & - "M3N2FKZE ","M3N2FMXE ","M3N2FMYE ","M3N2FMZE ","M3N2MKXE ","M3N2MKYE ","M3N2MKZE ", & - "M3N2MMXE ","M3N2MMYE ","M3N2MMZE ","M3N2RAXE ","M3N2RAYE ","M3N2RAZE ","M3N2RDXE ", & - "M3N2RDYE ","M3N2RDZE ","M3N2TAXE ","M3N2TAYE ","M3N2TAZE ","M3N2TDXSS","M3N2TDYSS", & - "M3N2TDZSS","M3N3FKXE ","M3N3FKYE ","M3N3FKZE ","M3N3FMXE ","M3N3FMYE ","M3N3FMZE ", & - "M3N3MKXE ","M3N3MKYE ","M3N3MKZE ","M3N3MMXE ","M3N3MMYE ","M3N3MMZE ","M3N3RAXE ", & - "M3N3RAYE ","M3N3RAZE ","M3N3RDXE ","M3N3RDYE ","M3N3RDZE ","M3N3TAXE ","M3N3TAYE ", & - "M3N3TAZE ","M3N3TDXSS","M3N3TDYSS","M3N3TDZSS","M3N4FKXE ","M3N4FKYE ","M3N4FKZE ", & - "M3N4FMXE ","M3N4FMYE ","M3N4FMZE ","M3N4MKXE ","M3N4MKYE ","M3N4MKZE ","M3N4MMXE ", & - "M3N4MMYE ","M3N4MMZE ","M3N4RAXE ","M3N4RAYE ","M3N4RAZE ","M3N4RDXE ","M3N4RDYE ", & - "M3N4RDZE ","M3N4TAXE ","M3N4TAYE ","M3N4TAZE ","M3N4TDXSS","M3N4TDYSS","M3N4TDZSS", & - "M3N5FKXE ","M3N5FKYE ","M3N5FKZE ","M3N5FMXE ","M3N5FMYE ","M3N5FMZE ","M3N5MKXE ", & - "M3N5MKYE ","M3N5MKZE ","M3N5MMXE ","M3N5MMYE ","M3N5MMZE ","M3N5RAXE ","M3N5RAYE ", & - "M3N5RAZE ","M3N5RDXE ","M3N5RDYE ","M3N5RDZE ","M3N5TAXE ","M3N5TAYE ","M3N5TAZE ", & - "M3N5TDXSS","M3N5TDYSS","M3N5TDZSS","M3N6FKXE ","M3N6FKYE ","M3N6FKZE ","M3N6FMXE ", & - "M3N6FMYE ","M3N6FMZE ","M3N6MKXE ","M3N6MKYE ","M3N6MKZE ","M3N6MMXE ","M3N6MMYE ", & - "M3N6MMZE ","M3N6RAXE ","M3N6RAYE ","M3N6RAZE ","M3N6RDXE ","M3N6RDYE ","M3N6RDZE ", & - "M3N6TAXE ","M3N6TAYE ","M3N6TAZE ","M3N6TDXSS","M3N6TDYSS","M3N6TDZSS","M3N7FKXE ", & - "M3N7FKYE ","M3N7FKZE ","M3N7FMXE ","M3N7FMYE ","M3N7FMZE ","M3N7MKXE ","M3N7MKYE ", & - "M3N7MKZE ","M3N7MMXE ","M3N7MMYE ","M3N7MMZE ","M3N7RAXE ","M3N7RAYE ","M3N7RAZE ", & - "M3N7RDXE ","M3N7RDYE ","M3N7RDZE ","M3N7TAXE ","M3N7TAYE ","M3N7TAZE ","M3N7TDXSS", & - "M3N7TDYSS","M3N7TDZSS","M3N8FKXE ","M3N8FKYE ","M3N8FKZE ","M3N8FMXE ","M3N8FMYE ", & - "M3N8FMZE ","M3N8MKXE ","M3N8MKYE ","M3N8MKZE ","M3N8MMXE ","M3N8MMYE ","M3N8MMZE ", & - "M3N8RAXE ","M3N8RAYE ","M3N8RAZE ","M3N8RDXE ","M3N8RDYE ","M3N8RDZE ","M3N8TAXE ", & - "M3N8TAYE ","M3N8TAZE ","M3N8TDXSS","M3N8TDYSS","M3N8TDZSS","M3N9FKXE ","M3N9FKYE ", & - "M3N9FKZE ","M3N9FMXE ","M3N9FMYE ","M3N9FMZE ","M3N9MKXE ","M3N9MKYE ","M3N9MKZE ", & - "M3N9MMXE ","M3N9MMYE ","M3N9MMZE ","M3N9RAXE ","M3N9RAYE ","M3N9RAZE ","M3N9RDXE ", & - "M3N9RDYE ","M3N9RDZE ","M3N9TAXE ","M3N9TAYE ","M3N9TAZE ","M3N9TDXSS","M3N9TDYSS", & - "M3N9TDZSS","M4N1FKXE ","M4N1FKYE ","M4N1FKZE ","M4N1FMXE ","M4N1FMYE ","M4N1FMZE ", & - "M4N1MKXE ","M4N1MKYE ","M4N1MKZE ","M4N1MMXE ","M4N1MMYE ","M4N1MMZE ","M4N1RAXE ", & - "M4N1RAYE ","M4N1RAZE ","M4N1RDXE ","M4N1RDYE ","M4N1RDZE ","M4N1TAXE ","M4N1TAYE ", & - "M4N1TAZE ","M4N1TDXSS","M4N1TDYSS","M4N1TDZSS","M4N2FKXE ","M4N2FKYE ","M4N2FKZE ", & - "M4N2FMXE ","M4N2FMYE ","M4N2FMZE ","M4N2MKXE ","M4N2MKYE ","M4N2MKZE ","M4N2MMXE ", & - "M4N2MMYE ","M4N2MMZE ","M4N2RAXE ","M4N2RAYE ","M4N2RAZE ","M4N2RDXE ","M4N2RDYE ", & - "M4N2RDZE ","M4N2TAXE ","M4N2TAYE ","M4N2TAZE ","M4N2TDXSS","M4N2TDYSS","M4N2TDZSS", & - "M4N3FKXE ","M4N3FKYE ","M4N3FKZE ","M4N3FMXE ","M4N3FMYE ","M4N3FMZE ","M4N3MKXE ", & - "M4N3MKYE ","M4N3MKZE ","M4N3MMXE ","M4N3MMYE ","M4N3MMZE ","M4N3RAXE ","M4N3RAYE ", & - "M4N3RAZE ","M4N3RDXE ","M4N3RDYE ","M4N3RDZE ","M4N3TAXE ","M4N3TAYE ","M4N3TAZE ", & - "M4N3TDXSS","M4N3TDYSS","M4N3TDZSS","M4N4FKXE ","M4N4FKYE ","M4N4FKZE ","M4N4FMXE ", & - "M4N4FMYE ","M4N4FMZE ","M4N4MKXE ","M4N4MKYE ","M4N4MKZE ","M4N4MMXE ","M4N4MMYE ", & - "M4N4MMZE ","M4N4RAXE ","M4N4RAYE ","M4N4RAZE ","M4N4RDXE ","M4N4RDYE ","M4N4RDZE ", & - "M4N4TAXE ","M4N4TAYE ","M4N4TAZE ","M4N4TDXSS","M4N4TDYSS","M4N4TDZSS","M4N5FKXE ", & - "M4N5FKYE ","M4N5FKZE ","M4N5FMXE ","M4N5FMYE ","M4N5FMZE ","M4N5MKXE ","M4N5MKYE ", & - "M4N5MKZE ","M4N5MMXE ","M4N5MMYE ","M4N5MMZE ","M4N5RAXE ","M4N5RAYE ","M4N5RAZE ", & - "M4N5RDXE ","M4N5RDYE ","M4N5RDZE ","M4N5TAXE ","M4N5TAYE ","M4N5TAZE ","M4N5TDXSS", & - "M4N5TDYSS","M4N5TDZSS","M4N6FKXE ","M4N6FKYE ","M4N6FKZE ","M4N6FMXE ","M4N6FMYE ", & - "M4N6FMZE ","M4N6MKXE ","M4N6MKYE ","M4N6MKZE ","M4N6MMXE ","M4N6MMYE ","M4N6MMZE ", & - "M4N6RAXE ","M4N6RAYE ","M4N6RAZE ","M4N6RDXE ","M4N6RDYE ","M4N6RDZE ","M4N6TAXE ", & - "M4N6TAYE ","M4N6TAZE ","M4N6TDXSS","M4N6TDYSS","M4N6TDZSS","M4N7FKXE ","M4N7FKYE ", & - "M4N7FKZE ","M4N7FMXE ","M4N7FMYE ","M4N7FMZE ","M4N7MKXE ","M4N7MKYE ","M4N7MKZE ", & - "M4N7MMXE ","M4N7MMYE ","M4N7MMZE ","M4N7RAXE ","M4N7RAYE ","M4N7RAZE ","M4N7RDXE ", & - "M4N7RDYE ","M4N7RDZE ","M4N7TAXE ","M4N7TAYE ","M4N7TAZE ","M4N7TDXSS","M4N7TDYSS", & - "M4N7TDZSS","M4N8FKXE ","M4N8FKYE ","M4N8FKZE ","M4N8FMXE ","M4N8FMYE ","M4N8FMZE ", & - "M4N8MKXE ","M4N8MKYE ","M4N8MKZE ","M4N8MMXE ","M4N8MMYE ","M4N8MMZE ","M4N8RAXE ", & - "M4N8RAYE ","M4N8RAZE ","M4N8RDXE ","M4N8RDYE ","M4N8RDZE ","M4N8TAXE ","M4N8TAYE ", & - "M4N8TAZE ","M4N8TDXSS","M4N8TDYSS","M4N8TDZSS","M4N9FKXE ","M4N9FKYE ","M4N9FKZE ", & - "M4N9FMXE ","M4N9FMYE ","M4N9FMZE ","M4N9MKXE ","M4N9MKYE ","M4N9MKZE ","M4N9MMXE ", & - "M4N9MMYE ","M4N9MMZE ","M4N9RAXE ","M4N9RAYE ","M4N9RAZE ","M4N9RDXE ","M4N9RDYE ", & - "M4N9RDZE ","M4N9TAXE ","M4N9TAYE ","M4N9TAZE ","M4N9TDXSS","M4N9TDYSS","M4N9TDZSS", & - "M5N1FKXE ","M5N1FKYE ","M5N1FKZE ","M5N1FMXE ","M5N1FMYE ","M5N1FMZE ","M5N1MKXE ", & - "M5N1MKYE ","M5N1MKZE ","M5N1MMXE ","M5N1MMYE ","M5N1MMZE ","M5N1RAXE ","M5N1RAYE ", & - "M5N1RAZE ","M5N1RDXE ","M5N1RDYE ","M5N1RDZE ","M5N1TAXE ","M5N1TAYE ","M5N1TAZE ", & - "M5N1TDXSS","M5N1TDYSS","M5N1TDZSS","M5N2FKXE ","M5N2FKYE ","M5N2FKZE ","M5N2FMXE ", & - "M5N2FMYE ","M5N2FMZE ","M5N2MKXE ","M5N2MKYE ","M5N2MKZE ","M5N2MMXE ","M5N2MMYE ", & - "M5N2MMZE ","M5N2RAXE ","M5N2RAYE ","M5N2RAZE ","M5N2RDXE ","M5N2RDYE ","M5N2RDZE ", & - "M5N2TAXE ","M5N2TAYE ","M5N2TAZE ","M5N2TDXSS","M5N2TDYSS","M5N2TDZSS","M5N3FKXE ", & - "M5N3FKYE ","M5N3FKZE ","M5N3FMXE ","M5N3FMYE ","M5N3FMZE ","M5N3MKXE ","M5N3MKYE ", & - "M5N3MKZE ","M5N3MMXE ","M5N3MMYE ","M5N3MMZE ","M5N3RAXE ","M5N3RAYE ","M5N3RAZE ", & - "M5N3RDXE ","M5N3RDYE ","M5N3RDZE ","M5N3TAXE ","M5N3TAYE ","M5N3TAZE ","M5N3TDXSS", & - "M5N3TDYSS","M5N3TDZSS","M5N4FKXE ","M5N4FKYE ","M5N4FKZE ","M5N4FMXE ","M5N4FMYE ", & - "M5N4FMZE ","M5N4MKXE ","M5N4MKYE ","M5N4MKZE ","M5N4MMXE ","M5N4MMYE ","M5N4MMZE ", & - "M5N4RAXE ","M5N4RAYE ","M5N4RAZE ","M5N4RDXE ","M5N4RDYE ","M5N4RDZE ","M5N4TAXE ", & - "M5N4TAYE ","M5N4TAZE ","M5N4TDXSS","M5N4TDYSS","M5N4TDZSS","M5N5FKXE ","M5N5FKYE ", & - "M5N5FKZE ","M5N5FMXE ","M5N5FMYE ","M5N5FMZE ","M5N5MKXE ","M5N5MKYE ","M5N5MKZE ", & - "M5N5MMXE ","M5N5MMYE ","M5N5MMZE ","M5N5RAXE ","M5N5RAYE ","M5N5RAZE ","M5N5RDXE ", & - "M5N5RDYE ","M5N5RDZE ","M5N5TAXE ","M5N5TAYE ","M5N5TAZE ","M5N5TDXSS","M5N5TDYSS", & - "M5N5TDZSS","M5N6FKXE ","M5N6FKYE ","M5N6FKZE ","M5N6FMXE ","M5N6FMYE ","M5N6FMZE ", & - "M5N6MKXE ","M5N6MKYE ","M5N6MKZE ","M5N6MMXE ","M5N6MMYE ","M5N6MMZE ","M5N6RAXE ", & - "M5N6RAYE ","M5N6RAZE ","M5N6RDXE ","M5N6RDYE ","M5N6RDZE ","M5N6TAXE ","M5N6TAYE ", & - "M5N6TAZE ","M5N6TDXSS","M5N6TDYSS","M5N6TDZSS","M5N7FKXE ","M5N7FKYE ","M5N7FKZE ", & - "M5N7FMXE ","M5N7FMYE ","M5N7FMZE ","M5N7MKXE ","M5N7MKYE ","M5N7MKZE ","M5N7MMXE ", & - "M5N7MMYE ","M5N7MMZE ","M5N7RAXE ","M5N7RAYE ","M5N7RAZE ","M5N7RDXE ","M5N7RDYE ", & - "M5N7RDZE ","M5N7TAXE ","M5N7TAYE ","M5N7TAZE ","M5N7TDXSS","M5N7TDYSS","M5N7TDZSS", & - "M5N8FKXE ","M5N8FKYE ","M5N8FKZE ","M5N8FMXE ","M5N8FMYE ","M5N8FMZE ","M5N8MKXE ", & - "M5N8MKYE ","M5N8MKZE ","M5N8MMXE ","M5N8MMYE ","M5N8MMZE ","M5N8RAXE ","M5N8RAYE ", & - "M5N8RAZE ","M5N8RDXE ","M5N8RDYE ","M5N8RDZE ","M5N8TAXE ","M5N8TAYE ","M5N8TAZE ", & - "M5N8TDXSS","M5N8TDYSS","M5N8TDZSS","M5N9FKXE ","M5N9FKYE ","M5N9FKZE ","M5N9FMXE ", & - "M5N9FMYE ","M5N9FMZE ","M5N9MKXE ","M5N9MKYE ","M5N9MKZE ","M5N9MMXE ","M5N9MMYE ", & - "M5N9MMZE ","M5N9RAXE ","M5N9RAYE ","M5N9RAZE ","M5N9RDXE ","M5N9RDYE ","M5N9RDZE ", & - "M5N9TAXE ","M5N9TAYE ","M5N9TAZE ","M5N9TDXSS","M5N9TDYSS","M5N9TDZSS","M6N1FKXE ", & - "M6N1FKYE ","M6N1FKZE ","M6N1FMXE ","M6N1FMYE ","M6N1FMZE ","M6N1MKXE ","M6N1MKYE ", & - "M6N1MKZE ","M6N1MMXE ","M6N1MMYE ","M6N1MMZE ","M6N1RAXE ","M6N1RAYE ","M6N1RAZE ", & - "M6N1RDXE ","M6N1RDYE ","M6N1RDZE ","M6N1TAXE ","M6N1TAYE ","M6N1TAZE ","M6N1TDXSS", & - "M6N1TDYSS","M6N1TDZSS","M6N2FKXE ","M6N2FKYE ","M6N2FKZE ","M6N2FMXE ","M6N2FMYE ", & - "M6N2FMZE ","M6N2MKXE ","M6N2MKYE ","M6N2MKZE ","M6N2MMXE ","M6N2MMYE ","M6N2MMZE ", & - "M6N2RAXE ","M6N2RAYE ","M6N2RAZE ","M6N2RDXE ","M6N2RDYE ","M6N2RDZE ","M6N2TAXE ", & - "M6N2TAYE ","M6N2TAZE ","M6N2TDXSS","M6N2TDYSS","M6N2TDZSS","M6N3FKXE ","M6N3FKYE ", & - "M6N3FKZE ","M6N3FMXE ","M6N3FMYE ","M6N3FMZE ","M6N3MKXE ","M6N3MKYE ","M6N3MKZE ", & - "M6N3MMXE ","M6N3MMYE ","M6N3MMZE ","M6N3RAXE ","M6N3RAYE ","M6N3RAZE ","M6N3RDXE ", & - "M6N3RDYE ","M6N3RDZE ","M6N3TAXE ","M6N3TAYE ","M6N3TAZE ","M6N3TDXSS","M6N3TDYSS", & - "M6N3TDZSS","M6N4FKXE ","M6N4FKYE ","M6N4FKZE ","M6N4FMXE ","M6N4FMYE ","M6N4FMZE ", & - "M6N4MKXE ","M6N4MKYE ","M6N4MKZE ","M6N4MMXE ","M6N4MMYE ","M6N4MMZE ","M6N4RAXE ", & - "M6N4RAYE ","M6N4RAZE ","M6N4RDXE ","M6N4RDYE ","M6N4RDZE ","M6N4TAXE ","M6N4TAYE ", & - "M6N4TAZE ","M6N4TDXSS","M6N4TDYSS","M6N4TDZSS","M6N5FKXE ","M6N5FKYE ","M6N5FKZE ", & - "M6N5FMXE ","M6N5FMYE ","M6N5FMZE ","M6N5MKXE ","M6N5MKYE ","M6N5MKZE ","M6N5MMXE ", & - "M6N5MMYE ","M6N5MMZE ","M6N5RAXE ","M6N5RAYE ","M6N5RAZE ","M6N5RDXE ","M6N5RDYE ", & - "M6N5RDZE ","M6N5TAXE ","M6N5TAYE ","M6N5TAZE ","M6N5TDXSS","M6N5TDYSS","M6N5TDZSS", & - "M6N6FKXE ","M6N6FKYE ","M6N6FKZE ","M6N6FMXE ","M6N6FMYE ","M6N6FMZE ","M6N6MKXE ", & - "M6N6MKYE ","M6N6MKZE ","M6N6MMXE ","M6N6MMYE ","M6N6MMZE ","M6N6RAXE ","M6N6RAYE ", & - "M6N6RAZE ","M6N6RDXE ","M6N6RDYE ","M6N6RDZE ","M6N6TAXE ","M6N6TAYE ","M6N6TAZE ", & - "M6N6TDXSS","M6N6TDYSS","M6N6TDZSS","M6N7FKXE ","M6N7FKYE ","M6N7FKZE ","M6N7FMXE ", & - "M6N7FMYE ","M6N7FMZE ","M6N7MKXE ","M6N7MKYE ","M6N7MKZE ","M6N7MMXE ","M6N7MMYE ", & - "M6N7MMZE ","M6N7RAXE ","M6N7RAYE ","M6N7RAZE ","M6N7RDXE ","M6N7RDYE ","M6N7RDZE ", & - "M6N7TAXE ","M6N7TAYE ","M6N7TAZE ","M6N7TDXSS","M6N7TDYSS","M6N7TDZSS","M6N8FKXE ", & - "M6N8FKYE ","M6N8FKZE ","M6N8FMXE ","M6N8FMYE ","M6N8FMZE ","M6N8MKXE ","M6N8MKYE ", & - "M6N8MKZE ","M6N8MMXE ","M6N8MMYE ","M6N8MMZE ","M6N8RAXE ","M6N8RAYE ","M6N8RAZE ", & - "M6N8RDXE ","M6N8RDYE ","M6N8RDZE ","M6N8TAXE ","M6N8TAYE ","M6N8TAZE ","M6N8TDXSS", & - "M6N8TDYSS","M6N8TDZSS","M6N9FKXE ","M6N9FKYE ","M6N9FKZE ","M6N9FMXE ","M6N9FMYE ", & - "M6N9FMZE ","M6N9MKXE ","M6N9MKYE ","M6N9MKZE ","M6N9MMXE ","M6N9MMYE ","M6N9MMZE ", & - "M6N9RAXE ","M6N9RAYE ","M6N9RAZE ","M6N9RDXE ","M6N9RDYE ","M6N9RDZE ","M6N9TAXE ", & - "M6N9TAYE ","M6N9TAZE ","M6N9TDXSS","M6N9TDYSS","M6N9TDZSS","M7N1FKXE ","M7N1FKYE ", & - "M7N1FKZE ","M7N1FMXE ","M7N1FMYE ","M7N1FMZE ","M7N1MKXE ","M7N1MKYE ","M7N1MKZE ", & - "M7N1MMXE ","M7N1MMYE ","M7N1MMZE ","M7N1RAXE ","M7N1RAYE ","M7N1RAZE ","M7N1RDXE ", & - "M7N1RDYE ","M7N1RDZE ","M7N1TAXE ","M7N1TAYE ","M7N1TAZE ","M7N1TDXSS","M7N1TDYSS", & - "M7N1TDZSS","M7N2FKXE ","M7N2FKYE ","M7N2FKZE ","M7N2FMXE ","M7N2FMYE ","M7N2FMZE ", & - "M7N2MKXE ","M7N2MKYE ","M7N2MKZE ","M7N2MMXE ","M7N2MMYE ","M7N2MMZE ","M7N2RAXE ", & - "M7N2RAYE ","M7N2RAZE ","M7N2RDXE ","M7N2RDYE ","M7N2RDZE ","M7N2TAXE ","M7N2TAYE ", & - "M7N2TAZE ","M7N2TDXSS","M7N2TDYSS","M7N2TDZSS","M7N3FKXE ","M7N3FKYE ","M7N3FKZE ", & - "M7N3FMXE ","M7N3FMYE ","M7N3FMZE ","M7N3MKXE ","M7N3MKYE ","M7N3MKZE ","M7N3MMXE ", & - "M7N3MMYE ","M7N3MMZE ","M7N3RAXE ","M7N3RAYE ","M7N3RAZE ","M7N3RDXE ","M7N3RDYE ", & - "M7N3RDZE ","M7N3TAXE ","M7N3TAYE ","M7N3TAZE ","M7N3TDXSS","M7N3TDYSS","M7N3TDZSS", & - "M7N4FKXE ","M7N4FKYE ","M7N4FKZE ","M7N4FMXE ","M7N4FMYE ","M7N4FMZE ","M7N4MKXE ", & - "M7N4MKYE ","M7N4MKZE ","M7N4MMXE ","M7N4MMYE ","M7N4MMZE ","M7N4RAXE ","M7N4RAYE ", & - "M7N4RAZE ","M7N4RDXE ","M7N4RDYE ","M7N4RDZE ","M7N4TAXE ","M7N4TAYE ","M7N4TAZE ", & - "M7N4TDXSS","M7N4TDYSS","M7N4TDZSS","M7N5FKXE ","M7N5FKYE ","M7N5FKZE ","M7N5FMXE ", & - "M7N5FMYE ","M7N5FMZE ","M7N5MKXE ","M7N5MKYE ","M7N5MKZE ","M7N5MMXE ","M7N5MMYE ", & - "M7N5MMZE ","M7N5RAXE ","M7N5RAYE ","M7N5RAZE ","M7N5RDXE ","M7N5RDYE ","M7N5RDZE ", & - "M7N5TAXE ","M7N5TAYE ","M7N5TAZE ","M7N5TDXSS","M7N5TDYSS","M7N5TDZSS","M7N6FKXE ", & - "M7N6FKYE ","M7N6FKZE ","M7N6FMXE ","M7N6FMYE ","M7N6FMZE ","M7N6MKXE ","M7N6MKYE ", & - "M7N6MKZE ","M7N6MMXE ","M7N6MMYE ","M7N6MMZE ","M7N6RAXE ","M7N6RAYE ","M7N6RAZE ", & - "M7N6RDXE ","M7N6RDYE ","M7N6RDZE ","M7N6TAXE ","M7N6TAYE ","M7N6TAZE ","M7N6TDXSS", & - "M7N6TDYSS","M7N6TDZSS","M7N7FKXE ","M7N7FKYE ","M7N7FKZE ","M7N7FMXE ","M7N7FMYE ", & - "M7N7FMZE ","M7N7MKXE ","M7N7MKYE ","M7N7MKZE ","M7N7MMXE ","M7N7MMYE ","M7N7MMZE ", & - "M7N7RAXE ","M7N7RAYE ","M7N7RAZE ","M7N7RDXE ","M7N7RDYE ","M7N7RDZE ","M7N7TAXE ", & - "M7N7TAYE ","M7N7TAZE ","M7N7TDXSS","M7N7TDYSS","M7N7TDZSS","M7N8FKXE ","M7N8FKYE ", & - "M7N8FKZE ","M7N8FMXE ","M7N8FMYE ","M7N8FMZE ","M7N8MKXE ","M7N8MKYE ","M7N8MKZE ", & - "M7N8MMXE ","M7N8MMYE ","M7N8MMZE ","M7N8RAXE ","M7N8RAYE ","M7N8RAZE ","M7N8RDXE ", & - "M7N8RDYE ","M7N8RDZE ","M7N8TAXE ","M7N8TAYE ","M7N8TAZE ","M7N8TDXSS","M7N8TDYSS", & - "M7N8TDZSS","M7N9FKXE ","M7N9FKYE ","M7N9FKZE ","M7N9FMXE ","M7N9FMYE ","M7N9FMZE ", & - "M7N9MKXE ","M7N9MKYE ","M7N9MKZE ","M7N9MMXE ","M7N9MMYE ","M7N9MMZE ","M7N9RAXE ", & - "M7N9RAYE ","M7N9RAZE ","M7N9RDXE ","M7N9RDYE ","M7N9RDZE ","M7N9TAXE ","M7N9TAYE ", & - "M7N9TAZE ","M7N9TDXSS","M7N9TDYSS","M7N9TDZSS","M8N1FKXE ","M8N1FKYE ","M8N1FKZE ", & - "M8N1FMXE ","M8N1FMYE ","M8N1FMZE ","M8N1MKXE ","M8N1MKYE ","M8N1MKZE ","M8N1MMXE ", & - "M8N1MMYE ","M8N1MMZE ","M8N1RAXE ","M8N1RAYE ","M8N1RAZE ","M8N1RDXE ","M8N1RDYE ", & - "M8N1RDZE ","M8N1TAXE ","M8N1TAYE ","M8N1TAZE ","M8N1TDXSS","M8N1TDYSS","M8N1TDZSS", & - "M8N2FKXE ","M8N2FKYE ","M8N2FKZE ","M8N2FMXE ","M8N2FMYE ","M8N2FMZE ","M8N2MKXE ", & - "M8N2MKYE ","M8N2MKZE ","M8N2MMXE ","M8N2MMYE ","M8N2MMZE ","M8N2RAXE ","M8N2RAYE ", & - "M8N2RAZE ","M8N2RDXE ","M8N2RDYE ","M8N2RDZE ","M8N2TAXE ","M8N2TAYE ","M8N2TAZE ", & - "M8N2TDXSS","M8N2TDYSS","M8N2TDZSS","M8N3FKXE ","M8N3FKYE ","M8N3FKZE ","M8N3FMXE ", & - "M8N3FMYE ","M8N3FMZE ","M8N3MKXE ","M8N3MKYE ","M8N3MKZE ","M8N3MMXE ","M8N3MMYE ", & - "M8N3MMZE ","M8N3RAXE ","M8N3RAYE ","M8N3RAZE ","M8N3RDXE ","M8N3RDYE ","M8N3RDZE ", & - "M8N3TAXE ","M8N3TAYE ","M8N3TAZE ","M8N3TDXSS","M8N3TDYSS","M8N3TDZSS","M8N4FKXE ", & - "M8N4FKYE ","M8N4FKZE ","M8N4FMXE ","M8N4FMYE ","M8N4FMZE ","M8N4MKXE ","M8N4MKYE ", & - "M8N4MKZE ","M8N4MMXE ","M8N4MMYE ","M8N4MMZE ","M8N4RAXE ","M8N4RAYE ","M8N4RAZE ", & - "M8N4RDXE ","M8N4RDYE ","M8N4RDZE ","M8N4TAXE ","M8N4TAYE ","M8N4TAZE ","M8N4TDXSS", & - "M8N4TDYSS","M8N4TDZSS","M8N5FKXE ","M8N5FKYE ","M8N5FKZE ","M8N5FMXE ","M8N5FMYE ", & - "M8N5FMZE ","M8N5MKXE ","M8N5MKYE ","M8N5MKZE ","M8N5MMXE ","M8N5MMYE ","M8N5MMZE ", & - "M8N5RAXE ","M8N5RAYE ","M8N5RAZE ","M8N5RDXE ","M8N5RDYE ","M8N5RDZE ","M8N5TAXE ", & - "M8N5TAYE ","M8N5TAZE ","M8N5TDXSS","M8N5TDYSS","M8N5TDZSS","M8N6FKXE ","M8N6FKYE ", & - "M8N6FKZE ","M8N6FMXE ","M8N6FMYE ","M8N6FMZE ","M8N6MKXE ","M8N6MKYE ","M8N6MKZE ", & - "M8N6MMXE ","M8N6MMYE ","M8N6MMZE ","M8N6RAXE ","M8N6RAYE ","M8N6RAZE ","M8N6RDXE ", & - "M8N6RDYE ","M8N6RDZE ","M8N6TAXE ","M8N6TAYE ","M8N6TAZE ","M8N6TDXSS","M8N6TDYSS", & - "M8N6TDZSS","M8N7FKXE ","M8N7FKYE ","M8N7FKZE ","M8N7FMXE ","M8N7FMYE ","M8N7FMZE ", & - "M8N7MKXE ","M8N7MKYE ","M8N7MKZE ","M8N7MMXE ","M8N7MMYE ","M8N7MMZE ","M8N7RAXE ", & - "M8N7RAYE ","M8N7RAZE ","M8N7RDXE ","M8N7RDYE ","M8N7RDZE ","M8N7TAXE ","M8N7TAYE ", & - "M8N7TAZE ","M8N7TDXSS","M8N7TDYSS","M8N7TDZSS","M8N8FKXE ","M8N8FKYE ","M8N8FKZE ", & - "M8N8FMXE ","M8N8FMYE ","M8N8FMZE ","M8N8MKXE ","M8N8MKYE ","M8N8MKZE ","M8N8MMXE ", & - "M8N8MMYE ","M8N8MMZE ","M8N8RAXE ","M8N8RAYE ","M8N8RAZE ","M8N8RDXE ","M8N8RDYE ", & - "M8N8RDZE ","M8N8TAXE ","M8N8TAYE ","M8N8TAZE ","M8N8TDXSS","M8N8TDYSS","M8N8TDZSS", & - "M8N9FKXE ","M8N9FKYE ","M8N9FKZE ","M8N9FMXE ","M8N9FMYE ","M8N9FMZE ","M8N9MKXE ", & - "M8N9MKYE ","M8N9MKZE ","M8N9MMXE ","M8N9MMYE ","M8N9MMZE ","M8N9RAXE ","M8N9RAYE ", & - "M8N9RAZE ","M8N9RDXE ","M8N9RDYE ","M8N9RDZE ","M8N9TAXE ","M8N9TAYE ","M8N9TAZE ", & - "M8N9TDXSS","M8N9TDYSS","M8N9TDZSS","M9N1FKXE ","M9N1FKYE ","M9N1FKZE ","M9N1FMXE ", & - "M9N1FMYE ","M9N1FMZE ","M9N1MKXE ","M9N1MKYE ","M9N1MKZE ","M9N1MMXE ","M9N1MMYE ", & - "M9N1MMZE ","M9N1RAXE ","M9N1RAYE ","M9N1RAZE ","M9N1RDXE ","M9N1RDYE ","M9N1RDZE ", & - "M9N1TAXE ","M9N1TAYE ","M9N1TAZE ","M9N1TDXSS","M9N1TDYSS","M9N1TDZSS","M9N2FKXE ", & - "M9N2FKYE ","M9N2FKZE ","M9N2FMXE ","M9N2FMYE ","M9N2FMZE ","M9N2MKXE ","M9N2MKYE ", & - "M9N2MKZE ","M9N2MMXE ","M9N2MMYE ","M9N2MMZE ","M9N2RAXE ","M9N2RAYE ","M9N2RAZE ", & - "M9N2RDXE ","M9N2RDYE ","M9N2RDZE ","M9N2TAXE ","M9N2TAYE ","M9N2TAZE ","M9N2TDXSS", & - "M9N2TDYSS","M9N2TDZSS","M9N3FKXE ","M9N3FKYE ","M9N3FKZE ","M9N3FMXE ","M9N3FMYE ", & - "M9N3FMZE ","M9N3MKXE ","M9N3MKYE ","M9N3MKZE ","M9N3MMXE ","M9N3MMYE ","M9N3MMZE ", & - "M9N3RAXE ","M9N3RAYE ","M9N3RAZE ","M9N3RDXE ","M9N3RDYE ","M9N3RDZE ","M9N3TAXE ", & - "M9N3TAYE ","M9N3TAZE ","M9N3TDXSS","M9N3TDYSS","M9N3TDZSS","M9N4FKXE ","M9N4FKYE ", & - "M9N4FKZE ","M9N4FMXE ","M9N4FMYE ","M9N4FMZE ","M9N4MKXE ","M9N4MKYE ","M9N4MKZE ", & - "M9N4MMXE ","M9N4MMYE ","M9N4MMZE ","M9N4RAXE ","M9N4RAYE ","M9N4RAZE ","M9N4RDXE ", & - "M9N4RDYE ","M9N4RDZE ","M9N4TAXE ","M9N4TAYE ","M9N4TAZE ","M9N4TDXSS","M9N4TDYSS", & - "M9N4TDZSS","M9N5FKXE ","M9N5FKYE ","M9N5FKZE ","M9N5FMXE ","M9N5FMYE ","M9N5FMZE ", & - "M9N5MKXE ","M9N5MKYE ","M9N5MKZE ","M9N5MMXE ","M9N5MMYE ","M9N5MMZE ","M9N5RAXE ", & - "M9N5RAYE ","M9N5RAZE ","M9N5RDXE ","M9N5RDYE ","M9N5RDZE ","M9N5TAXE ","M9N5TAYE ", & - "M9N5TAZE ","M9N5TDXSS","M9N5TDYSS","M9N5TDZSS","M9N6FKXE ","M9N6FKYE ","M9N6FKZE ", & - "M9N6FMXE ","M9N6FMYE ","M9N6FMZE ","M9N6MKXE ","M9N6MKYE ","M9N6MKZE ","M9N6MMXE ", & - "M9N6MMYE ","M9N6MMZE ","M9N6RAXE ","M9N6RAYE ","M9N6RAZE ","M9N6RDXE ","M9N6RDYE ", & - "M9N6RDZE ","M9N6TAXE ","M9N6TAYE ","M9N6TAZE ","M9N6TDXSS","M9N6TDYSS","M9N6TDZSS", & - "M9N7FKXE ","M9N7FKYE ","M9N7FKZE ","M9N7FMXE ","M9N7FMYE ","M9N7FMZE ","M9N7MKXE ", & - "M9N7MKYE ","M9N7MKZE ","M9N7MMXE ","M9N7MMYE ","M9N7MMZE ","M9N7RAXE ","M9N7RAYE ", & - "M9N7RAZE ","M9N7RDXE ","M9N7RDYE ","M9N7RDZE ","M9N7TAXE ","M9N7TAYE ","M9N7TAZE ", & - "M9N7TDXSS","M9N7TDYSS","M9N7TDZSS","M9N8FKXE ","M9N8FKYE ","M9N8FKZE ","M9N8FMXE ", & - "M9N8FMYE ","M9N8FMZE ","M9N8MKXE ","M9N8MKYE ","M9N8MKZE ","M9N8MMXE ","M9N8MMYE ", & - "M9N8MMZE ","M9N8RAXE ","M9N8RAYE ","M9N8RAZE ","M9N8RDXE ","M9N8RDYE ","M9N8RDZE ", & - "M9N8TAXE ","M9N8TAYE ","M9N8TAZE ","M9N8TDXSS","M9N8TDYSS","M9N8TDZSS","M9N9FKXE ", & - "M9N9FKYE ","M9N9FKZE ","M9N9FMXE ","M9N9FMYE ","M9N9FMZE ","M9N9MKXE ","M9N9MKYE ", & - "M9N9MKZE ","M9N9MMXE ","M9N9MMYE ","M9N9MMZE ","M9N9RAXE ","M9N9RAYE ","M9N9RAZE ", & - "M9N9RDXE ","M9N9RDYE ","M9N9RDZE ","M9N9TAXE ","M9N9TAYE ","M9N9TAZE ","M9N9TDXSS", & - "M9N9TDYSS","M9N9TDZSS","REACTFXSS","REACTFYSS","REACTFZSS","REACTMXSS","REACTMYSS", & - "REACTMZSS","SSQM01 ","SSQM02 ","SSQM03 ","SSQM04 ","SSQM05 ","SSQM06 ", & - "SSQM07 ","SSQM08 ","SSQM09 ","SSQM10 ","SSQM11 ","SSQM12 ","SSQM13 ", & - "SSQM14 ","SSQM15 ","SSQM16 ","SSQM17 ","SSQM18 ","SSQM19 ","SSQM20 ", & - "SSQM21 ","SSQM22 ","SSQM23 ","SSQM24 ","SSQM25 ","SSQM26 ","SSQM27 ", & - "SSQM28 ","SSQM29 ","SSQM30 ","SSQM31 ","SSQM32 ","SSQM33 ","SSQM34 ", & - "SSQM35 ","SSQM36 ","SSQM37 ","SSQM38 ","SSQM39 ","SSQM40 ","SSQM41 ", & - "SSQM42 ","SSQM43 ","SSQM44 ","SSQM45 ","SSQM46 ","SSQM47 ","SSQM48 ", & - "SSQM49 ","SSQM50 ","SSQM51 ","SSQM52 ","SSQM53 ","SSQM54 ","SSQM55 ", & - "SSQM56 ","SSQM57 ","SSQM58 ","SSQM59 ","SSQM60 ","SSQM61 ","SSQM62 ", & - "SSQM63 ","SSQM64 ","SSQM65 ","SSQM66 ","SSQM67 ","SSQM68 ","SSQM69 ", & - "SSQM70 ","SSQM71 ","SSQM72 ","SSQM73 ","SSQM74 ","SSQM75 ","SSQM76 ", & - "SSQM77 ","SSQM78 ","SSQM79 ","SSQM80 ","SSQM81 ","SSQM82 ","SSQM83 ", & - "SSQM84 ","SSQM85 ","SSQM86 ","SSQM87 ","SSQM88 ","SSQM89 ","SSQM90 ", & - "SSQM91 ","SSQM92 ","SSQM93 ","SSQM94 ","SSQM95 ","SSQM96 ","SSQM97 ", & - "SSQM98 ","SSQM99 ","SSQMD01 ","SSQMD02 ","SSQMD03 ","SSQMD04 ","SSQMD05 ", & - "SSQMD06 ","SSQMD07 ","SSQMD08 ","SSQMD09 ","SSQMD10 ","SSQMD11 ","SSQMD12 ", & - "SSQMD13 ","SSQMD14 ","SSQMD15 ","SSQMD16 ","SSQMD17 ","SSQMD18 ","SSQMD19 ", & - "SSQMD20 ","SSQMD21 ","SSQMD22 ","SSQMD23 ","SSQMD24 ","SSQMD25 ","SSQMD26 ", & - "SSQMD27 ","SSQMD28 ","SSQMD29 ","SSQMD30 ","SSQMD31 ","SSQMD32 ","SSQMD33 ", & - "SSQMD34 ","SSQMD35 ","SSQMD36 ","SSQMD37 ","SSQMD38 ","SSQMD39 ","SSQMD40 ", & - "SSQMD41 ","SSQMD42 ","SSQMD43 ","SSQMD44 ","SSQMD45 ","SSQMD46 ","SSQMD47 ", & - "SSQMD48 ","SSQMD49 ","SSQMD50 ","SSQMD51 ","SSQMD52 ","SSQMD53 ","SSQMD54 ", & - "SSQMD55 ","SSQMD56 ","SSQMD57 ","SSQMD58 ","SSQMD59 ","SSQMD60 ","SSQMD61 ", & - "SSQMD62 ","SSQMD63 ","SSQMD64 ","SSQMD65 ","SSQMD66 ","SSQMD67 ","SSQMD68 ", & - "SSQMD69 ","SSQMD70 ","SSQMD71 ","SSQMD72 ","SSQMD73 ","SSQMD74 ","SSQMD75 ", & - "SSQMD76 ","SSQMD77 ","SSQMD78 ","SSQMD79 ","SSQMD80 ","SSQMD81 ","SSQMD82 ", & - "SSQMD83 ","SSQMD84 ","SSQMD85 ","SSQMD86 ","SSQMD87 ","SSQMD88 ","SSQMD89 ", & - "SSQMD90 ","SSQMD91 ","SSQMD92 ","SSQMD93 ","SSQMD94 ","SSQMD95 ","SSQMD96 ", & - "SSQMD97 ","SSQMD98 ","SSQMD99 ","SSQMDD01 ","SSQMDD02 ","SSQMDD03 ","SSQMDD04 ", & - "SSQMDD05 ","SSQMDD06 ","SSQMDD07 ","SSQMDD08 ","SSQMDD09 ","SSQMDD10 ","SSQMDD11 ", & - "SSQMDD12 ","SSQMDD13 ","SSQMDD14 ","SSQMDD15 ","SSQMDD16 ","SSQMDD17 ","SSQMDD18 ", & - "SSQMDD19 ","SSQMDD20 ","SSQMDD21 ","SSQMDD22 ","SSQMDD23 ","SSQMDD24 ","SSQMDD25 ", & - "SSQMDD26 ","SSQMDD27 ","SSQMDD28 ","SSQMDD29 ","SSQMDD30 ","SSQMDD31 ","SSQMDD32 ", & - "SSQMDD33 ","SSQMDD34 ","SSQMDD35 ","SSQMDD36 ","SSQMDD37 ","SSQMDD38 ","SSQMDD39 ", & - "SSQMDD40 ","SSQMDD41 ","SSQMDD42 ","SSQMDD43 ","SSQMDD44 ","SSQMDD45 ","SSQMDD46 ", & - "SSQMDD47 ","SSQMDD48 ","SSQMDD49 ","SSQMDD50 ","SSQMDD51 ","SSQMDD52 ","SSQMDD53 ", & - "SSQMDD54 ","SSQMDD55 ","SSQMDD56 ","SSQMDD57 ","SSQMDD58 ","SSQMDD59 ","SSQMDD60 ", & - "SSQMDD61 ","SSQMDD62 ","SSQMDD63 ","SSQMDD64 ","SSQMDD65 ","SSQMDD66 ","SSQMDD67 ", & - "SSQMDD68 ","SSQMDD69 ","SSQMDD70 ","SSQMDD71 ","SSQMDD72 ","SSQMDD73 ","SSQMDD74 ", & - "SSQMDD75 ","SSQMDD76 ","SSQMDD77 ","SSQMDD78 ","SSQMDD79 ","SSQMDD80 ","SSQMDD81 ", & - "SSQMDD82 ","SSQMDD83 ","SSQMDD84 ","SSQMDD85 ","SSQMDD86 ","SSQMDD87 ","SSQMDD88 ", & - "SSQMDD89 ","SSQMDD90 ","SSQMDD91 ","SSQMDD92 ","SSQMDD93 ","SSQMDD94 ","SSQMDD95 ", & - "SSQMDD96 ","SSQMDD97 ","SSQMDD98 ","SSQMDD99 "/) - INTEGER(IntKi), PARAMETER :: ParamIndxAry(2265) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) - IntfFXss , IntfFYss , IntfFZss , IntfMXss , IntfMYss , IntfMZss , IntfRAXss , & - IntfRAYss , IntfRAZss , IntfRDXss , IntfRDYss , IntfRDZss , IntfTAXss , IntfTAYss , & - IntfTAZss , IntfTDXss , IntfTDYss , IntfTDZss , M1N1FKxe , M1N1FKye , M1N1FKze , & - M1N1FMxe , M1N1FMye , M1N1FMze , M1N1MKxe , M1N1MKye , M1N1MKze , M1N1MMxe , & - M1N1MMye , M1N1MMze , M1N1RAxe , M1N1RAye , M1N1RAze , M1N1RDxe , M1N1RDye , & - M1N1RDze , M1N1TAxe , M1N1TAye , M1N1TAze , M1N1TDxss , M1N1TDyss , M1N1TDzss , & - M1N2FKxe , M1N2FKye , M1N2FKze , M1N2FMxe , M1N2FMye , M1N2FMze , M1N2MKxe , & - M1N2MKye , M1N2MKze , M1N2MMxe , M1N2MMye , M1N2MMze , M1N2RAxe , M1N2RAye , & - M1N2RAze , M1N2RDxe , M1N2RDye , M1N2RDze , M1N2TAxe , M1N2TAye , M1N2TAze , & - M1N2TDxss , M1N2TDyss , M1N2TDzss , M1N3FKxe , M1N3FKye , M1N3FKze , M1N3FMxe , & - M1N3FMye , M1N3FMze , M1N3MKxe , M1N3MKye , M1N3MKze , M1N3MMxe , M1N3MMye , & - M1N3MMze , M1N3RAxe , M1N3RAye , M1N3RAze , M1N3RDxe , M1N3RDye , M1N3RDze , & - M1N3TAxe , M1N3TAye , M1N3TAze , M1N3TDxss , M1N3TDyss , M1N3TDzss , M1N4FKxe , & - M1N4FKye , M1N4FKze , M1N4FMxe , M1N4FMye , M1N4FMze , M1N4MKxe , M1N4MKye , & - M1N4MKze , M1N4MMxe , M1N4MMye , M1N4MMze , M1N4RAxe , M1N4RAye , M1N4RAze , & - M1N4RDxe , M1N4RDye , M1N4RDze , M1N4TAxe , M1N4TAye , M1N4TAze , M1N4TDxss , & - M1N4TDyss , M1N4TDzss , M1N5FKxe , M1N5FKye , M1N5FKze , M1N5FMxe , M1N5FMye , & - M1N5FMze , M1N5MKxe , M1N5MKye , M1N5MKze , M1N5MMxe , M1N5MMye , M1N5MMze , & - M1N5RAxe , M1N5RAye , M1N5RAze , M1N5RDxe , M1N5RDye , M1N5RDze , M1N5TAxe , & - M1N5TAye , M1N5TAze , M1N5TDxss , M1N5TDyss , M1N5TDzss , M1N6FKxe , M1N6FKye , & - M1N6FKze , M1N6FMxe , M1N6FMye , M1N6FMze , M1N6MKxe , M1N6MKye , M1N6MKze , & - M1N6MMxe , M1N6MMye , M1N6MMze , M1N6RAxe , M1N6RAye , M1N6RAze , M1N6RDxe , & - M1N6RDye , M1N6RDze , M1N6TAxe , M1N6TAye , M1N6TAze , M1N6TDxss , M1N6TDyss , & - M1N6TDzss , M1N7FKxe , M1N7FKye , M1N7FKze , M1N7FMxe , M1N7FMye , M1N7FMze , & - M1N7MKxe , M1N7MKye , M1N7MKze , M1N7MMxe , M1N7MMye , M1N7MMze , M1N7RAxe , & - M1N7RAye , M1N7RAze , M1N7RDxe , M1N7RDye , M1N7RDze , M1N7TAxe , M1N7TAye , & - M1N7TAze , M1N7TDxss , M1N7TDyss , M1N7TDzss , M1N8FKxe , M1N8FKye , M1N8FKze , & - M1N8FMxe , M1N8FMye , M1N8FMze , M1N8MKxe , M1N8MKye , M1N8MKze , M1N8MMxe , & - M1N8MMye , M1N8MMze , M1N8RAxe , M1N8RAye , M1N8RAze , M1N8RDxe , M1N8RDye , & - M1N8RDze , M1N8TAxe , M1N8TAye , M1N8TAze , M1N8TDxss , M1N8TDyss , M1N8TDzss , & - M1N9FKxe , M1N9FKye , M1N9FKze , M1N9FMxe , M1N9FMye , M1N9FMze , M1N9MKxe , & - M1N9MKye , M1N9MKze , M1N9MMxe , M1N9MMye , M1N9MMze , M1N9RAxe , M1N9RAye , & - M1N9RAze , M1N9RDxe , M1N9RDye , M1N9RDze , M1N9TAxe , M1N9TAye , M1N9TAze , & - M1N9TDxss , M1N9TDyss , M1N9TDzss , M2N1FKxe , M2N1FKye , M2N1FKze , M2N1FMxe , & - M2N1FMye , M2N1FMze , M2N1MKxe , M2N1MKye , M2N1MKze , M2N1MMxe , M2N1MMye , & - M2N1MMze , M2N1RAxe , M2N1RAye , M2N1RAze , M2N1RDxe , M2N1RDye , M2N1RDze , & - M2N1TAxe , M2N1TAye , M2N1TAze , M2N1TDxss , M2N1TDyss , M2N1TDzss , M2N2FKxe , & - M2N2FKye , M2N2FKze , M2N2FMxe , M2N2FMye , M2N2FMze , M2N2MKxe , M2N2MKye , & - M2N2MKze , M2N2MMxe , M2N2MMye , M2N2MMze , M2N2RAxe , M2N2RAye , M2N2RAze , & - M2N2RDxe , M2N2RDye , M2N2RDze , M2N2TAxe , M2N2TAye , M2N2TAze , M2N2TDxss , & - M2N2TDyss , M2N2TDzss , M2N3FKxe , M2N3FKye , M2N3FKze , M2N3FMxe , M2N3FMye , & - M2N3FMze , M2N3MKxe , M2N3MKye , M2N3MKze , M2N3MMxe , M2N3MMye , M2N3MMze , & - M2N3RAxe , M2N3RAye , M2N3RAze , M2N3RDxe , M2N3RDye , M2N3RDze , M2N3TAxe , & - M2N3TAye , M2N3TAze , M2N3TDxss , M2N3TDyss , M2N3TDzss , M2N4FKxe , M2N4FKye , & - M2N4FKze , M2N4FMxe , M2N4FMye , M2N4FMze , M2N4MKxe , M2N4MKye , M2N4MKze , & - M2N4MMxe , M2N4MMye , M2N4MMze , M2N4RAxe , M2N4RAye , M2N4RAze , M2N4RDxe , & - M2N4RDye , M2N4RDze , M2N4TAxe , M2N4TAye , M2N4TAze , M2N4TDxss , M2N4TDyss , & - M2N4TDzss , M2N5FKxe , M2N5FKye , M2N5FKze , M2N5FMxe , M2N5FMye , M2N5FMze , & - M2N5MKxe , M2N5MKye , M2N5MKze , M2N5MMxe , M2N5MMye , M2N5MMze , M2N5RAxe , & - M2N5RAye , M2N5RAze , M2N5RDxe , M2N5RDye , M2N5RDze , M2N5TAxe , M2N5TAye , & - M2N5TAze , M2N5TDxss , M2N5TDyss , M2N5TDzss , M2N6FKxe , M2N6FKye , M2N6FKze , & - M2N6FMxe , M2N6FMye , M2N6FMze , M2N6MKxe , M2N6MKye , M2N6MKze , M2N6MMxe , & - M2N6MMye , M2N6MMze , M2N6RAxe , M2N6RAye , M2N6RAze , M2N6RDxe , M2N6RDye , & - M2N6RDze , M2N6TAxe , M2N6TAye , M2N6TAze , M2N6TDxss , M2N6TDyss , M2N6TDzss , & - M2N7FKxe , M2N7FKye , M2N7FKze , M2N7FMxe , M2N7FMye , M2N7FMze , M2N7MKxe , & - M2N7MKye , M2N7MKze , M2N7MMxe , M2N7MMye , M2N7MMze , M2N7RAxe , M2N7RAye , & - M2N7RAze , M2N7RDxe , M2N7RDye , M2N7RDze , M2N7TAxe , M2N7TAye , M2N7TAze , & - M2N7TDxss , M2N7TDyss , M2N7TDzss , M2N8FKxe , M2N8FKye , M2N8FKze , M2N8FMxe , & - M2N8FMye , M2N8FMze , M2N8MKxe , M2N8MKye , M2N8MKze , M2N8MMxe , M2N8MMye , & - M2N8MMze , M2N8RAxe , M2N8RAye , M2N8RAze , M2N8RDxe , M2N8RDye , M2N8RDze , & - M2N8TAxe , M2N8TAye , M2N8TAze , M2N8TDxss , M2N8TDyss , M2N8TDzss , M2N9FKxe , & - M2N9FKye , M2N9FKze , M2N9FMxe , M2N9FMye , M2N9FMze , M2N9MKxe , M2N9MKye , & - M2N9MKze , M2N9MMxe , M2N9MMye , M2N9MMze , M2N9RAxe , M2N9RAye , M2N9RAze , & - M2N9RDxe , M2N9RDye , M2N9RDze , M2N9TAxe , M2N9TAye , M2N9TAze , M2N9TDxss , & - M2N9TDyss , M2N9TDzss , M3N1FKxe , M3N1FKye , M3N1FKze , M3N1FMxe , M3N1FMye , & - M3N1FMze , M3N1MKxe , M3N1MKye , M3N1MKze , M3N1MMxe , M3N1MMye , M3N1MMze , & - M3N1RAxe , M3N1RAye , M3N1RAze , M3N1RDxe , M3N1RDye , M3N1RDze , M3N1TAxe , & - M3N1TAye , M3N1TAze , M3N1TDxss , M3N1TDyss , M3N1TDzss , M3N2FKxe , M3N2FKye , & - M3N2FKze , M3N2FMxe , M3N2FMye , M3N2FMze , M3N2MKxe , M3N2MKye , M3N2MKze , & - M3N2MMxe , M3N2MMye , M3N2MMze , M3N2RAxe , M3N2RAye , M3N2RAze , M3N2RDxe , & - M3N2RDye , M3N2RDze , M3N2TAxe , M3N2TAye , M3N2TAze , M3N2TDxss , M3N2TDyss , & - M3N2TDzss , M3N3FKxe , M3N3FKye , M3N3FKze , M3N3FMxe , M3N3FMye , M3N3FMze , & - M3N3MKxe , M3N3MKye , M3N3MKze , M3N3MMxe , M3N3MMye , M3N3MMze , M3N3RAxe , & - M3N3RAye , M3N3RAze , M3N3RDxe , M3N3RDye , M3N3RDze , M3N3TAxe , M3N3TAye , & - M3N3TAze , M3N3TDxss , M3N3TDyss , M3N3TDzss , M3N4FKxe , M3N4FKye , M3N4FKze , & - M3N4FMxe , M3N4FMye , M3N4FMze , M3N4MKxe , M3N4MKye , M3N4MKze , M3N4MMxe , & - M3N4MMye , M3N4MMze , M3N4RAxe , M3N4RAye , M3N4RAze , M3N4RDxe , M3N4RDye , & - M3N4RDze , M3N4TAxe , M3N4TAye , M3N4TAze , M3N4TDxss , M3N4TDyss , M3N4TDzss , & - M3N5FKxe , M3N5FKye , M3N5FKze , M3N5FMxe , M3N5FMye , M3N5FMze , M3N5MKxe , & - M3N5MKye , M3N5MKze , M3N5MMxe , M3N5MMye , M3N5MMze , M3N5RAxe , M3N5RAye , & - M3N5RAze , M3N5RDxe , M3N5RDye , M3N5RDze , M3N5TAxe , M3N5TAye , M3N5TAze , & - M3N5TDxss , M3N5TDyss , M3N5TDzss , M3N6FKxe , M3N6FKye , M3N6FKze , M3N6FMxe , & - M3N6FMye , M3N6FMze , M3N6MKxe , M3N6MKye , M3N6MKze , M3N6MMxe , M3N6MMye , & - M3N6MMze , M3N6RAxe , M3N6RAye , M3N6RAze , M3N6RDxe , M3N6RDye , M3N6RDze , & - M3N6TAxe , M3N6TAye , M3N6TAze , M3N6TDxss , M3N6TDyss , M3N6TDzss , M3N7FKxe , & - M3N7FKye , M3N7FKze , M3N7FMxe , M3N7FMye , M3N7FMze , M3N7MKxe , M3N7MKye , & - M3N7MKze , M3N7MMxe , M3N7MMye , M3N7MMze , M3N7RAxe , M3N7RAye , M3N7RAze , & - M3N7RDxe , M3N7RDye , M3N7RDze , M3N7TAxe , M3N7TAye , M3N7TAze , M3N7TDxss , & - M3N7TDyss , M3N7TDzss , M3N8FKxe , M3N8FKye , M3N8FKze , M3N8FMxe , M3N8FMye , & - M3N8FMze , M3N8MKxe , M3N8MKye , M3N8MKze , M3N8MMxe , M3N8MMye , M3N8MMze , & - M3N8RAxe , M3N8RAye , M3N8RAze , M3N8RDxe , M3N8RDye , M3N8RDze , M3N8TAxe , & - M3N8TAye , M3N8TAze , M3N8TDxss , M3N8TDyss , M3N8TDzss , M3N9FKxe , M3N9FKye , & - M3N9FKze , M3N9FMxe , M3N9FMye , M3N9FMze , M3N9MKxe , M3N9MKye , M3N9MKze , & - M3N9MMxe , M3N9MMye , M3N9MMze , M3N9RAxe , M3N9RAye , M3N9RAze , M3N9RDxe , & - M3N9RDye , M3N9RDze , M3N9TAxe , M3N9TAye , M3N9TAze , M3N9TDxss , M3N9TDyss , & - M3N9TDzss , M4N1FKxe , M4N1FKye , M4N1FKze , M4N1FMxe , M4N1FMye , M4N1FMze , & - M4N1MKxe , M4N1MKye , M4N1MKze , M4N1MMxe , M4N1MMye , M4N1MMze , M4N1RAxe , & - M4N1RAye , M4N1RAze , M4N1RDxe , M4N1RDye , M4N1RDze , M4N1TAxe , M4N1TAye , & - M4N1TAze , M4N1TDxss , M4N1TDyss , M4N1TDzss , M4N2FKxe , M4N2FKye , M4N2FKze , & - M4N2FMxe , M4N2FMye , M4N2FMze , M4N2MKxe , M4N2MKye , M4N2MKze , M4N2MMxe , & - M4N2MMye , M4N2MMze , M4N2RAxe , M4N2RAye , M4N2RAze , M4N2RDxe , M4N2RDye , & - M4N2RDze , M4N2TAxe , M4N2TAye , M4N2TAze , M4N2TDxss , M4N2TDyss , M4N2TDzss , & - M4N3FKxe , M4N3FKye , M4N3FKze , M4N3FMxe , M4N3FMye , M4N3FMze , M4N3MKxe , & - M4N3MKye , M4N3MKze , M4N3MMxe , M4N3MMye , M4N3MMze , M4N3RAxe , M4N3RAye , & - M4N3RAze , M4N3RDxe , M4N3RDye , M4N3RDze , M4N3TAxe , M4N3TAye , M4N3TAze , & - M4N3TDxss , M4N3TDyss , M4N3TDzss , M4N4FKxe , M4N4FKye , M4N4FKze , M4N4FMxe , & - M4N4FMye , M4N4FMze , M4N4MKxe , M4N4MKye , M4N4MKze , M4N4MMxe , M4N4MMye , & - M4N4MMze , M4N4RAxe , M4N4RAye , M4N4RAze , M4N4RDxe , M4N4RDye , M4N4RDze , & - M4N4TAxe , M4N4TAye , M4N4TAze , M4N4TDxss , M4N4TDyss , M4N4TDzss , M4N5FKxe , & - M4N5FKye , M4N5FKze , M4N5FMxe , M4N5FMye , M4N5FMze , M4N5MKxe , M4N5MKye , & - M4N5MKze , M4N5MMxe , M4N5MMye , M4N5MMze , M4N5RAxe , M4N5RAye , M4N5RAze , & - M4N5RDxe , M4N5RDye , M4N5RDze , M4N5TAxe , M4N5TAye , M4N5TAze , M4N5TDxss , & - M4N5TDyss , M4N5TDzss , M4N6FKxe , M4N6FKye , M4N6FKze , M4N6FMxe , M4N6FMye , & - M4N6FMze , M4N6MKxe , M4N6MKye , M4N6MKze , M4N6MMxe , M4N6MMye , M4N6MMze , & - M4N6RAxe , M4N6RAye , M4N6RAze , M4N6RDxe , M4N6RDye , M4N6RDze , M4N6TAxe , & - M4N6TAye , M4N6TAze , M4N6TDxss , M4N6TDyss , M4N6TDzss , M4N7FKxe , M4N7FKye , & - M4N7FKze , M4N7FMxe , M4N7FMye , M4N7FMze , M4N7MKxe , M4N7MKye , M4N7MKze , & - M4N7MMxe , M4N7MMye , M4N7MMze , M4N7RAxe , M4N7RAye , M4N7RAze , M4N7RDxe , & - M4N7RDye , M4N7RDze , M4N7TAxe , M4N7TAye , M4N7TAze , M4N7TDxss , M4N7TDyss , & - M4N7TDzss , M4N8FKxe , M4N8FKye , M4N8FKze , M4N8FMxe , M4N8FMye , M4N8FMze , & - M4N8MKxe , M4N8MKye , M4N8MKze , M4N8MMxe , M4N8MMye , M4N8MMze , M4N8RAxe , & - M4N8RAye , M4N8RAze , M4N8RDxe , M4N8RDye , M4N8RDze , M4N8TAxe , M4N8TAye , & - M4N8TAze , M4N8TDxss , M4N8TDyss , M4N8TDzss , M4N9FKxe , M4N9FKye , M4N9FKze , & - M4N9FMxe , M4N9FMye , M4N9FMze , M4N9MKxe , M4N9MKye , M4N9MKze , M4N9MMxe , & - M4N9MMye , M4N9MMze , M4N9RAxe , M4N9RAye , M4N9RAze , M4N9RDxe , M4N9RDye , & - M4N9RDze , M4N9TAxe , M4N9TAye , M4N9TAze , M4N9TDxss , M4N9TDyss , M4N9TDzss , & - M5N1FKxe , M5N1FKye , M5N1FKze , M5N1FMxe , M5N1FMye , M5N1FMze , M5N1MKxe , & - M5N1MKye , M5N1MKze , M5N1MMxe , M5N1MMye , M5N1MMze , M5N1RAxe , M5N1RAye , & - M5N1RAze , M5N1RDxe , M5N1RDye , M5N1RDze , M5N1TAxe , M5N1TAye , M5N1TAze , & - M5N1TDxss , M5N1TDyss , M5N1TDzss , M5N2FKxe , M5N2FKye , M5N2FKze , M5N2FMxe , & - M5N2FMye , M5N2FMze , M5N2MKxe , M5N2MKye , M5N2MKze , M5N2MMxe , M5N2MMye , & - M5N2MMze , M5N2RAxe , M5N2RAye , M5N2RAze , M5N2RDxe , M5N2RDye , M5N2RDze , & - M5N2TAxe , M5N2TAye , M5N2TAze , M5N2TDxss , M5N2TDyss , M5N2TDzss , M5N3FKxe , & - M5N3FKye , M5N3FKze , M5N3FMxe , M5N3FMye , M5N3FMze , M5N3MKxe , M5N3MKye , & - M5N3MKze , M5N3MMxe , M5N3MMye , M5N3MMze , M5N3RAxe , M5N3RAye , M5N3RAze , & - M5N3RDxe , M5N3RDye , M5N3RDze , M5N3TAxe , M5N3TAye , M5N3TAze , M5N3TDxss , & - M5N3TDyss , M5N3TDzss , M5N4FKxe , M5N4FKye , M5N4FKze , M5N4FMxe , M5N4FMye , & - M5N4FMze , M5N4MKxe , M5N4MKye , M5N4MKze , M5N4MMxe , M5N4MMye , M5N4MMze , & - M5N4RAxe , M5N4RAye , M5N4RAze , M5N4RDxe , M5N4RDye , M5N4RDze , M5N4TAxe , & - M5N4TAye , M5N4TAze , M5N4TDxss , M5N4TDyss , M5N4TDzss , M5N5FKxe , M5N5FKye , & - M5N5FKze , M5N5FMxe , M5N5FMye , M5N5FMze , M5N5MKxe , M5N5MKye , M5N5MKze , & - M5N5MMxe , M5N5MMye , M5N5MMze , M5N5RAxe , M5N5RAye , M5N5RAze , M5N5RDxe , & - M5N5RDye , M5N5RDze , M5N5TAxe , M5N5TAye , M5N5TAze , M5N5TDxss , M5N5TDyss , & - M5N5TDzss , M5N6FKxe , M5N6FKye , M5N6FKze , M5N6FMxe , M5N6FMye , M5N6FMze , & - M5N6MKxe , M5N6MKye , M5N6MKze , M5N6MMxe , M5N6MMye , M5N6MMze , M5N6RAxe , & - M5N6RAye , M5N6RAze , M5N6RDxe , M5N6RDye , M5N6RDze , M5N6TAxe , M5N6TAye , & - M5N6TAze , M5N6TDxss , M5N6TDyss , M5N6TDzss , M5N7FKxe , M5N7FKye , M5N7FKze , & - M5N7FMxe , M5N7FMye , M5N7FMze , M5N7MKxe , M5N7MKye , M5N7MKze , M5N7MMxe , & - M5N7MMye , M5N7MMze , M5N7RAxe , M5N7RAye , M5N7RAze , M5N7RDxe , M5N7RDye , & - M5N7RDze , M5N7TAxe , M5N7TAye , M5N7TAze , M5N7TDxss , M5N7TDyss , M5N7TDzss , & - M5N8FKxe , M5N8FKye , M5N8FKze , M5N8FMxe , M5N8FMye , M5N8FMze , M5N8MKxe , & - M5N8MKye , M5N8MKze , M5N8MMxe , M5N8MMye , M5N8MMze , M5N8RAxe , M5N8RAye , & - M5N8RAze , M5N8RDxe , M5N8RDye , M5N8RDze , M5N8TAxe , M5N8TAye , M5N8TAze , & - M5N8TDxss , M5N8TDyss , M5N8TDzss , M5N9FKxe , M5N9FKye , M5N9FKze , M5N9FMxe , & - M5N9FMye , M5N9FMze , M5N9MKxe , M5N9MKye , M5N9MKze , M5N9MMxe , M5N9MMye , & - M5N9MMze , M5N9RAxe , M5N9RAye , M5N9RAze , M5N9RDxe , M5N9RDye , M5N9RDze , & - M5N9TAxe , M5N9TAye , M5N9TAze , M5N9TDxss , M5N9TDyss , M5N9TDzss , M6N1FKxe , & - M6N1FKye , M6N1FKze , M6N1FMxe , M6N1FMye , M6N1FMze , M6N1MKxe , M6N1MKye , & - M6N1MKze , M6N1MMxe , M6N1MMye , M6N1MMze , M6N1RAxe , M6N1RAye , M6N1RAze , & - M6N1RDxe , M6N1RDye , M6N1RDze , M6N1TAxe , M6N1TAye , M6N1TAze , M6N1TDxss , & - M6N1TDyss , M6N1TDzss , M6N2FKxe , M6N2FKye , M6N2FKze , M6N2FMxe , M6N2FMye , & - M6N2FMze , M6N2MKxe , M6N2MKye , M6N2MKze , M6N2MMxe , M6N2MMye , M6N2MMze , & - M6N2RAxe , M6N2RAye , M6N2RAze , M6N2RDxe , M6N2RDye , M6N2RDze , M6N2TAxe , & - M6N2TAye , M6N2TAze , M6N2TDxss , M6N2TDyss , M6N2TDzss , M6N3FKxe , M6N3FKye , & - M6N3FKze , M6N3FMxe , M6N3FMye , M6N3FMze , M6N3MKxe , M6N3MKye , M6N3MKze , & - M6N3MMxe , M6N3MMye , M6N3MMze , M6N3RAxe , M6N3RAye , M6N3RAze , M6N3RDxe , & - M6N3RDye , M6N3RDze , M6N3TAxe , M6N3TAye , M6N3TAze , M6N3TDxss , M6N3TDyss , & - M6N3TDzss , M6N4FKxe , M6N4FKye , M6N4FKze , M6N4FMxe , M6N4FMye , M6N4FMze , & - M6N4MKxe , M6N4MKye , M6N4MKze , M6N4MMxe , M6N4MMye , M6N4MMze , M6N4RAxe , & - M6N4RAye , M6N4RAze , M6N4RDxe , M6N4RDye , M6N4RDze , M6N4TAxe , M6N4TAye , & - M6N4TAze , M6N4TDxss , M6N4TDyss , M6N4TDzss , M6N5FKxe , M6N5FKye , M6N5FKze , & - M6N5FMxe , M6N5FMye , M6N5FMze , M6N5MKxe , M6N5MKye , M6N5MKze , M6N5MMxe , & - M6N5MMye , M6N5MMze , M6N5RAxe , M6N5RAye , M6N5RAze , M6N5RDxe , M6N5RDye , & - M6N5RDze , M6N5TAxe , M6N5TAye , M6N5TAze , M6N5TDxss , M6N5TDyss , M6N5TDzss , & - M6N6FKxe , M6N6FKye , M6N6FKze , M6N6FMxe , M6N6FMye , M6N6FMze , M6N6MKxe , & - M6N6MKye , M6N6MKze , M6N6MMxe , M6N6MMye , M6N6MMze , M6N6RAxe , M6N6RAye , & - M6N6RAze , M6N6RDxe , M6N6RDye , M6N6RDze , M6N6TAxe , M6N6TAye , M6N6TAze , & - M6N6TDxss , M6N6TDyss , M6N6TDzss , M6N7FKxe , M6N7FKye , M6N7FKze , M6N7FMxe , & - M6N7FMye , M6N7FMze , M6N7MKxe , M6N7MKye , M6N7MKze , M6N7MMxe , M6N7MMye , & - M6N7MMze , M6N7RAxe , M6N7RAye , M6N7RAze , M6N7RDxe , M6N7RDye , M6N7RDze , & - M6N7TAxe , M6N7TAye , M6N7TAze , M6N7TDxss , M6N7TDyss , M6N7TDzss , M6N8FKxe , & - M6N8FKye , M6N8FKze , M6N8FMxe , M6N8FMye , M6N8FMze , M6N8MKxe , M6N8MKye , & - M6N8MKze , M6N8MMxe , M6N8MMye , M6N8MMze , M6N8RAxe , M6N8RAye , M6N8RAze , & - M6N8RDxe , M6N8RDye , M6N8RDze , M6N8TAxe , M6N8TAye , M6N8TAze , M6N8TDxss , & - M6N8TDyss , M6N8TDzss , M6N9FKxe , M6N9FKye , M6N9FKze , M6N9FMxe , M6N9FMye , & - M6N9FMze , M6N9MKxe , M6N9MKye , M6N9MKze , M6N9MMxe , M6N9MMye , M6N9MMze , & - M6N9RAxe , M6N9RAye , M6N9RAze , M6N9RDxe , M6N9RDye , M6N9RDze , M6N9TAxe , & - M6N9TAye , M6N9TAze , M6N9TDxss , M6N9TDyss , M6N9TDzss , M7N1FKxe , M7N1FKye , & - M7N1FKze , M7N1FMxe , M7N1FMye , M7N1FMze , M7N1MKxe , M7N1MKye , M7N1MKze , & - M7N1MMxe , M7N1MMye , M7N1MMze , M7N1RAxe , M7N1RAye , M7N1RAze , M7N1RDxe , & - M7N1RDye , M7N1RDze , M7N1TAxe , M7N1TAye , M7N1TAze , M7N1TDxss , M7N1TDyss , & - M7N1TDzss , M7N2FKxe , M7N2FKye , M7N2FKze , M7N2FMxe , M7N2FMye , M7N2FMze , & - M7N2MKxe , M7N2MKye , M7N2MKze , M7N2MMxe , M7N2MMye , M7N2MMze , M7N2RAxe , & - M7N2RAye , M7N2RAze , M7N2RDxe , M7N2RDye , M7N2RDze , M7N2TAxe , M7N2TAye , & - M7N2TAze , M7N2TDxss , M7N2TDyss , M7N2TDzss , M7N3FKxe , M7N3FKye , M7N3FKze , & - M7N3FMxe , M7N3FMye , M7N3FMze , M7N3MKxe , M7N3MKye , M7N3MKze , M7N3MMxe , & - M7N3MMye , M7N3MMze , M7N3RAxe , M7N3RAye , M7N3RAze , M7N3RDxe , M7N3RDye , & - M7N3RDze , M7N3TAxe , M7N3TAye , M7N3TAze , M7N3TDxss , M7N3TDyss , M7N3TDzss , & - M7N4FKxe , M7N4FKye , M7N4FKze , M7N4FMxe , M7N4FMye , M7N4FMze , M7N4MKxe , & - M7N4MKye , M7N4MKze , M7N4MMxe , M7N4MMye , M7N4MMze , M7N4RAxe , M7N4RAye , & - M7N4RAze , M7N4RDxe , M7N4RDye , M7N4RDze , M7N4TAxe , M7N4TAye , M7N4TAze , & - M7N4TDxss , M7N4TDyss , M7N4TDzss , M7N5FKxe , M7N5FKye , M7N5FKze , M7N5FMxe , & - M7N5FMye , M7N5FMze , M7N5MKxe , M7N5MKye , M7N5MKze , M7N5MMxe , M7N5MMye , & - M7N5MMze , M7N5RAxe , M7N5RAye , M7N5RAze , M7N5RDxe , M7N5RDye , M7N5RDze , & - M7N5TAxe , M7N5TAye , M7N5TAze , M7N5TDxss , M7N5TDyss , M7N5TDzss , M7N6FKxe , & - M7N6FKye , M7N6FKze , M7N6FMxe , M7N6FMye , M7N6FMze , M7N6MKxe , M7N6MKye , & - M7N6MKze , M7N6MMxe , M7N6MMye , M7N6MMze , M7N6RAxe , M7N6RAye , M7N6RAze , & - M7N6RDxe , M7N6RDye , M7N6RDze , M7N6TAxe , M7N6TAye , M7N6TAze , M7N6TDxss , & - M7N6TDyss , M7N6TDzss , M7N7FKxe , M7N7FKye , M7N7FKze , M7N7FMxe , M7N7FMye , & - M7N7FMze , M7N7MKxe , M7N7MKye , M7N7MKze , M7N7MMxe , M7N7MMye , M7N7MMze , & - M7N7RAxe , M7N7RAye , M7N7RAze , M7N7RDxe , M7N7RDye , M7N7RDze , M7N7TAxe , & - M7N7TAye , M7N7TAze , M7N7TDxss , M7N7TDyss , M7N7TDzss , M7N8FKxe , M7N8FKye , & - M7N8FKze , M7N8FMxe , M7N8FMye , M7N8FMze , M7N8MKxe , M7N8MKye , M7N8MKze , & - M7N8MMxe , M7N8MMye , M7N8MMze , M7N8RAxe , M7N8RAye , M7N8RAze , M7N8RDxe , & - M7N8RDye , M7N8RDze , M7N8TAxe , M7N8TAye , M7N8TAze , M7N8TDxss , M7N8TDyss , & - M7N8TDzss , M7N9FKxe , M7N9FKye , M7N9FKze , M7N9FMxe , M7N9FMye , M7N9FMze , & - M7N9MKxe , M7N9MKye , M7N9MKze , M7N9MMxe , M7N9MMye , M7N9MMze , M7N9RAxe , & - M7N9RAye , M7N9RAze , M7N9RDxe , M7N9RDye , M7N9RDze , M7N9TAxe , M7N9TAye , & - M7N9TAze , M7N9TDxss , M7N9TDyss , M7N9TDzss , M8N1FKxe , M8N1FKye , M8N1FKze , & - M8N1FMxe , M8N1FMye , M8N1FMze , M8N1MKxe , M8N1MKye , M8N1MKze , M8N1MMxe , & - M8N1MMye , M8N1MMze , M8N1RAxe , M8N1RAye , M8N1RAze , M8N1RDxe , M8N1RDye , & - M8N1RDze , M8N1TAxe , M8N1TAye , M8N1TAze , M8N1TDxss , M8N1TDyss , M8N1TDzss , & - M8N2FKxe , M8N2FKye , M8N2FKze , M8N2FMxe , M8N2FMye , M8N2FMze , M8N2MKxe , & - M8N2MKye , M8N2MKze , M8N2MMxe , M8N2MMye , M8N2MMze , M8N2RAxe , M8N2RAye , & - M8N2RAze , M8N2RDxe , M8N2RDye , M8N2RDze , M8N2TAxe , M8N2TAye , M8N2TAze , & - M8N2TDxss , M8N2TDyss , M8N2TDzss , M8N3FKxe , M8N3FKye , M8N3FKze , M8N3FMxe , & - M8N3FMye , M8N3FMze , M8N3MKxe , M8N3MKye , M8N3MKze , M8N3MMxe , M8N3MMye , & - M8N3MMze , M8N3RAxe , M8N3RAye , M8N3RAze , M8N3RDxe , M8N3RDye , M8N3RDze , & - M8N3TAxe , M8N3TAye , M8N3TAze , M8N3TDxss , M8N3TDyss , M8N3TDzss , M8N4FKxe , & - M8N4FKye , M8N4FKze , M8N4FMxe , M8N4FMye , M8N4FMze , M8N4MKxe , M8N4MKye , & - M8N4MKze , M8N4MMxe , M8N4MMye , M8N4MMze , M8N4RAxe , M8N4RAye , M8N4RAze , & - M8N4RDxe , M8N4RDye , M8N4RDze , M8N4TAxe , M8N4TAye , M8N4TAze , M8N4TDxss , & - M8N4TDyss , M8N4TDzss , M8N5FKxe , M8N5FKye , M8N5FKze , M8N5FMxe , M8N5FMye , & - M8N5FMze , M8N5MKxe , M8N5MKye , M8N5MKze , M8N5MMxe , M8N5MMye , M8N5MMze , & - M8N5RAxe , M8N5RAye , M8N5RAze , M8N5RDxe , M8N5RDye , M8N5RDze , M8N5TAxe , & - M8N5TAye , M8N5TAze , M8N5TDxss , M8N5TDyss , M8N5TDzss , M8N6FKxe , M8N6FKye , & - M8N6FKze , M8N6FMxe , M8N6FMye , M8N6FMze , M8N6MKxe , M8N6MKye , M8N6MKze , & - M8N6MMxe , M8N6MMye , M8N6MMze , M8N6RAxe , M8N6RAye , M8N6RAze , M8N6RDxe , & - M8N6RDye , M8N6RDze , M8N6TAxe , M8N6TAye , M8N6TAze , M8N6TDxss , M8N6TDyss , & - M8N6TDzss , M8N7FKxe , M8N7FKye , M8N7FKze , M8N7FMxe , M8N7FMye , M8N7FMze , & - M8N7MKxe , M8N7MKye , M8N7MKze , M8N7MMxe , M8N7MMye , M8N7MMze , M8N7RAxe , & - M8N7RAye , M8N7RAze , M8N7RDxe , M8N7RDye , M8N7RDze , M8N7TAxe , M8N7TAye , & - M8N7TAze , M8N7TDxss , M8N7TDyss , M8N7TDzss , M8N8FKxe , M8N8FKye , M8N8FKze , & - M8N8FMxe , M8N8FMye , M8N8FMze , M8N8MKxe , M8N8MKye , M8N8MKze , M8N8MMxe , & - M8N8MMye , M8N8MMze , M8N8RAxe , M8N8RAye , M8N8RAze , M8N8RDxe , M8N8RDye , & - M8N8RDze , M8N8TAxe , M8N8TAye , M8N8TAze , M8N8TDxss , M8N8TDyss , M8N8TDzss , & - M8N9FKxe , M8N9FKye , M8N9FKze , M8N9FMxe , M8N9FMye , M8N9FMze , M8N9MKxe , & - M8N9MKye , M8N9MKze , M8N9MMxe , M8N9MMye , M8N9MMze , M8N9RAxe , M8N9RAye , & - M8N9RAze , M8N9RDxe , M8N9RDye , M8N9RDze , M8N9TAxe , M8N9TAye , M8N9TAze , & - M8N9TDxss , M8N9TDyss , M8N9TDzss , M9N1FKxe , M9N1FKye , M9N1FKze , M9N1FMxe , & - M9N1FMye , M9N1FMze , M9N1MKxe , M9N1MKye , M9N1MKze , M9N1MMxe , M9N1MMye , & - M9N1MMze , M9N1RAxe , M9N1RAye , M9N1RAze , M9N1RDxe , M9N1RDye , M9N1RDze , & - M9N1TAxe , M9N1TAye , M9N1TAze , M9N1TDxss , M9N1TDyss , M9N1TDzss , M9N2FKxe , & - M9N2FKye , M9N2FKze , M9N2FMxe , M9N2FMye , M9N2FMze , M9N2MKxe , M9N2MKye , & - M9N2MKze , M9N2MMxe , M9N2MMye , M9N2MMze , M9N2RAxe , M9N2RAye , M9N2RAze , & - M9N2RDxe , M9N2RDye , M9N2RDze , M9N2TAxe , M9N2TAye , M9N2TAze , M9N2TDxss , & - M9N2TDyss , M9N2TDzss , M9N3FKxe , M9N3FKye , M9N3FKze , M9N3FMxe , M9N3FMye , & - M9N3FMze , M9N3MKxe , M9N3MKye , M9N3MKze , M9N3MMxe , M9N3MMye , M9N3MMze , & - M9N3RAxe , M9N3RAye , M9N3RAze , M9N3RDxe , M9N3RDye , M9N3RDze , M9N3TAxe , & - M9N3TAye , M9N3TAze , M9N3TDxss , M9N3TDyss , M9N3TDzss , M9N4FKxe , M9N4FKye , & - M9N4FKze , M9N4FMxe , M9N4FMye , M9N4FMze , M9N4MKxe , M9N4MKye , M9N4MKze , & - M9N4MMxe , M9N4MMye , M9N4MMze , M9N4RAxe , M9N4RAye , M9N4RAze , M9N4RDxe , & - M9N4RDye , M9N4RDze , M9N4TAxe , M9N4TAye , M9N4TAze , M9N4TDxss , M9N4TDyss , & - M9N4TDzss , M9N5FKxe , M9N5FKye , M9N5FKze , M9N5FMxe , M9N5FMye , M9N5FMze , & - M9N5MKxe , M9N5MKye , M9N5MKze , M9N5MMxe , M9N5MMye , M9N5MMze , M9N5RAxe , & - M9N5RAye , M9N5RAze , M9N5RDxe , M9N5RDye , M9N5RDze , M9N5TAxe , M9N5TAye , & - M9N5TAze , M9N5TDxss , M9N5TDyss , M9N5TDzss , M9N6FKxe , M9N6FKye , M9N6FKze , & - M9N6FMxe , M9N6FMye , M9N6FMze , M9N6MKxe , M9N6MKye , M9N6MKze , M9N6MMxe , & - M9N6MMye , M9N6MMze , M9N6RAxe , M9N6RAye , M9N6RAze , M9N6RDxe , M9N6RDye , & - M9N6RDze , M9N6TAxe , M9N6TAye , M9N6TAze , M9N6TDxss , M9N6TDyss , M9N6TDzss , & - M9N7FKxe , M9N7FKye , M9N7FKze , M9N7FMxe , M9N7FMye , M9N7FMze , M9N7MKxe , & - M9N7MKye , M9N7MKze , M9N7MMxe , M9N7MMye , M9N7MMze , M9N7RAxe , M9N7RAye , & - M9N7RAze , M9N7RDxe , M9N7RDye , M9N7RDze , M9N7TAxe , M9N7TAye , M9N7TAze , & - M9N7TDxss , M9N7TDyss , M9N7TDzss , M9N8FKxe , M9N8FKye , M9N8FKze , M9N8FMxe , & - M9N8FMye , M9N8FMze , M9N8MKxe , M9N8MKye , M9N8MKze , M9N8MMxe , M9N8MMye , & - M9N8MMze , M9N8RAxe , M9N8RAye , M9N8RAze , M9N8RDxe , M9N8RDye , M9N8RDze , & - M9N8TAxe , M9N8TAye , M9N8TAze , M9N8TDxss , M9N8TDyss , M9N8TDzss , M9N9FKxe , & - M9N9FKye , M9N9FKze , M9N9FMxe , M9N9FMye , M9N9FMze , M9N9MKxe , M9N9MKye , & - M9N9MKze , M9N9MMxe , M9N9MMye , M9N9MMze , M9N9RAxe , M9N9RAye , M9N9RAze , & - M9N9RDxe , M9N9RDye , M9N9RDze , M9N9TAxe , M9N9TAye , M9N9TAze , M9N9TDxss , & - M9N9TDyss , M9N9TDzss , ReactFXss , ReactFYss , ReactFZss , ReactMXss , ReactMYss , & - ReactMZss , SSqm01 , SSqm02 , SSqm03 , SSqm04 , SSqm05 , SSqm06 , & - SSqm07 , SSqm08 , SSqm09 , SSqm10 , SSqm11 , SSqm12 , SSqm13 , & - SSqm14 , SSqm15 , SSqm16 , SSqm17 , SSqm18 , SSqm19 , SSqm20 , & - SSqm21 , SSqm22 , SSqm23 , SSqm24 , SSqm25 , SSqm26 , SSqm27 , & - SSqm28 , SSqm29 , SSqm30 , SSqm31 , SSqm32 , SSqm33 , SSqm34 , & - SSqm35 , SSqm36 , SSqm37 , SSqm38 , SSqm39 , SSqm40 , SSqm41 , & - SSqm42 , SSqm43 , SSqm44 , SSqm45 , SSqm46 , SSqm47 , SSqm48 , & - SSqm49 , SSqm50 , SSqm51 , SSqm52 , SSqm53 , SSqm54 , SSqm55 , & - SSqm56 , SSqm57 , SSqm58 , SSqm59 , SSqm60 , SSqm61 , SSqm62 , & - SSqm63 , SSqm64 , SSqm65 , SSqm66 , SSqm67 , SSqm68 , SSqm69 , & - SSqm70 , SSqm71 , SSqm72 , SSqm73 , SSqm74 , SSqm75 , SSqm76 , & - SSqm77 , SSqm78 , SSqm79 , SSqm80 , SSqm81 , SSqm82 , SSqm83 , & - SSqm84 , SSqm85 , SSqm86 , SSqm87 , SSqm88 , SSqm89 , SSqm90 , & - SSqm91 , SSqm92 , SSqm93 , SSqm94 , SSqm95 , SSqm96 , SSqm97 , & - SSqm98 , SSqm99 , SSqmd01 , SSqmd02 , SSqmd03 , SSqmd04 , SSqmd05 , & - SSqmd06 , SSqmd07 , SSqmd08 , SSqmd09 , SSqmd10 , SSqmd11 , SSqmd12 , & - SSqmd13 , SSqmd14 , SSqmd15 , SSqmd16 , SSqmd17 , SSqmd18 , SSqmd19 , & - SSqmd20 , SSqmd21 , SSqmd22 , SSqmd23 , SSqmd24 , SSqmd25 , SSqmd26 , & - SSqmd27 , SSqmd28 , SSqmd29 , SSqmd30 , SSqmd31 , SSqmd32 , SSqmd33 , & - SSqmd34 , SSqmd35 , SSqmd36 , SSqmd37 , SSqmd38 , SSqmd39 , SSqmd40 , & - SSqmd41 , SSqmd42 , SSqmd43 , SSqmd44 , SSqmd45 , SSqmd46 , SSqmd47 , & - SSqmd48 , SSqmd49 , SSqmd50 , SSqmd51 , SSqmd52 , SSqmd53 , SSqmd54 , & - SSqmd55 , SSqmd56 , SSqmd57 , SSqmd58 , SSqmd59 , SSqmd60 , SSqmd61 , & - SSqmd62 , SSqmd63 , SSqmd64 , SSqmd65 , SSqmd66 , SSqmd67 , SSqmd68 , & - SSqmd69 , SSqmd70 , SSqmd71 , SSqmd72 , SSqmd73 , SSqmd74 , SSqmd75 , & - SSqmd76 , SSqmd77 , SSqmd78 , SSqmd79 , SSqmd80 , SSqmd81 , SSqmd82 , & - SSqmd83 , SSqmd84 , SSqmd85 , SSqmd86 , SSqmd87 , SSqmd88 , SSqmd89 , & - SSqmd90 , SSqmd91 , SSqmd92 , SSqmd93 , SSqmd94 , SSqmd95 , SSqmd96 , & - SSqmd97 , SSqmd98 , SSqmd99 , SSqmdd01 , SSqmdd02 , SSqmdd03 , SSqmdd04 , & - SSqmdd05 , SSqmdd06 , SSqmdd07 , SSqmdd08 , SSqmdd09 , SSqmdd10 , SSqmdd11 , & - SSqmdd12 , SSqmdd13 , SSqmdd14 , SSqmdd15 , SSqmdd16 , SSqmdd17 , SSqmdd18 , & - SSqmdd19 , SSqmdd20 , SSqmdd21 , SSqmdd22 , SSqmdd23 , SSqmdd24 , SSqmdd25 , & - SSqmdd26 , SSqmdd27 , SSqmdd28 , SSqmdd29 , SSqmdd30 , SSqmdd31 , SSqmdd32 , & - SSqmdd33 , SSqmdd34 , SSqmdd35 , SSqmdd36 , SSqmdd37 , SSqmdd38 , SSqmdd39 , & - SSqmdd40 , SSqmdd41 , SSqmdd42 , SSqmdd43 , SSqmdd44 , SSqmdd45 , SSqmdd46 , & - SSqmdd47 , SSqmdd48 , SSqmdd49 , SSqmdd50 , SSqmdd51 , SSqmdd52 , SSqmdd53 , & - SSqmdd54 , SSqmdd55 , SSqmdd56 , SSqmdd57 , SSqmdd58 , SSqmdd59 , SSqmdd60 , & - SSqmdd61 , SSqmdd62 , SSqmdd63 , SSqmdd64 , SSqmdd65 , SSqmdd66 , SSqmdd67 , & - SSqmdd68 , SSqmdd69 , SSqmdd70 , SSqmdd71 , SSqmdd72 , SSqmdd73 , SSqmdd74 , & - SSqmdd75 , SSqmdd76 , SSqmdd77 , SSqmdd78 , SSqmdd79 , SSqmdd80 , SSqmdd81 , & - SSqmdd82 , SSqmdd83 , SSqmdd84 , SSqmdd85 , SSqmdd86 , SSqmdd87 , SSqmdd88 , & - SSqmdd89 , SSqmdd90 , SSqmdd91 , SSqmdd92 , SSqmdd93 , SSqmdd94 , SSqmdd95 , & - SSqmdd96 , SSqmdd97 , SSqmdd98 , SSqmdd99 /) - CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(2265) = (/ & ! This lists the units corresponding to the allowed parameters - "(N) ","(N) ","(N) ","(Nm) ","(Nm) ","(Nm) ","(rad/s^2) ", & - "(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ", & - "(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ", & - "(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m) ","(m) ","(m) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ", & - "(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ", & - "(m) ","(m) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ", & - "(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ", & - "(m) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ", & - "(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ", & - "(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ", & - "(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m) ","(m) ","(m) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ", & - "(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ", & - "(m) ","(m) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ", & - "(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ", & - "(m) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ", & - "(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ", & - "(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ", & - "(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m) ","(m) ","(m) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ", & - "(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ", & - "(m) ","(m) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ", & - "(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ", & - "(m) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ", & - "(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ", & - "(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ", & - "(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m) ","(m) ","(m) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ", & - "(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ", & - "(m) ","(m) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ", & - "(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ", & - "(m) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ", & - "(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ", & - "(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ", & - "(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m) ","(m) ","(m) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ", & - "(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ", & - "(m) ","(m) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ", & - "(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ", & - "(m) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ", & - "(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ", & - "(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ", & - "(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m) ","(m) ","(m) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ", & - "(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ", & - "(m) ","(m) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ", & - "(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ", & - "(m) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ", & - "(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ", & - "(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ", & - "(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m) ","(m) ","(m) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ", & - "(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ", & - "(m) ","(m) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ", & - "(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ", & - "(m) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ", & - "(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ", & - "(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ", & - "(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m) ","(m) ","(m) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ", & - "(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ", & - "(m) ","(m) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ", & - "(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ", & - "(m) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ", & - "(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ", & - "(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ", & - "(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m) ","(m) ","(m) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ", & - "(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ", & - "(m) ","(m) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ", & - "(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ", & - "(m) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ", & - "(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ", & - "(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ", & - "(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m) ","(m) ","(m) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ", & - "(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ", & - "(m) ","(m) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ", & - "(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ", & - "(m) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ", & - "(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ", & - "(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ", & - "(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m) ","(m) ","(m) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ", & - "(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ", & - "(m) ","(m) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ", & - "(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ", & - "(m) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ", & - "(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m) ","(m) ","(m) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ", & - "(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ", & - "(rad/s^2) ","(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m) ","(m) ","(m) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ","(N*m) ", & - "(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ","(rad) ","(rad) ","(rad) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N*m) ","(N*m) ", & - "(N*m) ","(N*m) ","(N*m) ","(N*m) ","(rad/s^2) ","(rad/s^2) ","(rad/s^2) ", & - "(rad) ","(rad) ","(rad) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ", & - "(m) ","(m) ","(N) ","(N) ","(N) ","(Nm) ","(Nm) ", & - "(Nm) ","(--) ","(--) ","(--) ","(--) ","(--) ","(--) ", & - "(--) ","(--) ","(--) ","(--) ","(--) ","(--) ","(--) ", & - "(--) ","(--) ","(--) ","(--) ","(--) ","(--) ","(--) ", & - "(--) ","(--) ","(--) ","(--) ","(--) ","(--) ","(--) ", & - "(--) ","(--) ","(--) ","(--) ","(--) ","(--) ","(--) ", & - "(--) ","(--) ","(--) ","(--) ","(--) ","(--) ","(--) ", & - "(--) ","(--) ","(--) ","(--) ","(--) ","(--) ","(--) ", & - "(--) ","(--) ","(--) ","(--) ","(--) ","(--) ","(--) ", & - "(--) ","(--) ","(--) ","(--) ","(--) ","(--) ","(--) ", & - "(--) ","(--) ","(--) ","(--) ","(--) ","(--) ","(--) ", & - "(--) ","(--) ","(--) ","(--) ","(--) ","(--) ","(--) ", & - "(--) ","(--) ","(--) ","(--) ","(--) ","(--) ","(--) ", & - "(--) ","(--) ","(--) ","(--) ","(--) ","(--) ","(--) ", & - "(--) ","(--) ","(--) ","(--) ","(--) ","(--) ","(--) ", & - "(--) ","(--) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ", & - "(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ", & - "(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ", & - "(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ", & - "(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ", & - "(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ", & - "(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ", & - "(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ", & - "(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ", & - "(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ", & - "(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ", & - "(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ", & - "(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ", & - "(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ","(1/s) ", & - "(1/s) ","(1/s) ","(1/s) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ", & - "(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ", & - "(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ", & - "(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ", & - "(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ", & - "(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ", & - "(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ", & - "(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ", & - "(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ", & - "(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ", & - "(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ", & - "(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ", & - "(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ", & - "(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) ", & - "(1/s^2) ","(1/s^2) ","(1/s^2) ","(1/s^2) "/) - - -!End of code generated by Matlab script -end module SubDyn_Output_Params diff --git a/OpenFAST/modules/subdyn/src/SubDyn_Registry.txt b/OpenFAST/modules/subdyn/src/SubDyn_Registry.txt deleted file mode 100644 index d8d458ca5..000000000 --- a/OpenFAST/modules/subdyn/src/SubDyn_Registry.txt +++ /dev/null @@ -1,282 +0,0 @@ -##################### Registry for SubDyn ################## -# -# -# 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 - -# ============================== Internal data types ============================================================================================================================================ -typedef SubDyn/SD IList INTEGER List {:} - - "List of integers" -# -typedef ^ MeshAuxDataType INTEGER MemberID - - - "Member ID for Output" -typedef ^ MeshAuxDataType INTEGER NOutCnt - - - "Number of Nodes for the output member" -typedef ^ MeshAuxDataType INTEGER NodeCnt {:} - - "Node ordinal numbers for the output member" -typedef ^ MeshAuxDataType INTEGER NodeIDs {:} - - "Node IDs associated with ordinal numbers for the output member" -typedef ^ MeshAuxDataType INTEGER ElmIDs {:}{:} - - "Element IDs connected to each NodeIDs; max 10 elements" -typedef ^ MeshAuxDataType INTEGER ElmNds {:}{:} - - "Flag to indicate 1st or 2nd node of element for each ElmIDs" -typedef ^ MeshAuxDataType R8Ki Me {:}{:}{:}{:} - - "Mass matrix connected to each joint element for outAll output" -typedef ^ MeshAuxDataType R8Ki Ke {:}{:}{:}{:} - - "Mass matrix connected to each joint element for outAll output" -typedef ^ MeshAuxDataType R8Ki Fg {:}{:}{:} - - "Gravity load vector connected to each joint element for requested member output" - -# CB_MatArrays: Matrices and arrays for CB summary -typedef ^ CB_MatArrays R8Ki MBB {:}{:} - - "FULL MBB ( no constraints applied)" -typedef ^ CB_MatArrays R8Ki MBM {:}{:} - - "FULL MBM ( no constraints applied)" -typedef ^ CB_MatArrays R8Ki KBB {:}{:} - - "FULL KBB ( no constraints applied)" -typedef ^ CB_MatArrays R8Ki PhiL {:}{:} - - "Retained CB modes, possibly allPhiL(nDOFL,nDOFL), or PhiL(nDOFL,nDOFM)" -typedef ^ CB_MatArrays R8Ki PhiR {:}{:} - - "FULL PhiR ( no constraints applied)" -typedef ^ CB_MatArrays R8Ki OmegaL {:} - - "Eigenvalues of retained CB modes, possibly all (nDOFL or nDOFM)" -# -typedef ^ ElemPropType IntKi eType - - - "Element Type" -typedef ^ ElemPropType ReKi Length - - - "Length of an element" -typedef ^ ElemPropType ReKi Ixx - - - "Moment of inertia of an element" -typedef ^ ElemPropType ReKi Iyy - - - "Moment of inertia of an element" -typedef ^ ElemPropType ReKi Jzz - - - "Moment of inertia of an element" -typedef ^ ElemPropType LOGICAL Shear - - - "Use timoshenko (true) E-B (false)" -typedef ^ ElemPropType ReKi Kappa - - - "Shear coefficient" -typedef ^ ElemPropType ReKi YoungE - - - "Young's modulus" -typedef ^ ElemPropType ReKi ShearG - - - "Shear modulus" N/m^2 -# Properties common to all element types: -typedef ^ ElemPropType ReKi Area - - - "Area of an element" m^2 -typedef ^ ElemPropType ReKi Rho - - - "Density" kg/m^3 -typedef ^ ElemPropType ReKi T0 - - - "Pretension " N -typedef ^ ElemPropType R8Ki DirCos {3}{3} - - "Element direction cosine matrix" - -# ============================== Input Initialization (from glue code) ============================================================================================================================================ -typedef ^ InitInputType CHARACTER(1024) SDInputFile - - - "Name of the input file" -typedef ^ InitInputType CHARACTER(1024) RootName - - - "SubDyn rootname" -typedef ^ InitInputType ReKi g - - - "Gravity acceleration" -typedef ^ InitInputType ReKi WtrDpth - - - "Water Depth (positive valued)" -typedef ^ InitInputType ReKi TP_RefPoint {3} - - "global position of transition piece reference point (could also be defined in SubDyn itself)" -typedef ^ InitInputType ReKi SubRotateZ - - - "Rotation angle in degrees about global Z" -typedef ^ InitInputType ReKi SoilStiffness ::: - - "Soil stiffness matrices from SoilDyn" '(N/m, N-m/rad)' -typedef ^ InitInputType MeshType SoilMesh - - - "Mesh for soil stiffness locations" - -typedef ^ InitInputType Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - - -# ============================== Initialization outputs ============================================================================================================================================ -typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - -typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - -typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - -# Linearization -typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - -typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - -typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - -typedef ^ InitOutputType LOGICAL RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - -typedef ^ InitOutputType LOGICAL RotFrame_x {:} - - "Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame (not used for glue)" - -typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - -typedef ^ InitOutputType LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - -typedef ^ InitOutputType IntKi DerivOrder_x {:} - - "Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization" - - -# ============================== Define initialization data (not from glue code) here: ============================================================================================================================================ -typedef ^ SD_InitType CHARACTER(1024) RootName - - - "SubDyn rootname" -typedef ^ SD_InitType ReKi TP_RefPoint {3} - - "global position of transition piece reference point (could also be defined in SubDyn itself)" -typedef ^ SD_InitType ReKi SubRotateZ - - - "Rotation angle in degrees about global Z" -typedef ^ SD_InitType ReKi g - - - "Gravity acceleration" -typedef ^ SD_InitType DbKi DT - - - "Time step from Glue Code" seconds -typedef ^ SD_InitType INTEGER NJoints - - - "Number of joints of the sub structure" -typedef ^ SD_InitType INTEGER NPropSetsX - - - "Number of extended property sets" -typedef ^ SD_InitType INTEGER NPropSetsB - - - "Number of property sets for beams" -typedef ^ SD_InitType INTEGER NPropSetsC - - - "Number of property sets for cables" -typedef ^ SD_InitType INTEGER NPropSetsR - - - "Number of property sets for rigid links" -typedef ^ SD_InitType INTEGER NCMass - - - "Number of joints with concentrated mass" -typedef ^ SD_InitType INTEGER NCOSMs - - - "Number of independent cosine matrices" -typedef ^ SD_InitType INTEGER FEMMod - - - "FEM switch element model in the FEM" -typedef ^ SD_InitType INTEGER NDiv - - - "Number of divisions for each member" -typedef ^ SD_InitType LOGICAL CBMod - - - "Perform C-B flag" -typedef ^ SD_InitType ReKi Joints {:}{:} - - "Joints number and coordinate values" -typedef ^ SD_InitType ReKi PropSetsB {:}{:} - - "Property sets number and values" -typedef ^ SD_InitType ReKi PropSetsC {:}{:} - - "Property ID and values for cables" -typedef ^ SD_InitType ReKi PropSetsR {:}{:} - - "Property ID and values for rigid link" -typedef ^ SD_InitType ReKi PropSetsX {:}{:} - - "Extended property sets" -typedef ^ SD_InitType ReKi COSMs {:}{:} - - "Independent direction cosine matrices" -typedef ^ SD_InitType ReKi CMass {:}{:} - - "Concentrated mass information" -typedef ^ SD_InitType ReKi JDampings {:} - - "Damping coefficients for internal modes" -typedef ^ SD_InitType IntKi GuyanDampMod - - - "Guyan damping [0=none, 1=Rayleigh Damping, 2= user specified 6x6 matrix]" -typedef ^ SD_InitType ReKi RayleighDamp {2} - - "Mass and stiffness proportional damping coefficients (Rayleigh Damping) [only if GuyanDampMod=1]" -typedef ^ SD_InitType ReKi GuyanDampMat {6}{6} - - "Guyan Damping Matrix, see also CBB" -typedef ^ SD_InitType INTEGER Members {:}{:} - - "Member joints connection " -typedef ^ SD_InitType CHARACTER(ChanLen) SSOutList {:} - - "List of Output Channels " -typedef ^ SD_InitType LOGICAL OutCOSM - - - "Output Cos-matrices Flag " -typedef ^ SD_InitType LOGICAL TabDelim - - - "Generate a tab-delimited output file in OutJckF-Flag " -typedef ^ SD_InitType R8Ki SSIK {:}{:} - - "SSI stiffness packed matrix elements (21 of them), for each reaction joint " -typedef ^ SD_InitType R8Ki SSIM {:}{:} - - "SSI mass packed matrix elements (21 of them), for each reaction joint " -typedef ^ SD_InitType CHARACTER(1024) SSIfile {:} - - "Soil Structure Interaction (SSI) files to associate with each reaction node" -typedef ^ SD_InitType ReKi Soil_K {:}{:}{:} - - "Soil stiffness (at passed at Init, not in input file) 6x6xn " -typedef ^ SD_InitType ReKi Soil_Points {:}{:} - - "Node positions where soil stiffness will be added " -typedef ^ SD_InitType Integer Soil_Nodes {:} - - "Node indices where soil stiffness will be added " -typedef ^ SD_InitType INTEGER NElem - - - "Total number of elements" -typedef ^ SD_InitType INTEGER NPropB - - - "Total number of property sets for Beams" -typedef ^ SD_InitType INTEGER NPropC - - - "Total number of property sets for Cable" -typedef ^ SD_InitType INTEGER NPropR - - - "Total number of property sets for Rigid" -typedef ^ SD_InitType ReKi Nodes {:}{:} - - "Nodes number and coordinates " -typedef ^ SD_InitType ReKi PropsB {:}{:} - - "Property sets and values for Beams " -typedef ^ SD_InitType ReKi PropsC {:}{:} - - "Property sets and values for Cable " -typedef ^ SD_InitType ReKi PropsR {:}{:} - - "Property sets and values for Rigid link" -typedef ^ SD_InitType R8Ki K {:}{:} - - "System stiffness matrix " -typedef ^ SD_InitType R8Ki M {:}{:} - - "System mass matrix " -typedef ^ SD_InitType ReKi ElemProps {:}{:} - - "Element properties(A, L, Ixx, Iyy, Jzz, Shear, Kappa, E, G, Rho, DirCos(1,1), DirCos(2, 1), ....., DirCos(3, 3) )" -typedef ^ SD_InitType INTEGER MemberNodes {:}{:} - - "Member number and list of nodes making up a member (>2 if subdivided)" -typedef ^ SD_InitType INTEGER NodesConnN {:}{:} - - "Nodes that connect to a common node " -typedef ^ SD_InitType INTEGER NodesConnE {:}{:} - - "Elements that connect to a common node" -typedef ^ SD_InitType LOGICAL SSSum - - - "SubDyn Summary File Flag " - -# ============================== States ============================================================================================================================================ -typedef ^ ContinuousStateType R8Ki qm {:} - - "Virtual states, Nmod elements" -typedef ^ ContinuousStateType R8Ki qmdot {:} - - "Derivative of states, Nmod elements" - -typedef ^ DiscreteStateType ReKi DummyDiscState - - - "Remove this variable if you have discrete states" - -typedef ^ ConstraintStateType ReKi DummyConstrState - - - "Remove this variable if you have constraint states" - -typedef ^ OtherStateType SD_ContinuousStateType xdot {:} - - "previous state derivs for m-step time integrator" -typedef ^ ^ IntKi n - - - "tracks time step for which OtherState was updated last" - -# ..... Misc/Optimization variables................................................................................................. -# 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 ReKi qmdotdot {:} - - "2nd Derivative of states, used only for output-file purposes" -typedef ^ MiscVarType ReKi u_TP 6 - - -typedef ^ MiscVarType ReKi udot_TP 6 - - -typedef ^ MiscVarType ReKi udotdot_TP 6 - - -typedef ^ MiscVarType ReKi F_L {:} - - -typedef ^ MiscVarType ReKi UR_bar {:} - - -typedef ^ MiscVarType ReKi UR_bar_dot {:} - - -typedef ^ MiscVarType ReKi UR_bar_dotdot {:} - - -typedef ^ MiscVarType ReKi UL {:} - - -typedef ^ MiscVarType ReKi UL_dot {:} - - -typedef ^ MiscVarType ReKi UL_dotdot {:} - - -typedef ^ MiscVarType ReKi DU_full {:} - - "Delta U used for extra moment" -typedef ^ MiscVarType ReKi U_full {:} - - -typedef ^ MiscVarType ReKi U_full_dot {:} - - -typedef ^ MiscVarType ReKi U_full_dotdot {:} - - -typedef ^ MiscVarType ReKi U_full_elast {:} - - "Elastic displacements for computation of K ue (without rigid body mode for floating)" -typedef ^ MiscVarType ReKi U_red {:} - - -typedef ^ MiscVarType ReKi U_red_dot {:} - - -typedef ^ MiscVarType ReKi U_red_dotdot {:} - - -typedef ^ MiscVarType ReKi FC_unit {:} - - "Cable Force vector (for varying cable load, of unit cable load)" N -typedef ^ MiscVarType ReKi SDWrOutput {:} - - "Data from previous step to be written to a SubDyn output file" -typedef ^ MiscVarType DbKi LastOutTime - - - "The time of the most recent stored output data" "s" -typedef ^ MiscVarType IntKi Decimat - - - "Current output decimation counter" "-" -typedef ^ MiscVarType ReKi Fext {:} - - "External loads on unconstrained DOFs" "-" -typedef ^ MiscVarType ReKi Fext_red {:} - - "External loads on constrained DOFs, Fext_red= T^t Fext" "-" -### data for writing to an output file (this data is associated with time, but saved/written in CalcOutput so not stored as an other state) ### - -# ============================== Parameters ============================================================================================================================================ -# --- Parameters - Algo -typedef ^ ParameterType DbKi SDDeltaT - - - "Time step (for integration of continuous states)" seconds -typedef ^ ParameterType IntKi IntMethod - - - "Integration Method (1/2/3)Length of y2 array" -# --- Parameters - FEM -typedef ^ ParameterType INTEGER nDOF - - - "Total degree of freedom" -typedef ^ ParameterType INTEGER nDOF_red - - - "Total degree of freedom after constraint reduction" -typedef ^ ParameterType IntKi Nmembers - - - "Number of members of the sub structure" -typedef ^ ParameterType IntKi Elems {:}{:} - - "Element nodes connections" -typedef ^ ParameterType ElemPropType ElemProps {:} - - "List of element properties" -typedef ^ ParameterType R8Ki FG {:} - - "Gravity force vector (with initial cable force T0), not reduced" N -typedef ^ ParameterType ReKi DP0 {:}{:} - - "Vector from TP to a Node at t=0, used for Floating Rigid Body motion" m -# --- Parameters - Constraints reduction -typedef ^ ParameterType Logical reduced - - - "True if system has been reduced to account for constraints" "-" -typedef ^ ParameterType R8Ki T_red {:}{:} - - "Transformation matrix performing the constraint reduction x = T. xtilde" "-" -typedef ^ ParameterType R8Ki T_red_T {:}{:} - - "Transpose of T_red" "-" -typedef ^ ParameterType IList NodesDOF {:} - - "DOF indices of each nodes in unconstrained assembled system " "-" -typedef ^ ParameterType IList NodesDOFred {:} - - "DOF indices of each nodes in constrained assembled system " "-" -typedef ^ ParameterType IntKi ElemsDOF {:}{:} - - "12 DOF indices of node 1 and 2 of a given member in unconstrained assembled system " "-" -typedef ^ ParameterType IntKi DOFred2Nodes {:}{:} - - "nDOFRed x 3, for each constrained DOF, col1 node index, col2 number of DOF, col3 DOF starting from 1" "-" -# --- Parameters - Control -typedef ^ ParameterType IntKi CtrlElem2Channel {:}{:} - - "nCtrlCable x 2, for each CtrlCable, Elem index, and Channel Index" -# --- Parameters - CB reduction -typedef ^ ParameterType IntKi nDOFM - - - "retained degrees of freedom (modes)" -typedef ^ ParameterType IntKi SttcSolve - - - "Solve dynamics about static equilibrium point (flag)" -typedef ^ ParameterType Logical GuyanLoadCorrection - - - "Add Extra lever arm contribution to interface reaction outputs" -typedef ^ ParameterType Logical Floating - - - "True if floating bottom (the 6 DOF are free at all reaction nodes)" -typedef ^ ParameterType ReKi KMMDiag {:} - - "Diagonal coefficients of Kmm (OmegaM squared)" -typedef ^ ParameterType ReKi CMMDiag {:} - - "Diagonal coefficients of Cmm (~2 Zeta OmegaM))" -typedef ^ ParameterType ReKi MMB {:}{:} - - "Matrix after C-B reduction (transpose of MBM" -typedef ^ ParameterType ReKi MBmmB {:}{:} - - "MBm * MmB, used for Y1" -typedef ^ ParameterType ReKi C1_11 {:}{:} - - "Coefficient of x in Y1" -typedef ^ ParameterType ReKi C1_12 {:}{:} - - "Coefficient of x in Y1" -typedef ^ ParameterType ReKi D1_141 {:}{:} - - "MBm PhiM^T" -typedef ^ ParameterType ReKi D1_142 {:}{:} - - "TI^T PhiR^T" -typedef ^ ParameterType ReKi PhiM {:}{:} - - "Coefficient of x in Y2" -typedef ^ ParameterType ReKi C2_61 {:}{:} - - "Coefficient of x in Y2 (URdotdot ULdotdot)" -typedef ^ ParameterType ReKi C2_62 {:}{:} - - "Coefficient of x in Y2 (URdotdot ULdotdot)" -typedef ^ ParameterType ReKi PhiRb_TI {:}{:} - - "Coefficient of u in Y2 (Phi_R bar * TI)" -typedef ^ ParameterType ReKi D2_63 {:}{:} - - "Coefficient of u in Y2 (URdotdot ULdotdot)" -typedef ^ ParameterType ReKi D2_64 {:}{:} - - "Coefficient of u in Y2 (URdotdot ULdotdot)" -typedef ^ ParameterType ReKi MBB {:}{:} - - "Guyan Mass Matrix after C-B reduction" -typedef ^ ParameterType ReKi KBB {:}{:} - - "Guyan Stiffness Matrix after C-B reduction" -typedef ^ ParameterType ReKi CBB {:}{:} - - "Guyan Damping Matrix after C-B reduction" -typedef ^ ParameterType ReKi CMM {:}{:} - - "CB damping matrix" -typedef ^ ParameterType ReKi MBM {:}{:} - - "Matrix after C-B reduction" -typedef ^ ParameterType ReKi PhiL_T {:}{:} - - "Transpose of Matrix of C-B modes" -typedef ^ ParameterType ReKi PhiLInvOmgL2 {:}{:} - - "Matrix of C-B modes times the inverse of OmegaL**2 (Phi_L*(Omg**2)^-1)" -typedef ^ ParameterType ReKi KLLm1 {:}{:} - - "KLL^{-1}, inverse of matrix KLL, for static solve only" -typedef ^ ParameterType ReKi AM2Jac {:}{:} - - "Jacobian (factored) for Adams-Boulton 2nd order Integration" -typedef ^ ParameterType IntKi AM2JacPiv {:} - - "Pivot array for Jacobian factorization (for Adams-Boulton 2nd order Integration)" -typedef ^ ParameterType ReKi TI {:}{:} - - "Matrix to calculate TP reference point reaction at top of structure" -typedef ^ ParameterType ReKi TIreact {:}{:} - - "Matrix to calculate single point reaction at base of structure" -# --- Parameters - Partitioning I L C Y, R=[C I] -typedef ^ ParameterType IntKi nNodes - - - "Total number of nodes" -typedef ^ ParameterType IntKi nNodes_I - - - "Number of Interface nodes" -typedef ^ ParameterType IntKi nNodes_L - - - "Number of Internal nodes" -typedef ^ ParameterType IntKi nNodes_C - - - "Number of joints with reactions" -typedef ^ ParameterType IntKi Nodes_I {:}{:} - - "Interface degree of freedoms" -typedef ^ ParameterType IntKi Nodes_L {:}{:} - - "Internal nodes (not interface nor reaction)" -typedef ^ ParameterType IntKi Nodes_C {:}{:} - - "React degree of freedoms" -typedef ^ ParameterType IntKi nDOFI__ - - - "Size of IDI__" -typedef ^ ParameterType IntKi nDOFI_Rb - - - "Size of IDI_Rb" -typedef ^ ParameterType IntKi nDOFI_F - - - "Size of IDI_F" -typedef ^ ParameterType IntKi nDOFL_L - - - "Size of IDL_L" -typedef ^ ParameterType IntKi nDOFC__ - - - "Size of IDC__" -typedef ^ ParameterType IntKi nDOFC_Rb - - - "Size of IDC_Rb" -typedef ^ ParameterType IntKi nDOFC_L - - - "Size of IDC_L" -typedef ^ ParameterType IntKi nDOFC_F - - - "Size of IDC_F" -typedef ^ ParameterType IntKi nDOFR__ - - - "Size of IDR__" -typedef ^ ParameterType IntKi nDOF__Rb - - - "Size of ID__Rb" -typedef ^ ParameterType IntKi nDOF__L - - - "Size of ID__L" -typedef ^ ParameterType IntKi nDOF__F - - - "Size of ID__F" -typedef ^ ParameterType IntKi IDI__ {:} - - "Index of all Interface DOFs" -typedef ^ ParameterType IntKi IDI_Rb {:} - - "Index array of the interface (nodes connect to TP) dofs that are retained/master/follower DOFs" -typedef ^ ParameterType IntKi IDI_F {:} - - "Index array of the interface (nodes connect to TP) dofs that are fixed DOF" -typedef ^ ParameterType IntKi IDL_L {:} - - "Index array of the internal dofs coming from internal nodes" -typedef ^ ParameterType IntKi IDC__ {:} - - "Index of all bottom DOF" -typedef ^ ParameterType IntKi IDC_Rb {:} - - "Index array of the contraint dofs that are retained/master/follower DOF" -typedef ^ ParameterType IntKi IDC_L {:} - - "Index array of the contraint dofs that are follower/internal DOF" -typedef ^ ParameterType IntKi IDC_F {:} - - "Index array of the contraint dofs that are fixd DOF" -typedef ^ ParameterType IntKi IDR__ {:} - - "Index array of the interface and restraint dofs" -typedef ^ ParameterType IntKi ID__Rb {:} - - "Index array of all the retained/leader/master dofs (from any nodes of the structure)" -typedef ^ ParameterType IntKi ID__L {:} - - "Index array of all the follower/internal dofs (from any nodes of the structure)" -typedef ^ ParameterType IntKi ID__F {:} - - "Index array of the DOF that are fixed (from any nodes of the structure)" -# --- Parameters - Outputs -typedef ^ ParameterType IntKi NMOutputs - - - "Number of members whose output is written" -typedef ^ ParameterType IntKi NumOuts - - - "Number of output channels read from input file" -typedef ^ ParameterType IntKi OutSwtch - - - "Output Requested Channels to local or global output file [1/2/3]" -typedef ^ ParameterType IntKi UnJckF - - - "Unit of SD ouput file" -typedef ^ ParameterType CHARACTER(1) Delim - - - "Column delimiter for output text files" -typedef ^ ParameterType CHARACTER(20) OutFmt - - - "Format for Output" -typedef ^ ParameterType CHARACTER(20) OutSFmt - - - "Format for Output Headers" -typedef ^ ParameterType MeshAuxDataType MoutLst {:} - - "List of user requested members and nodes" -typedef ^ ParameterType MeshAuxDataType MoutLst2 {:} - - "List of all member joint nodes and elements for output" -typedef ^ ParameterType MeshAuxDataType MoutLst3 {:} - - "List of all member joint nodes and elements for output" -typedef ^ ParameterType OutParmType OutParam {:} - - "An array holding names, units, and indices of all of the selected output channels. # logical" -typedef ^ ParameterType LOGICAL OutAll - - - "Flag to output or not all joint forces" -typedef ^ ParameterType LOGICAL OutReact - - - "Flag to check whether reactions are requested" -typedef ^ ParameterType IntKi OutAllInt - - - "Integer version of OutAll" -typedef ^ ParameterType IntKi OutAllDims - - - "Integer version of OutAll" -typedef ^ ParameterType IntKi OutDec - - - "Output Decimation for Requested Channels" -# --- Parametesr - Linearization -typedef ^ ParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - -typedef ^ ParameterType R8Ki du {:} - - "vector that determines size of perturbation for u (inputs)" -typedef ^ ParameterType R8Ki dx {2} - - "vector that determines size of perturbation for x (continuous states)" -typedef ^ ParameterType Integer Jac_ny - - - "number of outputs in jacobian matrix" - -typedef ^ ParameterType Integer Jac_nx - - - "half the number of continuous states in jacobian matrix" - -typedef ^ ParameterType logical RotStates - - - "Orient states in rotating frame during linearization? (flag)" - - -# ============================== Inputs ============================================================================================================================================ -typedef ^ InputType MeshType TPMesh - - - "Transition piece inputs on a point mesh" -typedef ^ InputType MeshType LMesh - - - "Point mesh for interior node inputs" -typedef ^ InputType ReKi CableDeltaL {:} - - "Cable tension, control input" - -# ============================== Outputs ============================================================================================================================================ -typedef ^ OutputType MeshType Y1Mesh - - - "Transition piece outputs on a point mesh" -typedef ^ OutputType MeshType Y2Mesh - - - "Interior+Interface nodes outputs on a point mesh" -typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file" diff --git a/OpenFAST/modules/subdyn/src/SubDyn_Tests.f90 b/OpenFAST/modules/subdyn/src/SubDyn_Tests.f90 deleted file mode 100644 index 138435f85..000000000 --- a/OpenFAST/modules/subdyn/src/SubDyn_Tests.f90 +++ /dev/null @@ -1,549 +0,0 @@ -module SubDyn_Tests - use NWTC_Library - use SubDyn_Types - use SD_FEM - use IntegerList - - implicit none - - public :: SD_Tests - private - - character(len=255),save :: testname - interface test_equal; module procedure & - test_equal_i1, & - test_equal_i0 - end interface - interface test_almost_equal; module procedure & - test_almost_equal_0, & - test_almost_equal_1, & - test_almost_equal_1d, & - test_almost_equal_2, & - test_almost_equal_2d - end interface -contains - - ! -------------------------------------------------------------------------------- - ! --- Helper functions (should be part of NWTC library) - ! -------------------------------------------------------------------------------- - subroutine test_success(info,bPrint_in) - character(len=*), intent(in) :: info - logical, intent(in), optional :: bPrint_in - if(present(bPrint_in)) then - if(bPrint_in) then - write(*,'(A)')'[ OK ] '//trim(testname)//': '//trim(Info) - endif - else - write(*,'(A)')'[ OK ] '//trim(testname)//': '//trim(Info) - endif - end subroutine - - subroutine test_fail(info,bPrint_in,bStop_in) - character(len=*), intent(in) :: info - logical, intent(in), optional :: bPrint_in - logical, intent(in), optional :: bStop_in - if(present(bPrint_in)) then - if(bPrint_in) then - write(*,'(A)')'[FAIL] '//trim(testname)//': '//trim(Info) - endif - else - write(*,'(A)')'[FAIL] '//trim(testname)//': '//trim(Info) - endif - if(present(bStop_in)) then - if(bStop_in) then - STOP - endif - else - STOP - endif - end subroutine - - subroutine test_equal_i0(Var,iTry,iRef) - ! Arguments - character(len=*), intent(in) :: Var - integer, intent(in) :: iTry !< - integer, intent(in) :: iRef !< - ! Variables - character(len=255) :: InfoAbs - if(iRef/=iTry) then - write(InfoAbs,'(A,I0,A,I0)') trim(Var),iRef,'/',iTry - call test_fail(InfoAbs) - STOP - else - write(InfoAbs,'(A,A,I0)') trim(Var),' ok ',iRef - call test_success(InfoAbs) - endif - end subroutine - - subroutine test_equal_i1(Var,VecTry,VecRef,bTest,bPrintOnly,bPassed) - ! Arguments - character(len=*), intent(in) :: Var - integer, dimension(:), intent(in) :: VecTry !< - integer, dimension(:), intent(in) :: VecRef !< - logical, intent(in) :: bTest - logical, intent(in) :: bPrintOnly - logical, intent(out),optional :: bPassed - ! Variables - character(len=255) :: InfoAbs - integer :: i,cpt - ! - cpt=0 - do i=1,size(VecRef) - if(VecRef(i)/=VecTry(i)) then - cpt=cpt+1 - endif - enddo - if(cpt>0) then - write(InfoAbs,'(A,I0)') trim(Var)//' Elements different: ',cpt - if(present(bPassed)) then - bPassed=.false. - endif - else - write(InfoAbs,'(A)') trim(Var)//' reproduced to identity' - if(present(bPassed)) then - bPassed=.true. - endif - endif - if(bPrintOnly) then - print'(A)',trim(InfoAbs) - endif - if(bTest) then - if(cpt>0) then - call test_fail(InfoAbs) - STOP - else - call test_success(InfoAbs) - endif - endif - end subroutine - - subroutine test_almost_equal_0(Var,Ref,Try,MINNORM,bStop,bPrint,bPassed) - ! Arguments - character(len=*), intent(in) :: Var - real(ReKi), intent(in) :: Ref !< - real(ReKi), intent(in) :: Try !< - real(ReKi), intent(in) :: MINNORM - logical, intent(in) :: bStop - logical, intent(in) :: bPrint - logical, intent(out),optional :: bPassed - ! Variables - character(len=255) :: InfoAbs - real(ReKi) :: delta - integer :: cpt - ! - cpt=0 - delta=abs(Ref-Try) - if(delta>MINNORM) then - write(InfoAbs,'(A,ES8.1E2,A,ES8.1E2,A,I0)') trim(Var)//' tol: ',MINNORM,', mean: ',delta,' - Failed:',cpt - call test_fail(InfoAbs,bPrint,bStop) - else - write(InfoAbs,'(A,ES8.1E2,A,ES8.1E2)') trim(Var)//' tol: ',MINNORM,', mean: ',delta - call test_success(InfoAbs,bPrint) - endif - if(present(bPassed)) then - bPassed=delta>MINNORM - endif - end subroutine - subroutine test_almost_equal_1(Var,VecRef,VecTry,MINNORM,bStop,bPrint,bPassed) - ! Arguments - character(len=*), intent(in) :: Var - real(SiKi), dimension(:), intent(in) :: VecRef !< - real(SiKi), dimension(:), intent(in) :: VecTry !< - real(SiKi), intent(in) :: MINNORM - logical, intent(in) :: bStop - logical, intent(in) :: bPrint - logical, intent(out),optional :: bPassed - ! Variables - character(len=255) :: InfoAbs - integer :: i,cpt - real(SiKi) :: delta - real(SiKi) :: delta_cum - ! - cpt=0 - delta_cum=0.0_SiKi - do i=1,size(VecRef,1) - delta=abs(VecRef(i)-VecTry(i)) - delta_cum=delta_cum+delta - if(delta>MINNORM) then - cpt=cpt+1 - endif - enddo - delta_cum=delta_cum/size(VecRef) - - if(cpt>0) then - write(InfoAbs,'(A,ES8.1E2,A,ES8.1E2,A,I0)') trim(Var)//' tol: ',MINNORM,', mean: ',delta_cum,' - Failed:',cpt - call test_fail(InfoAbs,bPrint,bStop) - else - write(InfoAbs,'(A,ES8.1E2,A,ES8.1E2)') trim(Var)//' tol: ',MINNORM,', mean: ',delta_cum - call test_success(InfoAbs,bPrint) - endif - if(present(bPassed)) then - bPassed=(cpt==0) - endif - end subroutine - subroutine test_almost_equal_1d(Var,VecRef,VecTry,MINNORM,bStop,bPrint,bPassed) - ! Arguments - character(len=*), intent(in) :: Var - real(R8Ki), dimension(:), intent(in) :: VecRef !< - real(R8Ki), dimension(:), intent(in) :: VecTry !< - real(R8Ki), intent(in) :: MINNORM - logical, intent(in) :: bStop - logical, intent(in) :: bPrint - logical, intent(out),optional :: bPassed - ! Variables - character(len=255) :: InfoAbs - integer :: i,cpt - real(R8Ki) :: delta - real(R8Ki) :: delta_cum - ! - cpt=0 - delta_cum=0.0_R8Ki - do i=1,size(VecRef,1) - delta=abs(VecRef(i)-VecTry(i)) - delta_cum=delta_cum+delta - if(delta>MINNORM) then - cpt=cpt+1 - endif - enddo - delta_cum=delta_cum/size(VecRef) - - if(cpt>0) then - write(InfoAbs,'(A,ES8.1E2,A,ES8.1E2,A,I0)') trim(Var)//' tol: ',MINNORM,', mean: ',delta_cum,' - Failed:',cpt - call test_fail(InfoAbs,bPrint,bStop) - else - write(InfoAbs,'(A,ES8.1E2,A,ES8.1E2)') trim(Var)//' tol: ',MINNORM,', mean: ',delta_cum - call test_success(InfoAbs,bPrint) - endif - if(present(bPassed)) then - bPassed=(cpt==0) - endif - end subroutine - subroutine test_almost_equal_2(Var,VecRef,VecTry,MINNORM,bStop,bPrint,bPassed) - ! Arguments - character(len=*), intent(in) :: Var - real(SiKi), dimension(:,:), intent(in) :: VecRef !< - real(SiKi), dimension(:,:), intent(in) :: VecTry !< - real(SiKi), intent(in) :: MINNORM - logical, intent(in) :: bStop - logical, intent(in) :: bPrint - logical, intent(out),optional :: bPassed - ! Variables - real(SiKi), dimension(:),allocatable :: VecRef2 !< - real(SiKi), dimension(:),allocatable :: VecTry2 !< - integer :: p, i,j,n1,n2,nCPs - ! - n1 = size(VecRef,1); n2 = size(VecRef,2); nCPs=n1*n2 - allocate ( VecRef2 (n1*n2) ) ; allocate ( VecTry2 (n1*n2) ) - p=0 - do j=1,n2; do i=1,n1 - p=p+1 - VecRef2(p)=VecRef(i,j) - VecTry2(p)=VecTry(i,j) - enddo; enddo; - call test_almost_equal(Var,VecRef2,VecTry2,MINNORM,bStop,bPrint,bPassed) - end subroutine - subroutine test_almost_equal_2d(Var,VecRef,VecTry,MINNORM,bStop,bPrint,bPassed) - ! Arguments - character(len=*), intent(in) :: Var - real(R8Ki), dimension(:,:), intent(in) :: VecRef !< - real(R8Ki), dimension(:,:), intent(in) :: VecTry !< - real(R8Ki), intent(in) :: MINNORM - logical, intent(in) :: bStop - logical, intent(in) :: bPrint - logical, intent(out),optional :: bPassed - ! Variables - real(R8Ki), dimension(:),allocatable :: VecRef2 !< - real(R8Ki), dimension(:),allocatable :: VecTry2 !< - integer :: p, i,j,n1,n2,nCPs - ! - n1 = size(VecRef,1); n2 = size(VecRef,2); nCPs=n1*n2 - allocate ( VecRef2 (n1*n2) ) ; allocate ( VecTry2 (n1*n2) ) - p=0 - do j=1,n2; do i=1,n1 - p=p+1 - VecRef2(p)=VecRef(i,j) - VecTry2(p)=VecTry(i,j) - enddo; enddo; - call test_almost_equal(Var,VecRef2,VecTry2,MINNORM,bStop,bPrint,bPassed) - end subroutine - - - - ! --------------------------------------------------------------------------------} - ! --- Specific SubDyn tests - ! --------------------------------------------------------------------------------{ - subroutine Test_CB_Results(MBBt, MBMt, KBBt, OmegaM, DOFTP, DOFM, ErrStat, ErrMsg) - INTEGER(IntKi) :: DOFTP, DOFM - REAL(ReKi) :: MBBt(DOFTP, DOFTP) - REAL(ReKi) :: MBmt(DOFTP, DOFM) - REAL(ReKi) :: KBBt(DOFTP, DOFTP) - REAL(ReKi) :: OmegaM(DOFM) - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: DOFT, NM, i - REAL(ReKi), Allocatable :: OmegaCB(:), PhiCB(:, :) - REAL(ReKi), Allocatable :: K(:, :) - REAL(ReKi), Allocatable :: M(:, :) - Character(1024) :: rootname - ErrStat = ErrID_None - ErrMsg = '' - print*,'This test is not a unit test' - - DOFT = DOFTP + DOFM - NM = DOFT - 3 - Allocate( OmegaCB(NM), K(DOFT, DOFT), M(DOFT, DOFT), PhiCB(DOFT, NM) ) - K = 0.0 - M = 0.0 - OmegaCB = 0.0 - PhiCB = 0.0 - - M(1:DOFTP, 1:DOFTP) = MBBt - M(1:DOFTP, (DOFTP+1):DOFT ) = MBMt - M((DOFTP+1):DOFT, 1:DOFTP ) = transpose(mbmt) - - DO i = 1, DOFM - K(DOFTP+i, DOFTP+i) = OmegaM(i)*OmegaM(i) - M(DOFTP+i, DOFTP+i) = 1.0 - ENDDO - - K(1:DOFTP, 1:DOFTP) = KBBt - - ! temporary rootname - rootname = './test_assemble_C-B_out' - - ! NOTE: Eigensolve is in SubDyn - !CALL EigenSolve(K, M, DOFT, NM,.False.,Init,p, PhiCB, OmegaCB, ErrStat, ErrMsg) - IF ( ErrStat /= 0 ) RETURN - end subroutine Test_CB_Results - - !> Transformation matrices tests - subroutine Test_Transformations(ErrStat,ErrMsg) - integer(IntKi) , intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg - - real(ReKi), dimension(3) :: P1, P2, e1, e2, e3 - real(FEKi), dimension(3,3) :: DirCos, Ref - real(ReKi), dimension(6,6) :: T, Tref - real(ReKi) :: L - integer(IntKi) :: I - testname='Transf' - - ! --- DirCos - P1=(/0,0,0/) - P2=(/2,0,0/) - call GetDirCos(P1, P2, DirCos, L, ErrStat, ErrMsg) - Ref = reshape( (/0_FEKi,-1_FEKi,0_FEKi, 0_FEKi, 0_FEKi, -1_FEKi, 1_FEKi, 0_FEKi, 0_FEKi/) , (/3,3/)) - call test_almost_equal('DirCos',Ref,DirCos,1e-8_FEKi,.true.,.true.) - - ! --- Rigid Transo - P1=(/1,2,-1/) - P2=(/2,5,5/) - call GetRigidTransformation(P1, P2, T, ErrStat, ErrMsg) - Tref = 0; do I=1,6; Tref(I,I) =1_ReKi; enddo - Tref(1,5) = 6._ReKi; Tref(1,6) =-3._ReKi; - Tref(2,4) =-6._ReKi; Tref(2,6) = 1._ReKi; - Tref(3,4) = 3._ReKi; Tref(3,5) =-1._ReKi; - call test_almost_equal('TRigid',Tref,T,1e-8_ReKi,.true.,.true.) - - - ! --- Orthogonal vectors - e1 = (/10,0,0/) - call GetOrthVectors(e1,e2,e3,ErrStat, ErrMsg) - call test_almost_equal('orth',e2,(/0._ReKi,0._ReKi,-1._ReKi/),1e-8_ReKi,.true.,.true.) - call test_almost_equal('orth',e3,(/0._ReKi,1._ReKi, 0._ReKi/),1e-8_ReKi,.true.,.true.) - e1 = (/0,10,0/) - call GetOrthVectors(e1,e2,e3,ErrStat, ErrMsg) - call test_almost_equal('orth',e2,(/0._ReKi,0._ReKi, 1._ReKi/),1e-8_ReKi,.true.,.true.) - call test_almost_equal('orth',e3,(/1._ReKi,0._ReKi, 0._ReKi/),1e-8_ReKi,.true.,.true.) - e1 = (/1,2,4/) - call GetOrthVectors(e1,e2,e3,ErrStat, ErrMsg) - call test_almost_equal('dot', 0._ReKi, dot_product(e1,e2), 1e-8_ReKi, .true., .true.) - call test_almost_equal('dot', 0._ReKi, dot_product(e1,e3), 1e-8_ReKi, .true., .true.) - end subroutine Test_Transformations - - - !> Linear algebra tests - subroutine Test_Linalg(ErrStat,ErrMsg) - integer(IntKi) , intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg - real(FEKi), dimension(:,:), allocatable :: A, Ainv, Aref - real(DbKi) :: det - testname='Linalg' - - ! --- Determinant of a singular matrix - ! Commented since might lead to floating invalid - !allocate(A(3,3)); - !A(1,1) = 0 ; A(1,2) = 0 ; A(1,3) = 1 ; - !A(2,1) = 0 ; A(2,2) = 0 ; A(2,3) = -1 ; - !A(3,1) =-3 ; A(3,2) = 4 ; A(3,3) = -2 ; - !det = Determinant(A,ErrStat, ErrMsg) - !call test_almost_equal('Det of singular 3x3 matrix', real(det,ReKi), 0.0_ReKi, 1e-8_ReKi, .true. , .true.) - !deallocate(A ) - - ! --- Inverse and determinant of a 3x3 matrix - allocate(A(3,3)); allocate(Aref(3,3)) - A(1,1) = 7 ; A(1,2) = 2 ; A(1,3) = 1 ; - A(2,1) = 0 ; A(2,2) = 3 ; A(2,3) = -1 ; - A(3,1) =-3 ; A(3,2) = 4 ; A(3,3) = -2 ; - Aref(1,1) =-2 ; Aref(1,2) = 8 ; Aref(1,3) = -5 ; - Aref(2,1) = 3 ; Aref(2,2) =-11; Aref(2,3) = 7 ; - Aref(3,1) = 9 ; Aref(3,2) =-34; Aref(3,3) = 21; - call PseudoInverse(A, Ainv, ErrStat, ErrMsg) - ! Determinant test - det = Determinant(A,ErrStat, ErrMsg) - call test_almost_equal('Det of 3x3 matrix', real(det,ReKi), 1.0_ReKi, 1e-8_ReKi, .true. , .true.) - det = Determinant(Ainv,ErrStat, ErrMsg) - call test_almost_equal('Det of 3x3 matrix', real(det,ReKi), 1.0_ReKi, 1e-8_ReKi, .true. , .true.) - ! Inverse test - call test_almost_equal('Inverse of 3x3 matrix', real(Aref,ReKi), real(Ainv,ReKi), 1e-8_ReKi, .true., .true.) - deallocate(A ) - deallocate(Ainv) - deallocate(Aref) - - ! --- Inverse of a 3x6 matrix - allocate(A(3,6)) - allocate(Aref(6,3)) - A(1,:) = (/ 0, 1, 2, 0, 1, 2 /) - A(2,:) = (/ -1, 1, 2, -0, 0, 0 /) - A(3,:) = (/ -0, 0, 0, -1, 1, 2 /) - Aref(:,:) = transpose(reshape( (/ 0.500000, -0.583333, -0.416667, 0.100000, 0.083333, -0.083333 , 0.200000, 0.166667, -0.166667 , 0.500000, -0.416667, -0.583333 , 0.100000, -0.083333, 0.083333 , 0.200000, -0.166667, 0.166667 /), (/ 3, 6 /))) - call PseudoInverse(A, Ainv, ErrStat, ErrMsg) - call test_almost_equal('Inverse of 3x6 matrix', real(Aref,ReKi), real(Ainv,ReKi), 1e-6_ReKi, .true., .true.) - deallocate(A ) - deallocate(Ainv) - deallocate(Aref) - - ! --- Inverse of a 6x3 matrix - allocate(A(6,3)) - allocate(Aref(3,6)) - A(:,1) = (/ 0, 1, 2, 0, 1, 2 /) - A(:,2) = (/ -1, 1, 2, -0, 0, 0 /) - A(:,3) = (/ -0, 0, 0, -1, 1, 2 /) - Aref(:,:) = reshape( (/ 0.500000, -0.583333, -0.416667, 0.100000, 0.083333, -0.083333 , 0.200000, 0.166667, -0.166667 , 0.500000, -0.416667, -0.583333 , 0.100000, -0.083333, 0.083333 , 0.200000, -0.166667, 0.166667 /), (/ 3, 6 /)) - call PseudoInverse(A, Ainv, ErrStat, ErrMsg) - call test_almost_equal('Inverse of 6x3 matrix', real(Aref,ReKi), real(Ainv,ReKi), 1e-6_ReKi, .true., .true.) - end subroutine Test_Linalg - - !> Series of tests for integer lists - subroutine Test_lists(ErrStat,ErrMsg) - integer(IntKi) , intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg - type(IList) :: L1 - type(IList) :: L2 - integer(IntKi) :: e - ErrStat = ErrID_None - ErrMsg = "" - testname='Lists' - - call init_list(L1, 0, 0 ,ErrStat, ErrMsg) - call init_list(L2, 10, 12,ErrStat, ErrMsg) - - ! test len - call test_equal('length',0 ,len(L1)) - call test_equal('length',10,len(L2)) - - ! test append - call append(L1, 5, ErrStat, ErrMsg) - call append(L1, 3, ErrStat, ErrMsg) - call append(L1, 1, ErrStat, ErrMsg) - call test_equal('appnd',L1%List, (/5,3,1/) , .true. , .false.) - - ! test get - call test_equal('get ',get(L1,2, ErrStat, ErrMsg), 3) - e = get(L1,0, ErrStat, ErrMsg) - call test_equal('get <0 ', ErrStat, ErrID_Fatal) - e = get(L1,7, ErrStat, ErrMsg) - call test_equal('get >n ', ErrStat, ErrID_Fatal) - - ! test sort - call sort(L1, ErrStat, ErrMsg) - call test_equal('sort ',L1%List, (/1,3,5/) , .true. , .false.) - - ! test reverse - call reverse(L1, ErrStat, ErrMsg) - call test_equal('rev ',L1%List, (/5,3,1/) , .true. , .false.) - - ! test pop - e = pop(L1, ErrStat, ErrMsg) - call test_equal('pop ',e , 1) - e = pop(L1, ErrStat, ErrMsg) - call test_equal('pop ',e , 3) - e = pop(L1, ErrStat, ErrMsg) - call test_equal('pop ',e , 5) - call destroy_list(L1, ErrStat, ErrMsg) - - ! test unique - call init_list(L1,(/5,3,2,3,8/),ErrStat, ErrMsg) - call unique(L1, ErrStat, ErrMsg) - call test_equal('uniq ',L1%List, (/5,3,2,8/) , .true. , .false.) - - call destroy_list(L1, ErrStat, ErrMsg) - call destroy_list(L2, ErrStat, ErrMsg) - end subroutine Test_lists - - !> Test CheckBoard (from FEM), useful for joint stiffness - subroutine Test_ChessBoard(ErrStat,ErrMsg) - integer(IntKi) , intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg - real(ReKi), dimension(:,:), allocatable :: M, Mref - ErrStat = ErrID_None - ErrMsg = "" - testname='ChessBoard' - allocate(M(1:6,1:6), Mref(1:6,1:6)) - ! Typical example for pin joint Stiffness add - Mref(1 , :)= (/4 , -1 , -1 , -1 , -1, -1/) - Mref(2 , :)= (/-1 , 4 , -1 , -1 , -1, -1/) - Mref(3 , :)= (/-1 , -1 , 4 , -1 , -1, -1/) - Mref(4 , :)= (/-1 , -1 , -1 , 4 , -1, -1/) - Mref(5 , :)= (/-1 , -1 , -1 , -1 , 4, -1/) - Mref(6 , :)= (/-1 , -1 , -1 , -1 , -1, 4/) - call ChessBoard(M, -1._ReKi, -10._ReKi, nSpace=0, diagVal=4._ReKi) - call test_almost_equal('ChessBoardPin', Mref, M, 1e-6_ReKi, .true., .true.) - - ! Typical example for universal joint Stiffness add - Mref=0.0_ReKi - Mref(1 , :)= (/2 , 0 , -1 , 0 , -1, 0 /) - Mref(2 , :)= (/0 , 2 , 0 , -1 , 0, -1 /) - Mref(3 , :)= (/-1 , 0 , 2 , 0 , -1, 0 /) - Mref(4 , :)= (/ 0 , -1 , 0 , 2 , 0, -1 /) - Mref(5 , :)= (/-1 , 0 , -1 , 0 , 2, 0 /) - Mref(6 , :)= (/ 0 , -1 , 0 , -1 , 0, 2 /) - call ChessBoard(M, -1._ReKi, 0._ReKi, nSpace=1, diagVal=2._ReKi) - call test_almost_equal('ChessBoardUnv', Mref, M, 1e-6_ReKi, .true., .true.) - - ! Typical example for ball joint Stiffness add - Mref(1 , :)= (/ 1 , 0 , 0 , -1 , 0, 0 /) - Mref(2 , :)= (/ 0 , 1 , 0 , 0 , -1, 0 /) - Mref(3 , :)= (/ 0 , 0 , 1 , 0 , 0, -1 /) - Mref(4 , :)= (/-1 , 0 , 0 , 1 , 0, 0 /) - Mref(5 , :)= (/ 0 , -1 , 0 , 0 , 1, 0 /) - Mref(6 , :)= (/ 0 , 0 , -1 , 0 , 0, 1 /) - call ChessBoard(M, -1._ReKi, 0._ReKi, nSpace=2, diagVal=1._ReKi) - call test_almost_equal('ChessBoardBll', Mref, M, 1e-6_ReKi, .true., .true.) - - deallocate(M,Mref) - end subroutine Test_ChessBoard - - subroutine SD_Tests(ErrStat,ErrMsg) - integer(IntKi) , intent(out) :: ErrStat !< Error status of the operation - character(ErrMsgLen), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - - call Test_lists(ErrStat2, ErrMsg2); if(Failed()) return - call Test_Transformations(ErrStat2, ErrMsg2); if(Failed()) return - call Test_Linalg(ErrStat2, ErrMsg2); if(Failed()) return - call Test_ChessBoard(ErrStat2, ErrMsg2); if(Failed()) return - contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_Tests') - Failed = ErrStat >= AbortErrLev - end function failed - end subroutine SD_Tests - - -end module SubDyn_Tests diff --git a/OpenFAST/modules/subdyn/src/SubDyn_Types.f90 b/OpenFAST/modules/subdyn/src/SubDyn_Types.f90 deleted file mode 100644 index 6a0d60bda..000000000 --- a/OpenFAST/modules/subdyn/src/SubDyn_Types.f90 +++ /dev/null @@ -1,12464 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'SubDyn_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 -!********************************************************************************************************************************* -! SubDyn_Types -!................................................................................................................................. -! This file is part of SubDyn. -! -! 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 SubDyn. 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 SubDyn_Types -!--------------------------------------------------------------------------------------------------------------------------------- -USE NWTC_Library -IMPLICIT NONE -! ========= IList ======= - TYPE, PUBLIC :: IList - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: List !< List of integers [-] - END TYPE IList -! ======================= -! ========= MeshAuxDataType ======= - TYPE, PUBLIC :: MeshAuxDataType - INTEGER(IntKi) :: MemberID !< Member ID for Output [-] - INTEGER(IntKi) :: NOutCnt !< Number of Nodes for the output member [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeCnt !< Node ordinal numbers for the output member [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeIDs !< Node IDs associated with ordinal numbers for the output member [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ElmIDs !< Element IDs connected to each NodeIDs; max 10 elements [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ElmNds !< Flag to indicate 1st or 2nd node of element for each ElmIDs [-] - REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: Me !< Mass matrix connected to each joint element for outAll output [-] - REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: Ke !< Mass matrix connected to each joint element for outAll output [-] - REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: Fg !< Gravity load vector connected to each joint element for requested member output [-] - END TYPE MeshAuxDataType -! ======================= -! ========= CB_MatArrays ======= - TYPE, PUBLIC :: CB_MatArrays - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: MBB !< FULL MBB ( no constraints applied) [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: MBM !< FULL MBM ( no constraints applied) [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: KBB !< FULL KBB ( no constraints applied) [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: PhiL !< Retained CB modes, possibly allPhiL(nDOFL,nDOFL), or PhiL(nDOFL,nDOFM) [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: PhiR !< FULL PhiR ( no constraints applied) [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: OmegaL !< Eigenvalues of retained CB modes, possibly all (nDOFL or nDOFM) [-] - END TYPE CB_MatArrays -! ======================= -! ========= ElemPropType ======= - TYPE, PUBLIC :: ElemPropType - INTEGER(IntKi) :: eType !< Element Type [-] - REAL(ReKi) :: Length !< Length of an element [-] - REAL(ReKi) :: Ixx !< Moment of inertia of an element [-] - REAL(ReKi) :: Iyy !< Moment of inertia of an element [-] - REAL(ReKi) :: Jzz !< Moment of inertia of an element [-] - LOGICAL :: Shear !< Use timoshenko (true) E-B (false) [-] - REAL(ReKi) :: Kappa !< Shear coefficient [-] - REAL(ReKi) :: YoungE !< Young's modulus [-] - REAL(ReKi) :: ShearG !< Shear modulus [N/m^2] - REAL(ReKi) :: Area !< Area of an element [m^2] - REAL(ReKi) :: Rho !< Density [kg/m^3] - REAL(ReKi) :: T0 !< Pretension [N] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: DirCos !< Element direction cosine matrix [-] - END TYPE ElemPropType -! ======================= -! ========= SD_InitInputType ======= - TYPE, PUBLIC :: SD_InitInputType - CHARACTER(1024) :: SDInputFile !< Name of the input file [-] - CHARACTER(1024) :: RootName !< SubDyn rootname [-] - REAL(ReKi) :: g !< Gravity acceleration [-] - REAL(ReKi) :: WtrDpth !< Water Depth (positive valued) [-] - REAL(ReKi) , DIMENSION(1:3) :: TP_RefPoint !< global position of transition piece reference point (could also be defined in SubDyn itself) [-] - REAL(ReKi) :: SubRotateZ !< Rotation angle in degrees about global Z [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SoilStiffness !< Soil stiffness matrices from SoilDyn ['(N/m,] - TYPE(MeshType) :: SoilMesh !< Mesh for soil stiffness locations [-] - LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] - END TYPE SD_InitInputType -! ======================= -! ========= SD_InitOutputType ======= - TYPE, PUBLIC :: SD_InitOutputType - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] - TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] - CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_x !< Names of the continuous states used in linearization [-] - CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_y !< Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_x !< Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame (not used for glue) [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization [-] - END TYPE SD_InitOutputType -! ======================= -! ========= SD_InitType ======= - TYPE, PUBLIC :: SD_InitType - CHARACTER(1024) :: RootName !< SubDyn rootname [-] - REAL(ReKi) , DIMENSION(1:3) :: TP_RefPoint !< global position of transition piece reference point (could also be defined in SubDyn itself) [-] - REAL(ReKi) :: SubRotateZ !< Rotation angle in degrees about global Z [-] - REAL(ReKi) :: g !< Gravity acceleration [-] - REAL(DbKi) :: DT !< Time step from Glue Code [seconds] - INTEGER(IntKi) :: NJoints !< Number of joints of the sub structure [-] - INTEGER(IntKi) :: NPropSetsX !< Number of extended property sets [-] - INTEGER(IntKi) :: NPropSetsB !< Number of property sets for beams [-] - INTEGER(IntKi) :: NPropSetsC !< Number of property sets for cables [-] - INTEGER(IntKi) :: NPropSetsR !< Number of property sets for rigid links [-] - INTEGER(IntKi) :: NCMass !< Number of joints with concentrated mass [-] - INTEGER(IntKi) :: NCOSMs !< Number of independent cosine matrices [-] - INTEGER(IntKi) :: FEMMod !< FEM switch element model in the FEM [-] - INTEGER(IntKi) :: NDiv !< Number of divisions for each member [-] - LOGICAL :: CBMod !< Perform C-B flag [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Joints !< Joints number and coordinate values [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsB !< Property sets number and values [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsC !< Property ID and values for cables [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsR !< Property ID and values for rigid link [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsX !< Extended property sets [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: COSMs !< Independent direction cosine matrices [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CMass !< Concentrated mass information [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: JDampings !< Damping coefficients for internal modes [-] - INTEGER(IntKi) :: GuyanDampMod !< Guyan damping [0=none, 1=Rayleigh Damping, 2= user specified 6x6 matrix] [-] - REAL(ReKi) , DIMENSION(1:2) :: RayleighDamp !< Mass and stiffness proportional damping coefficients (Rayleigh Damping) [only if GuyanDampMod=1] [-] - REAL(ReKi) , DIMENSION(1:6,1:6) :: GuyanDampMat !< Guyan Damping Matrix, see also CBB [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Members !< Member joints connection [-] - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: SSOutList !< List of Output Channels [-] - LOGICAL :: OutCOSM !< Output Cos-matrices Flag [-] - LOGICAL :: TabDelim !< Generate a tab-delimited output file in OutJckF-Flag [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: SSIK !< SSI stiffness packed matrix elements (21 of them), for each reaction joint [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: SSIM !< SSI mass packed matrix elements (21 of them), for each reaction joint [-] - CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: SSIfile !< Soil Structure Interaction (SSI) files to associate with each reaction node [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Soil_K !< Soil stiffness (at passed at Init, not in input file) 6x6xn [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Soil_Points !< Node positions where soil stiffness will be added [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: Soil_Nodes !< Node indices where soil stiffness will be added [-] - INTEGER(IntKi) :: NElem !< Total number of elements [-] - INTEGER(IntKi) :: NPropB !< Total number of property sets for Beams [-] - INTEGER(IntKi) :: NPropC !< Total number of property sets for Cable [-] - INTEGER(IntKi) :: NPropR !< Total number of property sets for Rigid [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Nodes !< Nodes number and coordinates [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropsB !< Property sets and values for Beams [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropsC !< Property sets and values for Cable [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropsR !< Property sets and values for Rigid link [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: K !< System stiffness matrix [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: M !< System mass matrix [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ElemProps !< Element properties(A, L, Ixx, Iyy, Jzz, Shear, Kappa, E, G, Rho, DirCos(1,1), DirCos(2, 1), ....., DirCos(3, 3) ) [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: MemberNodes !< Member number and list of nodes making up a member (>2 if subdivided) [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: NodesConnN !< Nodes that connect to a common node [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: NodesConnE !< Elements that connect to a common node [-] - LOGICAL :: SSSum !< SubDyn Summary File Flag [-] - END TYPE SD_InitType -! ======================= -! ========= SD_ContinuousStateType ======= - TYPE, PUBLIC :: SD_ContinuousStateType - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: qm !< Virtual states, Nmod elements [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: qmdot !< Derivative of states, Nmod elements [-] - END TYPE SD_ContinuousStateType -! ======================= -! ========= SD_DiscreteStateType ======= - TYPE, PUBLIC :: SD_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] - END TYPE SD_DiscreteStateType -! ======================= -! ========= SD_ConstraintStateType ======= - TYPE, PUBLIC :: SD_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] - END TYPE SD_ConstraintStateType -! ======================= -! ========= SD_OtherStateType ======= - TYPE, PUBLIC :: SD_OtherStateType - TYPE(SD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: xdot !< previous state derivs for m-step time integrator [-] - INTEGER(IntKi) :: n !< tracks time step for which OtherState was updated last [-] - END TYPE SD_OtherStateType -! ======================= -! ========= SD_MiscVarType ======= - TYPE, PUBLIC :: SD_MiscVarType - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: qmdotdot !< 2nd Derivative of states, used only for output-file purposes [-] - REAL(ReKi) , DIMENSION(1:6) :: u_TP - REAL(ReKi) , DIMENSION(1:6) :: udot_TP - REAL(ReKi) , DIMENSION(1:6) :: udotdot_TP - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar_dot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar_dotdot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_dot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_dotdot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DU_full !< Delta U used for extra moment [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_dot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_dotdot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_elast !< Elastic displacements for computation of K ue (without rigid body mode for floating) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_red - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_red_dot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_red_dotdot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FC_unit !< Cable Force vector (for varying cable load, of unit cable load) [N] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SDWrOutput !< Data from previous step to be written to a SubDyn output file [-] - REAL(DbKi) :: LastOutTime !< The time of the most recent stored output data [s] - INTEGER(IntKi) :: Decimat !< Current output decimation counter [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext !< External loads on unconstrained DOFs [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext_red !< External loads on constrained DOFs, Fext_red= T^t Fext [-] - END TYPE SD_MiscVarType -! ======================= -! ========= SD_ParameterType ======= - TYPE, PUBLIC :: SD_ParameterType - REAL(DbKi) :: SDDeltaT !< Time step (for integration of continuous states) [seconds] - INTEGER(IntKi) :: IntMethod !< Integration Method (1/2/3)Length of y2 array [-] - INTEGER(IntKi) :: nDOF !< Total degree of freedom [-] - INTEGER(IntKi) :: nDOF_red !< Total degree of freedom after constraint reduction [-] - INTEGER(IntKi) :: Nmembers !< Number of members of the sub structure [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Elems !< Element nodes connections [-] - TYPE(ElemPropType) , DIMENSION(:), ALLOCATABLE :: ElemProps !< List of element properties [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: FG !< Gravity force vector (with initial cable force T0), not reduced [N] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DP0 !< Vector from TP to a Node at t=0, used for Floating Rigid Body motion [m] - LOGICAL :: reduced !< True if system has been reduced to account for constraints [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: T_red !< Transformation matrix performing the constraint reduction x = T. xtilde [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: T_red_T !< Transpose of T_red [-] - TYPE(IList) , DIMENSION(:), ALLOCATABLE :: NodesDOF !< DOF indices of each nodes in unconstrained assembled system [-] - TYPE(IList) , DIMENSION(:), ALLOCATABLE :: NodesDOFred !< DOF indices of each nodes in constrained assembled system [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ElemsDOF !< 12 DOF indices of node 1 and 2 of a given member in unconstrained assembled system [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: DOFred2Nodes !< nDOFRed x 3, for each constrained DOF, col1 node index, col2 number of DOF, col3 DOF starting from 1 [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CtrlElem2Channel !< nCtrlCable x 2, for each CtrlCable, Elem index, and Channel Index [-] - INTEGER(IntKi) :: nDOFM !< retained degrees of freedom (modes) [-] - INTEGER(IntKi) :: SttcSolve !< Solve dynamics about static equilibrium point (flag) [-] - LOGICAL :: GuyanLoadCorrection !< Add Extra lever arm contribution to interface reaction outputs [-] - LOGICAL :: Floating !< True if floating bottom (the 6 DOF are free at all reaction nodes) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: KMMDiag !< Diagonal coefficients of Kmm (OmegaM squared) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CMMDiag !< Diagonal coefficients of Cmm (~2 Zeta OmegaM)) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MMB !< Matrix after C-B reduction (transpose of MBM [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MBmmB !< MBm * MmB, used for Y1 [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C1_11 !< Coefficient of x in Y1 [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C1_12 !< Coefficient of x in Y1 [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: D1_141 !< MBm PhiM^T [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: D1_142 !< TI^T PhiR^T [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PhiM !< Coefficient of x in Y2 [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C2_61 !< Coefficient of x in Y2 (URdotdot ULdotdot) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C2_62 !< Coefficient of x in Y2 (URdotdot ULdotdot) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PhiRb_TI !< Coefficient of u in Y2 (Phi_R bar * TI) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: D2_63 !< Coefficient of u in Y2 (URdotdot ULdotdot) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: D2_64 !< Coefficient of u in Y2 (URdotdot ULdotdot) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MBB !< Guyan Mass Matrix after C-B reduction [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: KBB !< Guyan Stiffness Matrix after C-B reduction [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CBB !< Guyan Damping Matrix after C-B reduction [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CMM !< CB damping matrix [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MBM !< Matrix after C-B reduction [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PhiL_T !< Transpose of Matrix of C-B modes [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PhiLInvOmgL2 !< Matrix of C-B modes times the inverse of OmegaL**2 (Phi_L*(Omg**2)^-1) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: KLLm1 !< KLL^{-1}, inverse of matrix KLL, for static solve only [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AM2Jac !< Jacobian (factored) for Adams-Boulton 2nd order Integration [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: AM2JacPiv !< Pivot array for Jacobian factorization (for Adams-Boulton 2nd order Integration) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI !< Matrix to calculate TP reference point reaction at top of structure [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TIreact !< Matrix to calculate single point reaction at base of structure [-] - INTEGER(IntKi) :: nNodes !< Total number of nodes [-] - INTEGER(IntKi) :: nNodes_I !< Number of Interface nodes [-] - INTEGER(IntKi) :: nNodes_L !< Number of Internal nodes [-] - INTEGER(IntKi) :: nNodes_C !< Number of joints with reactions [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Nodes_I !< Interface degree of freedoms [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Nodes_L !< Internal nodes (not interface nor reaction) [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Nodes_C !< React degree of freedoms [-] - INTEGER(IntKi) :: nDOFI__ !< Size of IDI__ [-] - INTEGER(IntKi) :: nDOFI_Rb !< Size of IDI_Rb [-] - INTEGER(IntKi) :: nDOFI_F !< Size of IDI_F [-] - INTEGER(IntKi) :: nDOFL_L !< Size of IDL_L [-] - INTEGER(IntKi) :: nDOFC__ !< Size of IDC__ [-] - INTEGER(IntKi) :: nDOFC_Rb !< Size of IDC_Rb [-] - INTEGER(IntKi) :: nDOFC_L !< Size of IDC_L [-] - INTEGER(IntKi) :: nDOFC_F !< Size of IDC_F [-] - INTEGER(IntKi) :: nDOFR__ !< Size of IDR__ [-] - INTEGER(IntKi) :: nDOF__Rb !< Size of ID__Rb [-] - INTEGER(IntKi) :: nDOF__L !< Size of ID__L [-] - INTEGER(IntKi) :: nDOF__F !< Size of ID__F [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDI__ !< Index of all Interface DOFs [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDI_Rb !< Index array of the interface (nodes connect to TP) dofs that are retained/master/follower DOFs [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDI_F !< Index array of the interface (nodes connect to TP) dofs that are fixed DOF [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDL_L !< Index array of the internal dofs coming from internal nodes [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDC__ !< Index of all bottom DOF [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDC_Rb !< Index array of the contraint dofs that are retained/master/follower DOF [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDC_L !< Index array of the contraint dofs that are follower/internal DOF [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDC_F !< Index array of the contraint dofs that are fixd DOF [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDR__ !< Index array of the interface and restraint dofs [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ID__Rb !< Index array of all the retained/leader/master dofs (from any nodes of the structure) [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ID__L !< Index array of all the follower/internal dofs (from any nodes of the structure) [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ID__F !< Index array of the DOF that are fixed (from any nodes of the structure) [-] - INTEGER(IntKi) :: NMOutputs !< Number of members whose output is written [-] - INTEGER(IntKi) :: NumOuts !< Number of output channels read from input file [-] - INTEGER(IntKi) :: OutSwtch !< Output Requested Channels to local or global output file [1/2/3] [-] - INTEGER(IntKi) :: UnJckF !< Unit of SD ouput file [-] - CHARACTER(1) :: Delim !< Column delimiter for output text files [-] - CHARACTER(20) :: OutFmt !< Format for Output [-] - CHARACTER(20) :: OutSFmt !< Format for Output Headers [-] - TYPE(MeshAuxDataType) , DIMENSION(:), ALLOCATABLE :: MoutLst !< List of user requested members and nodes [-] - TYPE(MeshAuxDataType) , DIMENSION(:), ALLOCATABLE :: MoutLst2 !< List of all member joint nodes and elements for output [-] - TYPE(MeshAuxDataType) , DIMENSION(:), ALLOCATABLE :: MoutLst3 !< List of all member joint nodes and elements for output [-] - TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< An array holding names, units, and indices of all of the selected output channels. logical [-] - LOGICAL :: OutAll !< Flag to output or not all joint forces [-] - LOGICAL :: OutReact !< Flag to check whether reactions are requested [-] - INTEGER(IntKi) :: OutAllInt !< Integer version of OutAll [-] - INTEGER(IntKi) :: OutAllDims !< Integer version of OutAll [-] - INTEGER(IntKi) :: OutDec !< Output Decimation for Requested Channels [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] - REAL(R8Ki) , DIMENSION(1:2) :: dx !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] - INTEGER(IntKi) :: Jac_nx !< half the number of continuous states in jacobian matrix [-] - LOGICAL :: RotStates !< Orient states in rotating frame during linearization? (flag) [-] - END TYPE SD_ParameterType -! ======================= -! ========= SD_InputType ======= - TYPE, PUBLIC :: SD_InputType - TYPE(MeshType) :: TPMesh !< Transition piece inputs on a point mesh [-] - TYPE(MeshType) :: LMesh !< Point mesh for interior node inputs [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CableDeltaL !< Cable tension, control input [-] - END TYPE SD_InputType -! ======================= -! ========= SD_OutputType ======= - TYPE, PUBLIC :: SD_OutputType - TYPE(MeshType) :: Y1Mesh !< Transition piece outputs on a point mesh [-] - TYPE(MeshType) :: Y2Mesh !< Interior+Interface nodes outputs on a point mesh [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file [-] - END TYPE SD_OutputType -! ======================= -CONTAINS - SUBROUTINE SD_CopyIList( SrcIListData, DstIListData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IList), INTENT(IN) :: SrcIListData - TYPE(IList), INTENT(INOUT) :: DstIListData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyIList' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcIListData%List)) THEN - i1_l = LBOUND(SrcIListData%List,1) - i1_u = UBOUND(SrcIListData%List,1) - IF (.NOT. ALLOCATED(DstIListData%List)) THEN - ALLOCATE(DstIListData%List(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIListData%List.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstIListData%List = SrcIListData%List -ENDIF - END SUBROUTINE SD_CopyIList - - SUBROUTINE SD_DestroyIList( IListData, ErrStat, ErrMsg ) - TYPE(IList), INTENT(INOUT) :: IListData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyIList' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(IListData%List)) THEN - DEALLOCATE(IListData%List) -ENDIF - END SUBROUTINE SD_DestroyIList - - SUBROUTINE SD_PackIList( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IList), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackIList' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! List allocated yes/no - IF ( ALLOCATED(InData%List) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! List upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%List) ! List - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%List) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%List,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%List,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%List,1), UBOUND(InData%List,1) - IntKiBuf(Int_Xferred) = InData%List(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackIList - - SUBROUTINE SD_UnPackIList( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IList), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackIList' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! List not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%List)) DEALLOCATE(OutData%List) - ALLOCATE(OutData%List(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%List.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%List,1), UBOUND(OutData%List,1) - OutData%List(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackIList - - SUBROUTINE SD_CopyMeshAuxDataType( SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MeshAuxDataType), INTENT(IN) :: SrcMeshAuxDataTypeData - TYPE(MeshAuxDataType), INTENT(INOUT) :: DstMeshAuxDataTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyMeshAuxDataType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMeshAuxDataTypeData%MemberID = SrcMeshAuxDataTypeData%MemberID - DstMeshAuxDataTypeData%NOutCnt = SrcMeshAuxDataTypeData%NOutCnt -IF (ALLOCATED(SrcMeshAuxDataTypeData%NodeCnt)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%NodeCnt,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%NodeCnt,1) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%NodeCnt)) THEN - ALLOCATE(DstMeshAuxDataTypeData%NodeCnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%NodeCnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%NodeCnt = SrcMeshAuxDataTypeData%NodeCnt -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%NodeIDs)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%NodeIDs,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%NodeIDs,1) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%NodeIDs)) THEN - ALLOCATE(DstMeshAuxDataTypeData%NodeIDs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%NodeIDs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%NodeIDs = SrcMeshAuxDataTypeData%NodeIDs -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%ElmIDs)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%ElmIDs,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%ElmIDs,1) - i2_l = LBOUND(SrcMeshAuxDataTypeData%ElmIDs,2) - i2_u = UBOUND(SrcMeshAuxDataTypeData%ElmIDs,2) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%ElmIDs)) THEN - ALLOCATE(DstMeshAuxDataTypeData%ElmIDs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%ElmIDs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%ElmIDs = SrcMeshAuxDataTypeData%ElmIDs -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%ElmNds)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%ElmNds,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%ElmNds,1) - i2_l = LBOUND(SrcMeshAuxDataTypeData%ElmNds,2) - i2_u = UBOUND(SrcMeshAuxDataTypeData%ElmNds,2) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%ElmNds)) THEN - ALLOCATE(DstMeshAuxDataTypeData%ElmNds(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%ElmNds.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%ElmNds = SrcMeshAuxDataTypeData%ElmNds -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%Me)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%Me,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%Me,1) - i2_l = LBOUND(SrcMeshAuxDataTypeData%Me,2) - i2_u = UBOUND(SrcMeshAuxDataTypeData%Me,2) - i3_l = LBOUND(SrcMeshAuxDataTypeData%Me,3) - i3_u = UBOUND(SrcMeshAuxDataTypeData%Me,3) - i4_l = LBOUND(SrcMeshAuxDataTypeData%Me,4) - i4_u = UBOUND(SrcMeshAuxDataTypeData%Me,4) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%Me)) THEN - ALLOCATE(DstMeshAuxDataTypeData%Me(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%Me.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%Me = SrcMeshAuxDataTypeData%Me -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%Ke)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%Ke,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%Ke,1) - i2_l = LBOUND(SrcMeshAuxDataTypeData%Ke,2) - i2_u = UBOUND(SrcMeshAuxDataTypeData%Ke,2) - i3_l = LBOUND(SrcMeshAuxDataTypeData%Ke,3) - i3_u = UBOUND(SrcMeshAuxDataTypeData%Ke,3) - i4_l = LBOUND(SrcMeshAuxDataTypeData%Ke,4) - i4_u = UBOUND(SrcMeshAuxDataTypeData%Ke,4) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%Ke)) THEN - ALLOCATE(DstMeshAuxDataTypeData%Ke(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%Ke.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%Ke = SrcMeshAuxDataTypeData%Ke -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%Fg)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%Fg,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%Fg,1) - i2_l = LBOUND(SrcMeshAuxDataTypeData%Fg,2) - i2_u = UBOUND(SrcMeshAuxDataTypeData%Fg,2) - i3_l = LBOUND(SrcMeshAuxDataTypeData%Fg,3) - i3_u = UBOUND(SrcMeshAuxDataTypeData%Fg,3) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%Fg)) THEN - ALLOCATE(DstMeshAuxDataTypeData%Fg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%Fg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%Fg = SrcMeshAuxDataTypeData%Fg -ENDIF - END SUBROUTINE SD_CopyMeshAuxDataType - - SUBROUTINE SD_DestroyMeshAuxDataType( MeshAuxDataTypeData, ErrStat, ErrMsg ) - TYPE(MeshAuxDataType), INTENT(INOUT) :: MeshAuxDataTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyMeshAuxDataType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(MeshAuxDataTypeData%NodeCnt)) THEN - DEALLOCATE(MeshAuxDataTypeData%NodeCnt) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%NodeIDs)) THEN - DEALLOCATE(MeshAuxDataTypeData%NodeIDs) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%ElmIDs)) THEN - DEALLOCATE(MeshAuxDataTypeData%ElmIDs) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%ElmNds)) THEN - DEALLOCATE(MeshAuxDataTypeData%ElmNds) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%Me)) THEN - DEALLOCATE(MeshAuxDataTypeData%Me) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%Ke)) THEN - DEALLOCATE(MeshAuxDataTypeData%Ke) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%Fg)) THEN - DEALLOCATE(MeshAuxDataTypeData%Fg) -ENDIF - END SUBROUTINE SD_DestroyMeshAuxDataType - - SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MeshAuxDataType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackMeshAuxDataType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! MemberID - Int_BufSz = Int_BufSz + 1 ! NOutCnt - Int_BufSz = Int_BufSz + 1 ! NodeCnt allocated yes/no - IF ( ALLOCATED(InData%NodeCnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodeCnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodeCnt) ! NodeCnt - END IF - Int_BufSz = Int_BufSz + 1 ! NodeIDs allocated yes/no - IF ( ALLOCATED(InData%NodeIDs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodeIDs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodeIDs) ! NodeIDs - END IF - Int_BufSz = Int_BufSz + 1 ! ElmIDs allocated yes/no - IF ( ALLOCATED(InData%ElmIDs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ElmIDs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ElmIDs) ! ElmIDs - END IF - Int_BufSz = Int_BufSz + 1 ! ElmNds allocated yes/no - IF ( ALLOCATED(InData%ElmNds) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ElmNds upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ElmNds) ! ElmNds - END IF - Int_BufSz = Int_BufSz + 1 ! Me allocated yes/no - IF ( ALLOCATED(InData%Me) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Me upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Me) ! Me - END IF - Int_BufSz = Int_BufSz + 1 ! Ke allocated yes/no - IF ( ALLOCATED(InData%Ke) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Ke upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ke) ! Ke - END IF - Int_BufSz = Int_BufSz + 1 ! Fg allocated yes/no - IF ( ALLOCATED(InData%Fg) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Fg upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fg) ! Fg - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutCnt - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NodeCnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodeCnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeCnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodeCnt,1), UBOUND(InData%NodeCnt,1) - IntKiBuf(Int_Xferred) = InData%NodeCnt(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodeIDs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodeIDs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeIDs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodeIDs,1), UBOUND(InData%NodeIDs,1) - IntKiBuf(Int_Xferred) = InData%NodeIDs(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElmIDs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElmIDs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmIDs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElmIDs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmIDs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ElmIDs,2), UBOUND(InData%ElmIDs,2) - DO i1 = LBOUND(InData%ElmIDs,1), UBOUND(InData%ElmIDs,1) - IntKiBuf(Int_Xferred) = InData%ElmIDs(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElmNds) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElmNds,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmNds,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElmNds,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmNds,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ElmNds,2), UBOUND(InData%ElmNds,2) - DO i1 = LBOUND(InData%ElmNds,1), UBOUND(InData%ElmNds,1) - IntKiBuf(Int_Xferred) = InData%ElmNds(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Me) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Me,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Me,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Me,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Me,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Me,4), UBOUND(InData%Me,4) - DO i3 = LBOUND(InData%Me,3), UBOUND(InData%Me,3) - DO i2 = LBOUND(InData%Me,2), UBOUND(InData%Me,2) - DO i1 = LBOUND(InData%Me,1), UBOUND(InData%Me,1) - DbKiBuf(Db_Xferred) = InData%Me(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ke) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ke,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ke,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ke,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ke,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Ke,4), UBOUND(InData%Ke,4) - DO i3 = LBOUND(InData%Ke,3), UBOUND(InData%Ke,3) - DO i2 = LBOUND(InData%Ke,2), UBOUND(InData%Ke,2) - DO i1 = LBOUND(InData%Ke,1), UBOUND(InData%Ke,1) - DbKiBuf(Db_Xferred) = InData%Ke(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fg) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fg,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fg,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Fg,3), UBOUND(InData%Fg,3) - DO i2 = LBOUND(InData%Fg,2), UBOUND(InData%Fg,2) - DO i1 = LBOUND(InData%Fg,1), UBOUND(InData%Fg,1) - DbKiBuf(Db_Xferred) = InData%Fg(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE SD_PackMeshAuxDataType - - SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MeshAuxDataType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackMeshAuxDataType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%MemberID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NOutCnt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeCnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodeCnt)) DEALLOCATE(OutData%NodeCnt) - ALLOCATE(OutData%NodeCnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeCnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodeCnt,1), UBOUND(OutData%NodeCnt,1) - OutData%NodeCnt(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeIDs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodeIDs)) DEALLOCATE(OutData%NodeIDs) - ALLOCATE(OutData%NodeIDs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIDs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodeIDs,1), UBOUND(OutData%NodeIDs,1) - OutData%NodeIDs(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElmIDs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ElmIDs)) DEALLOCATE(OutData%ElmIDs) - ALLOCATE(OutData%ElmIDs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmIDs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ElmIDs,2), UBOUND(OutData%ElmIDs,2) - DO i1 = LBOUND(OutData%ElmIDs,1), UBOUND(OutData%ElmIDs,1) - OutData%ElmIDs(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElmNds not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ElmNds)) DEALLOCATE(OutData%ElmNds) - ALLOCATE(OutData%ElmNds(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmNds.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ElmNds,2), UBOUND(OutData%ElmNds,2) - DO i1 = LBOUND(OutData%ElmNds,1), UBOUND(OutData%ElmNds,1) - OutData%ElmNds(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Me not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Me)) DEALLOCATE(OutData%Me) - ALLOCATE(OutData%Me(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Me.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Me,4), UBOUND(OutData%Me,4) - DO i3 = LBOUND(OutData%Me,3), UBOUND(OutData%Me,3) - DO i2 = LBOUND(OutData%Me,2), UBOUND(OutData%Me,2) - DO i1 = LBOUND(OutData%Me,1), UBOUND(OutData%Me,1) - OutData%Me(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ke not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Ke)) DEALLOCATE(OutData%Ke) - ALLOCATE(OutData%Ke(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ke.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Ke,4), UBOUND(OutData%Ke,4) - DO i3 = LBOUND(OutData%Ke,3), UBOUND(OutData%Ke,3) - DO i2 = LBOUND(OutData%Ke,2), UBOUND(OutData%Ke,2) - DO i1 = LBOUND(OutData%Ke,1), UBOUND(OutData%Ke,1) - OutData%Ke(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fg not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Fg)) DEALLOCATE(OutData%Fg) - ALLOCATE(OutData%Fg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Fg,3), UBOUND(OutData%Fg,3) - DO i2 = LBOUND(OutData%Fg,2), UBOUND(OutData%Fg,2) - DO i1 = LBOUND(OutData%Fg,1), UBOUND(OutData%Fg,1) - OutData%Fg(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE SD_UnPackMeshAuxDataType - - SUBROUTINE SD_CopyCB_MatArrays( SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCode, ErrStat, ErrMsg ) - TYPE(CB_MatArrays), INTENT(IN) :: SrcCB_MatArraysData - TYPE(CB_MatArrays), INTENT(INOUT) :: DstCB_MatArraysData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyCB_MatArrays' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcCB_MatArraysData%MBB)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%MBB,1) - i1_u = UBOUND(SrcCB_MatArraysData%MBB,1) - i2_l = LBOUND(SrcCB_MatArraysData%MBB,2) - i2_u = UBOUND(SrcCB_MatArraysData%MBB,2) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%MBB)) THEN - ALLOCATE(DstCB_MatArraysData%MBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%MBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%MBB = SrcCB_MatArraysData%MBB -ENDIF -IF (ALLOCATED(SrcCB_MatArraysData%MBM)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%MBM,1) - i1_u = UBOUND(SrcCB_MatArraysData%MBM,1) - i2_l = LBOUND(SrcCB_MatArraysData%MBM,2) - i2_u = UBOUND(SrcCB_MatArraysData%MBM,2) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%MBM)) THEN - ALLOCATE(DstCB_MatArraysData%MBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%MBM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%MBM = SrcCB_MatArraysData%MBM -ENDIF -IF (ALLOCATED(SrcCB_MatArraysData%KBB)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%KBB,1) - i1_u = UBOUND(SrcCB_MatArraysData%KBB,1) - i2_l = LBOUND(SrcCB_MatArraysData%KBB,2) - i2_u = UBOUND(SrcCB_MatArraysData%KBB,2) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%KBB)) THEN - ALLOCATE(DstCB_MatArraysData%KBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%KBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%KBB = SrcCB_MatArraysData%KBB -ENDIF -IF (ALLOCATED(SrcCB_MatArraysData%PhiL)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%PhiL,1) - i1_u = UBOUND(SrcCB_MatArraysData%PhiL,1) - i2_l = LBOUND(SrcCB_MatArraysData%PhiL,2) - i2_u = UBOUND(SrcCB_MatArraysData%PhiL,2) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%PhiL)) THEN - ALLOCATE(DstCB_MatArraysData%PhiL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%PhiL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%PhiL = SrcCB_MatArraysData%PhiL -ENDIF -IF (ALLOCATED(SrcCB_MatArraysData%PhiR)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%PhiR,1) - i1_u = UBOUND(SrcCB_MatArraysData%PhiR,1) - i2_l = LBOUND(SrcCB_MatArraysData%PhiR,2) - i2_u = UBOUND(SrcCB_MatArraysData%PhiR,2) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%PhiR)) THEN - ALLOCATE(DstCB_MatArraysData%PhiR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%PhiR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%PhiR = SrcCB_MatArraysData%PhiR -ENDIF -IF (ALLOCATED(SrcCB_MatArraysData%OmegaL)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%OmegaL,1) - i1_u = UBOUND(SrcCB_MatArraysData%OmegaL,1) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%OmegaL)) THEN - ALLOCATE(DstCB_MatArraysData%OmegaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%OmegaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%OmegaL = SrcCB_MatArraysData%OmegaL -ENDIF - END SUBROUTINE SD_CopyCB_MatArrays - - SUBROUTINE SD_DestroyCB_MatArrays( CB_MatArraysData, ErrStat, ErrMsg ) - TYPE(CB_MatArrays), INTENT(INOUT) :: CB_MatArraysData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyCB_MatArrays' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(CB_MatArraysData%MBB)) THEN - DEALLOCATE(CB_MatArraysData%MBB) -ENDIF -IF (ALLOCATED(CB_MatArraysData%MBM)) THEN - DEALLOCATE(CB_MatArraysData%MBM) -ENDIF -IF (ALLOCATED(CB_MatArraysData%KBB)) THEN - DEALLOCATE(CB_MatArraysData%KBB) -ENDIF -IF (ALLOCATED(CB_MatArraysData%PhiL)) THEN - DEALLOCATE(CB_MatArraysData%PhiL) -ENDIF -IF (ALLOCATED(CB_MatArraysData%PhiR)) THEN - DEALLOCATE(CB_MatArraysData%PhiR) -ENDIF -IF (ALLOCATED(CB_MatArraysData%OmegaL)) THEN - DEALLOCATE(CB_MatArraysData%OmegaL) -ENDIF - END SUBROUTINE SD_DestroyCB_MatArrays - - SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(CB_MatArrays), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackCB_MatArrays' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! MBB allocated yes/no - IF ( ALLOCATED(InData%MBB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MBB upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%MBB) ! MBB - END IF - Int_BufSz = Int_BufSz + 1 ! MBM allocated yes/no - IF ( ALLOCATED(InData%MBM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MBM upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%MBM) ! MBM - END IF - Int_BufSz = Int_BufSz + 1 ! KBB allocated yes/no - IF ( ALLOCATED(InData%KBB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! KBB upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%KBB) ! KBB - END IF - Int_BufSz = Int_BufSz + 1 ! PhiL allocated yes/no - IF ( ALLOCATED(InData%PhiL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiL upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PhiL) ! PhiL - END IF - Int_BufSz = Int_BufSz + 1 ! PhiR allocated yes/no - IF ( ALLOCATED(InData%PhiR) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiR upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PhiR) ! PhiR - END IF - Int_BufSz = Int_BufSz + 1 ! OmegaL allocated yes/no - IF ( ALLOCATED(InData%OmegaL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OmegaL upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%OmegaL) ! OmegaL - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%MBB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MBB,2), UBOUND(InData%MBB,2) - DO i1 = LBOUND(InData%MBB,1), UBOUND(InData%MBB,1) - DbKiBuf(Db_Xferred) = InData%MBB(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MBM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MBM,2), UBOUND(InData%MBM,2) - DO i1 = LBOUND(InData%MBM,1), UBOUND(InData%MBM,1) - DbKiBuf(Db_Xferred) = InData%MBM(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%KBB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%KBB,2), UBOUND(InData%KBB,2) - DO i1 = LBOUND(InData%KBB,1), UBOUND(InData%KBB,1) - DbKiBuf(Db_Xferred) = InData%KBB(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiL,2), UBOUND(InData%PhiL,2) - DO i1 = LBOUND(InData%PhiL,1), UBOUND(InData%PhiL,1) - DbKiBuf(Db_Xferred) = InData%PhiL(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiR) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiR,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiR,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiR,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiR,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiR,2), UBOUND(InData%PhiR,2) - DO i1 = LBOUND(InData%PhiR,1), UBOUND(InData%PhiR,1) - DbKiBuf(Db_Xferred) = InData%PhiR(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OmegaL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OmegaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OmegaL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OmegaL,1), UBOUND(InData%OmegaL,1) - DbKiBuf(Db_Xferred) = InData%OmegaL(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackCB_MatArrays - - SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(CB_MatArrays), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackCB_MatArrays' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MBB)) DEALLOCATE(OutData%MBB) - ALLOCATE(OutData%MBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MBB,2), UBOUND(OutData%MBB,2) - DO i1 = LBOUND(OutData%MBB,1), UBOUND(OutData%MBB,1) - OutData%MBB(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MBM)) DEALLOCATE(OutData%MBM) - ALLOCATE(OutData%MBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MBM,2), UBOUND(OutData%MBM,2) - DO i1 = LBOUND(OutData%MBM,1), UBOUND(OutData%MBM,1) - OutData%MBM(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%KBB)) DEALLOCATE(OutData%KBB) - ALLOCATE(OutData%KBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%KBB,2), UBOUND(OutData%KBB,2) - DO i1 = LBOUND(OutData%KBB,1), UBOUND(OutData%KBB,1) - OutData%KBB(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PhiL)) DEALLOCATE(OutData%PhiL) - ALLOCATE(OutData%PhiL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiL,2), UBOUND(OutData%PhiL,2) - DO i1 = LBOUND(OutData%PhiL,1), UBOUND(OutData%PhiL,1) - OutData%PhiL(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiR not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PhiR)) DEALLOCATE(OutData%PhiR) - ALLOCATE(OutData%PhiR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiR,2), UBOUND(OutData%PhiR,2) - DO i1 = LBOUND(OutData%PhiR,1), UBOUND(OutData%PhiR,1) - OutData%PhiR(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OmegaL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OmegaL)) DEALLOCATE(OutData%OmegaL) - ALLOCATE(OutData%OmegaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OmegaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OmegaL,1), UBOUND(OutData%OmegaL,1) - OutData%OmegaL(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackCB_MatArrays - - SUBROUTINE SD_CopyElemPropType( SrcElemPropTypeData, DstElemPropTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ElemPropType), INTENT(IN) :: SrcElemPropTypeData - TYPE(ElemPropType), INTENT(INOUT) :: DstElemPropTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyElemPropType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstElemPropTypeData%eType = SrcElemPropTypeData%eType - DstElemPropTypeData%Length = SrcElemPropTypeData%Length - DstElemPropTypeData%Ixx = SrcElemPropTypeData%Ixx - DstElemPropTypeData%Iyy = SrcElemPropTypeData%Iyy - DstElemPropTypeData%Jzz = SrcElemPropTypeData%Jzz - DstElemPropTypeData%Shear = SrcElemPropTypeData%Shear - DstElemPropTypeData%Kappa = SrcElemPropTypeData%Kappa - DstElemPropTypeData%YoungE = SrcElemPropTypeData%YoungE - DstElemPropTypeData%ShearG = SrcElemPropTypeData%ShearG - DstElemPropTypeData%Area = SrcElemPropTypeData%Area - DstElemPropTypeData%Rho = SrcElemPropTypeData%Rho - DstElemPropTypeData%T0 = SrcElemPropTypeData%T0 - DstElemPropTypeData%DirCos = SrcElemPropTypeData%DirCos - END SUBROUTINE SD_CopyElemPropType - - SUBROUTINE SD_DestroyElemPropType( ElemPropTypeData, ErrStat, ErrMsg ) - TYPE(ElemPropType), INTENT(INOUT) :: ElemPropTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyElemPropType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE SD_DestroyElemPropType - - SUBROUTINE SD_PackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ElemPropType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackElemPropType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! eType - Re_BufSz = Re_BufSz + 1 ! Length - Re_BufSz = Re_BufSz + 1 ! Ixx - Re_BufSz = Re_BufSz + 1 ! Iyy - Re_BufSz = Re_BufSz + 1 ! Jzz - Int_BufSz = Int_BufSz + 1 ! Shear - Re_BufSz = Re_BufSz + 1 ! Kappa - Re_BufSz = Re_BufSz + 1 ! YoungE - Re_BufSz = Re_BufSz + 1 ! ShearG - Re_BufSz = Re_BufSz + 1 ! Area - Re_BufSz = Re_BufSz + 1 ! Rho - Re_BufSz = Re_BufSz + 1 ! T0 - Db_BufSz = Db_BufSz + SIZE(InData%DirCos) ! DirCos - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%eType - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Length - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ixx - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Iyy - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Jzz - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Shear, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kappa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YoungE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShearG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Area - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Rho - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T0 - Re_Xferred = Re_Xferred + 1 - DO i2 = LBOUND(InData%DirCos,2), UBOUND(InData%DirCos,2) - DO i1 = LBOUND(InData%DirCos,1), UBOUND(InData%DirCos,1) - DbKiBuf(Db_Xferred) = InData%DirCos(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END SUBROUTINE SD_PackElemPropType - - SUBROUTINE SD_UnPackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ElemPropType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackElemPropType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%eType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Length = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ixx = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Iyy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Jzz = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Shear = TRANSFER(IntKiBuf(Int_Xferred), OutData%Shear) - Int_Xferred = Int_Xferred + 1 - OutData%Kappa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YoungE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShearG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Area = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Rho = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%DirCos,1) - i1_u = UBOUND(OutData%DirCos,1) - i2_l = LBOUND(OutData%DirCos,2) - i2_u = UBOUND(OutData%DirCos,2) - DO i2 = LBOUND(OutData%DirCos,2), UBOUND(OutData%DirCos,2) - DO i1 = LBOUND(OutData%DirCos,1), UBOUND(OutData%DirCos,1) - OutData%DirCos(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END SUBROUTINE SD_UnPackElemPropType - - SUBROUTINE SD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_InitInputType), INTENT(INOUT) :: SrcInitInputData - TYPE(SD_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%SDInputFile = SrcInitInputData%SDInputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%g = SrcInitInputData%g - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%TP_RefPoint = SrcInitInputData%TP_RefPoint - DstInitInputData%SubRotateZ = SrcInitInputData%SubRotateZ -IF (ALLOCATED(SrcInitInputData%SoilStiffness)) THEN - i1_l = LBOUND(SrcInitInputData%SoilStiffness,1) - i1_u = UBOUND(SrcInitInputData%SoilStiffness,1) - i2_l = LBOUND(SrcInitInputData%SoilStiffness,2) - i2_u = UBOUND(SrcInitInputData%SoilStiffness,2) - i3_l = LBOUND(SrcInitInputData%SoilStiffness,3) - i3_u = UBOUND(SrcInitInputData%SoilStiffness,3) - IF (.NOT. ALLOCATED(DstInitInputData%SoilStiffness)) THEN - ALLOCATE(DstInitInputData%SoilStiffness(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%SoilStiffness.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%SoilStiffness = SrcInitInputData%SoilStiffness -ENDIF - CALL MeshCopy( SrcInitInputData%SoilMesh, DstInitInputData%SoilMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%Linearize = SrcInitInputData%Linearize - END SUBROUTINE SD_CopyInitInput - - SUBROUTINE SD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(SD_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitInputData%SoilStiffness)) THEN - DEALLOCATE(InitInputData%SoilStiffness) -ENDIF - CALL MeshDestroy( InitInputData%SoilMesh, ErrStat, ErrMsg ) - END SUBROUTINE SD_DestroyInitInput - - SUBROUTINE SD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%SDInputFile) ! SDInputFile - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + 1 ! g - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + SIZE(InData%TP_RefPoint) ! TP_RefPoint - Re_BufSz = Re_BufSz + 1 ! SubRotateZ - Int_BufSz = Int_BufSz + 1 ! SoilStiffness allocated yes/no - IF ( ALLOCATED(InData%SoilStiffness) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! SoilStiffness upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SoilStiffness) ! SoilStiffness - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! SoilMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%SoilMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! SoilMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SoilMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SoilMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SoilMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Linearize - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%SDInputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%SDInputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%g - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%TP_RefPoint,1), UBOUND(InData%TP_RefPoint,1) - ReKiBuf(Re_Xferred) = InData%TP_RefPoint(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%SubRotateZ - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%SoilStiffness) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%SoilStiffness,3), UBOUND(InData%SoilStiffness,3) - DO i2 = LBOUND(InData%SoilStiffness,2), UBOUND(InData%SoilStiffness,2) - DO i1 = LBOUND(InData%SoilStiffness,1), UBOUND(InData%SoilStiffness,1) - ReKiBuf(Re_Xferred) = InData%SoilStiffness(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - CALL MeshPack( InData%SoilMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! SoilMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_PackInitInput - - SUBROUTINE SD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%SDInputFile) - OutData%SDInputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%g = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%TP_RefPoint,1) - i1_u = UBOUND(OutData%TP_RefPoint,1) - DO i1 = LBOUND(OutData%TP_RefPoint,1), UBOUND(OutData%TP_RefPoint,1) - OutData%TP_RefPoint(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%SubRotateZ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SoilStiffness not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SoilStiffness)) DEALLOCATE(OutData%SoilStiffness) - ALLOCATE(OutData%SoilStiffness(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SoilStiffness.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%SoilStiffness,3), UBOUND(OutData%SoilStiffness,3) - DO i2 = LBOUND(OutData%SoilStiffness,2), UBOUND(OutData%SoilStiffness,2) - DO i1 = LBOUND(OutData%SoilStiffness,1), UBOUND(OutData%SoilStiffness,1) - OutData%SoilStiffness(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%SoilMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! SoilMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_UnPackInitInput - - SUBROUTINE SD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SD_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN - ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_x)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_x,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_x)) THEN - ALLOCATE(DstInitOutputData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN - ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_y)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_y,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_y)) THEN - ALLOCATE(DstInitOutputData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_x)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_x,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_x)) THEN - ALLOCATE(DstInitOutputData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_u)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_u,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_u)) THEN - ALLOCATE(DstInitOutputData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN - i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) - i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN - ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcInitOutputData%DerivOrder_x,1) - i1_u = UBOUND(SrcInitOutputData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%DerivOrder_x)) THEN - ALLOCATE(DstInitOutputData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x -ENDIF - END SUBROUTINE SD_CopyInitOutput - - SUBROUTINE SD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(SD_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, ErrMsg ) -IF (ALLOCATED(InitOutputData%LinNames_y)) THEN - DEALLOCATE(InitOutputData%LinNames_y) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_x)) THEN - DEALLOCATE(InitOutputData%LinNames_x) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_u)) THEN - DEALLOCATE(InitOutputData%LinNames_u) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_y)) THEN - DEALLOCATE(InitOutputData%RotFrame_y) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_x)) THEN - DEALLOCATE(InitOutputData%RotFrame_x) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_u)) THEN - DEALLOCATE(InitOutputData%RotFrame_u) -ENDIF -IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN - DEALLOCATE(InitOutputData%IsLoad_u) -ENDIF -IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN - DEALLOCATE(InitOutputData%DerivOrder_x) -ENDIF - END SUBROUTINE SD_DestroyInitOutput - - SUBROUTINE SD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no - IF ( ALLOCATED(InData%LinNames_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no - IF ( ALLOCATED(InData%RotFrame_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no - IF ( ALLOCATED(InData%DerivOrder_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) - DO I = 1, LEN(InData%LinNames_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DerivOrder_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) - IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackInitOutput - - SUBROUTINE SD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_x)) DEALLOCATE(OutData%LinNames_x) - ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) - DO I = 1, LEN(OutData%LinNames_x) - OutData%LinNames_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) - ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) - OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) - ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) - OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) - OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) - ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) - OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackInitOutput - - SUBROUTINE SD_CopyInitType( SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_InitType), INTENT(IN) :: SrcInitTypeData - TYPE(SD_InitType), INTENT(INOUT) :: DstInitTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyInitType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitTypeData%RootName = SrcInitTypeData%RootName - DstInitTypeData%TP_RefPoint = SrcInitTypeData%TP_RefPoint - DstInitTypeData%SubRotateZ = SrcInitTypeData%SubRotateZ - DstInitTypeData%g = SrcInitTypeData%g - DstInitTypeData%DT = SrcInitTypeData%DT - DstInitTypeData%NJoints = SrcInitTypeData%NJoints - DstInitTypeData%NPropSetsX = SrcInitTypeData%NPropSetsX - DstInitTypeData%NPropSetsB = SrcInitTypeData%NPropSetsB - DstInitTypeData%NPropSetsC = SrcInitTypeData%NPropSetsC - DstInitTypeData%NPropSetsR = SrcInitTypeData%NPropSetsR - DstInitTypeData%NCMass = SrcInitTypeData%NCMass - DstInitTypeData%NCOSMs = SrcInitTypeData%NCOSMs - DstInitTypeData%FEMMod = SrcInitTypeData%FEMMod - DstInitTypeData%NDiv = SrcInitTypeData%NDiv - DstInitTypeData%CBMod = SrcInitTypeData%CBMod -IF (ALLOCATED(SrcInitTypeData%Joints)) THEN - i1_l = LBOUND(SrcInitTypeData%Joints,1) - i1_u = UBOUND(SrcInitTypeData%Joints,1) - i2_l = LBOUND(SrcInitTypeData%Joints,2) - i2_u = UBOUND(SrcInitTypeData%Joints,2) - IF (.NOT. ALLOCATED(DstInitTypeData%Joints)) THEN - ALLOCATE(DstInitTypeData%Joints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Joints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Joints = SrcInitTypeData%Joints -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropSetsB)) THEN - i1_l = LBOUND(SrcInitTypeData%PropSetsB,1) - i1_u = UBOUND(SrcInitTypeData%PropSetsB,1) - i2_l = LBOUND(SrcInitTypeData%PropSetsB,2) - i2_u = UBOUND(SrcInitTypeData%PropSetsB,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsB)) THEN - ALLOCATE(DstInitTypeData%PropSetsB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropSetsB = SrcInitTypeData%PropSetsB -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropSetsC)) THEN - i1_l = LBOUND(SrcInitTypeData%PropSetsC,1) - i1_u = UBOUND(SrcInitTypeData%PropSetsC,1) - i2_l = LBOUND(SrcInitTypeData%PropSetsC,2) - i2_u = UBOUND(SrcInitTypeData%PropSetsC,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsC)) THEN - ALLOCATE(DstInitTypeData%PropSetsC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropSetsC = SrcInitTypeData%PropSetsC -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropSetsR)) THEN - i1_l = LBOUND(SrcInitTypeData%PropSetsR,1) - i1_u = UBOUND(SrcInitTypeData%PropSetsR,1) - i2_l = LBOUND(SrcInitTypeData%PropSetsR,2) - i2_u = UBOUND(SrcInitTypeData%PropSetsR,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsR)) THEN - ALLOCATE(DstInitTypeData%PropSetsR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropSetsR = SrcInitTypeData%PropSetsR -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropSetsX)) THEN - i1_l = LBOUND(SrcInitTypeData%PropSetsX,1) - i1_u = UBOUND(SrcInitTypeData%PropSetsX,1) - i2_l = LBOUND(SrcInitTypeData%PropSetsX,2) - i2_u = UBOUND(SrcInitTypeData%PropSetsX,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsX)) THEN - ALLOCATE(DstInitTypeData%PropSetsX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropSetsX = SrcInitTypeData%PropSetsX -ENDIF -IF (ALLOCATED(SrcInitTypeData%COSMs)) THEN - i1_l = LBOUND(SrcInitTypeData%COSMs,1) - i1_u = UBOUND(SrcInitTypeData%COSMs,1) - i2_l = LBOUND(SrcInitTypeData%COSMs,2) - i2_u = UBOUND(SrcInitTypeData%COSMs,2) - IF (.NOT. ALLOCATED(DstInitTypeData%COSMs)) THEN - ALLOCATE(DstInitTypeData%COSMs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%COSMs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%COSMs = SrcInitTypeData%COSMs -ENDIF -IF (ALLOCATED(SrcInitTypeData%CMass)) THEN - i1_l = LBOUND(SrcInitTypeData%CMass,1) - i1_u = UBOUND(SrcInitTypeData%CMass,1) - i2_l = LBOUND(SrcInitTypeData%CMass,2) - i2_u = UBOUND(SrcInitTypeData%CMass,2) - IF (.NOT. ALLOCATED(DstInitTypeData%CMass)) THEN - ALLOCATE(DstInitTypeData%CMass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%CMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%CMass = SrcInitTypeData%CMass -ENDIF -IF (ALLOCATED(SrcInitTypeData%JDampings)) THEN - i1_l = LBOUND(SrcInitTypeData%JDampings,1) - i1_u = UBOUND(SrcInitTypeData%JDampings,1) - IF (.NOT. ALLOCATED(DstInitTypeData%JDampings)) THEN - ALLOCATE(DstInitTypeData%JDampings(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%JDampings.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%JDampings = SrcInitTypeData%JDampings -ENDIF - DstInitTypeData%GuyanDampMod = SrcInitTypeData%GuyanDampMod - DstInitTypeData%RayleighDamp = SrcInitTypeData%RayleighDamp - DstInitTypeData%GuyanDampMat = SrcInitTypeData%GuyanDampMat -IF (ALLOCATED(SrcInitTypeData%Members)) THEN - i1_l = LBOUND(SrcInitTypeData%Members,1) - i1_u = UBOUND(SrcInitTypeData%Members,1) - i2_l = LBOUND(SrcInitTypeData%Members,2) - i2_u = UBOUND(SrcInitTypeData%Members,2) - IF (.NOT. ALLOCATED(DstInitTypeData%Members)) THEN - ALLOCATE(DstInitTypeData%Members(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Members.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Members = SrcInitTypeData%Members -ENDIF -IF (ALLOCATED(SrcInitTypeData%SSOutList)) THEN - i1_l = LBOUND(SrcInitTypeData%SSOutList,1) - i1_u = UBOUND(SrcInitTypeData%SSOutList,1) - IF (.NOT. ALLOCATED(DstInitTypeData%SSOutList)) THEN - ALLOCATE(DstInitTypeData%SSOutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSOutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%SSOutList = SrcInitTypeData%SSOutList -ENDIF - DstInitTypeData%OutCOSM = SrcInitTypeData%OutCOSM - DstInitTypeData%TabDelim = SrcInitTypeData%TabDelim -IF (ALLOCATED(SrcInitTypeData%SSIK)) THEN - i1_l = LBOUND(SrcInitTypeData%SSIK,1) - i1_u = UBOUND(SrcInitTypeData%SSIK,1) - i2_l = LBOUND(SrcInitTypeData%SSIK,2) - i2_u = UBOUND(SrcInitTypeData%SSIK,2) - IF (.NOT. ALLOCATED(DstInitTypeData%SSIK)) THEN - ALLOCATE(DstInitTypeData%SSIK(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSIK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%SSIK = SrcInitTypeData%SSIK -ENDIF -IF (ALLOCATED(SrcInitTypeData%SSIM)) THEN - i1_l = LBOUND(SrcInitTypeData%SSIM,1) - i1_u = UBOUND(SrcInitTypeData%SSIM,1) - i2_l = LBOUND(SrcInitTypeData%SSIM,2) - i2_u = UBOUND(SrcInitTypeData%SSIM,2) - IF (.NOT. ALLOCATED(DstInitTypeData%SSIM)) THEN - ALLOCATE(DstInitTypeData%SSIM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSIM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%SSIM = SrcInitTypeData%SSIM -ENDIF -IF (ALLOCATED(SrcInitTypeData%SSIfile)) THEN - i1_l = LBOUND(SrcInitTypeData%SSIfile,1) - i1_u = UBOUND(SrcInitTypeData%SSIfile,1) - IF (.NOT. ALLOCATED(DstInitTypeData%SSIfile)) THEN - ALLOCATE(DstInitTypeData%SSIfile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSIfile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%SSIfile = SrcInitTypeData%SSIfile -ENDIF -IF (ALLOCATED(SrcInitTypeData%Soil_K)) THEN - i1_l = LBOUND(SrcInitTypeData%Soil_K,1) - i1_u = UBOUND(SrcInitTypeData%Soil_K,1) - i2_l = LBOUND(SrcInitTypeData%Soil_K,2) - i2_u = UBOUND(SrcInitTypeData%Soil_K,2) - i3_l = LBOUND(SrcInitTypeData%Soil_K,3) - i3_u = UBOUND(SrcInitTypeData%Soil_K,3) - IF (.NOT. ALLOCATED(DstInitTypeData%Soil_K)) THEN - ALLOCATE(DstInitTypeData%Soil_K(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Soil_K.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Soil_K = SrcInitTypeData%Soil_K -ENDIF -IF (ALLOCATED(SrcInitTypeData%Soil_Points)) THEN - i1_l = LBOUND(SrcInitTypeData%Soil_Points,1) - i1_u = UBOUND(SrcInitTypeData%Soil_Points,1) - i2_l = LBOUND(SrcInitTypeData%Soil_Points,2) - i2_u = UBOUND(SrcInitTypeData%Soil_Points,2) - IF (.NOT. ALLOCATED(DstInitTypeData%Soil_Points)) THEN - ALLOCATE(DstInitTypeData%Soil_Points(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Soil_Points.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Soil_Points = SrcInitTypeData%Soil_Points -ENDIF -IF (ALLOCATED(SrcInitTypeData%Soil_Nodes)) THEN - i1_l = LBOUND(SrcInitTypeData%Soil_Nodes,1) - i1_u = UBOUND(SrcInitTypeData%Soil_Nodes,1) - IF (.NOT. ALLOCATED(DstInitTypeData%Soil_Nodes)) THEN - ALLOCATE(DstInitTypeData%Soil_Nodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Soil_Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Soil_Nodes = SrcInitTypeData%Soil_Nodes -ENDIF - DstInitTypeData%NElem = SrcInitTypeData%NElem - DstInitTypeData%NPropB = SrcInitTypeData%NPropB - DstInitTypeData%NPropC = SrcInitTypeData%NPropC - DstInitTypeData%NPropR = SrcInitTypeData%NPropR -IF (ALLOCATED(SrcInitTypeData%Nodes)) THEN - i1_l = LBOUND(SrcInitTypeData%Nodes,1) - i1_u = UBOUND(SrcInitTypeData%Nodes,1) - i2_l = LBOUND(SrcInitTypeData%Nodes,2) - i2_u = UBOUND(SrcInitTypeData%Nodes,2) - IF (.NOT. ALLOCATED(DstInitTypeData%Nodes)) THEN - ALLOCATE(DstInitTypeData%Nodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Nodes = SrcInitTypeData%Nodes -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropsB)) THEN - i1_l = LBOUND(SrcInitTypeData%PropsB,1) - i1_u = UBOUND(SrcInitTypeData%PropsB,1) - i2_l = LBOUND(SrcInitTypeData%PropsB,2) - i2_u = UBOUND(SrcInitTypeData%PropsB,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropsB)) THEN - ALLOCATE(DstInitTypeData%PropsB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropsB = SrcInitTypeData%PropsB -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropsC)) THEN - i1_l = LBOUND(SrcInitTypeData%PropsC,1) - i1_u = UBOUND(SrcInitTypeData%PropsC,1) - i2_l = LBOUND(SrcInitTypeData%PropsC,2) - i2_u = UBOUND(SrcInitTypeData%PropsC,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropsC)) THEN - ALLOCATE(DstInitTypeData%PropsC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropsC = SrcInitTypeData%PropsC -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropsR)) THEN - i1_l = LBOUND(SrcInitTypeData%PropsR,1) - i1_u = UBOUND(SrcInitTypeData%PropsR,1) - i2_l = LBOUND(SrcInitTypeData%PropsR,2) - i2_u = UBOUND(SrcInitTypeData%PropsR,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropsR)) THEN - ALLOCATE(DstInitTypeData%PropsR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropsR = SrcInitTypeData%PropsR -ENDIF -IF (ALLOCATED(SrcInitTypeData%K)) THEN - i1_l = LBOUND(SrcInitTypeData%K,1) - i1_u = UBOUND(SrcInitTypeData%K,1) - i2_l = LBOUND(SrcInitTypeData%K,2) - i2_u = UBOUND(SrcInitTypeData%K,2) - IF (.NOT. ALLOCATED(DstInitTypeData%K)) THEN - ALLOCATE(DstInitTypeData%K(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%K.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%K = SrcInitTypeData%K -ENDIF -IF (ALLOCATED(SrcInitTypeData%M)) THEN - i1_l = LBOUND(SrcInitTypeData%M,1) - i1_u = UBOUND(SrcInitTypeData%M,1) - i2_l = LBOUND(SrcInitTypeData%M,2) - i2_u = UBOUND(SrcInitTypeData%M,2) - IF (.NOT. ALLOCATED(DstInitTypeData%M)) THEN - ALLOCATE(DstInitTypeData%M(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%M = SrcInitTypeData%M -ENDIF -IF (ALLOCATED(SrcInitTypeData%ElemProps)) THEN - i1_l = LBOUND(SrcInitTypeData%ElemProps,1) - i1_u = UBOUND(SrcInitTypeData%ElemProps,1) - i2_l = LBOUND(SrcInitTypeData%ElemProps,2) - i2_u = UBOUND(SrcInitTypeData%ElemProps,2) - IF (.NOT. ALLOCATED(DstInitTypeData%ElemProps)) THEN - ALLOCATE(DstInitTypeData%ElemProps(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%ElemProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%ElemProps = SrcInitTypeData%ElemProps -ENDIF -IF (ALLOCATED(SrcInitTypeData%MemberNodes)) THEN - i1_l = LBOUND(SrcInitTypeData%MemberNodes,1) - i1_u = UBOUND(SrcInitTypeData%MemberNodes,1) - i2_l = LBOUND(SrcInitTypeData%MemberNodes,2) - i2_u = UBOUND(SrcInitTypeData%MemberNodes,2) - IF (.NOT. ALLOCATED(DstInitTypeData%MemberNodes)) THEN - ALLOCATE(DstInitTypeData%MemberNodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%MemberNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%MemberNodes = SrcInitTypeData%MemberNodes -ENDIF -IF (ALLOCATED(SrcInitTypeData%NodesConnN)) THEN - i1_l = LBOUND(SrcInitTypeData%NodesConnN,1) - i1_u = UBOUND(SrcInitTypeData%NodesConnN,1) - i2_l = LBOUND(SrcInitTypeData%NodesConnN,2) - i2_u = UBOUND(SrcInitTypeData%NodesConnN,2) - IF (.NOT. ALLOCATED(DstInitTypeData%NodesConnN)) THEN - ALLOCATE(DstInitTypeData%NodesConnN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%NodesConnN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%NodesConnN = SrcInitTypeData%NodesConnN -ENDIF -IF (ALLOCATED(SrcInitTypeData%NodesConnE)) THEN - i1_l = LBOUND(SrcInitTypeData%NodesConnE,1) - i1_u = UBOUND(SrcInitTypeData%NodesConnE,1) - i2_l = LBOUND(SrcInitTypeData%NodesConnE,2) - i2_u = UBOUND(SrcInitTypeData%NodesConnE,2) - IF (.NOT. ALLOCATED(DstInitTypeData%NodesConnE)) THEN - ALLOCATE(DstInitTypeData%NodesConnE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%NodesConnE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%NodesConnE = SrcInitTypeData%NodesConnE -ENDIF - DstInitTypeData%SSSum = SrcInitTypeData%SSSum - END SUBROUTINE SD_CopyInitType - - SUBROUTINE SD_DestroyInitType( InitTypeData, ErrStat, ErrMsg ) - TYPE(SD_InitType), INTENT(INOUT) :: InitTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitTypeData%Joints)) THEN - DEALLOCATE(InitTypeData%Joints) -ENDIF -IF (ALLOCATED(InitTypeData%PropSetsB)) THEN - DEALLOCATE(InitTypeData%PropSetsB) -ENDIF -IF (ALLOCATED(InitTypeData%PropSetsC)) THEN - DEALLOCATE(InitTypeData%PropSetsC) -ENDIF -IF (ALLOCATED(InitTypeData%PropSetsR)) THEN - DEALLOCATE(InitTypeData%PropSetsR) -ENDIF -IF (ALLOCATED(InitTypeData%PropSetsX)) THEN - DEALLOCATE(InitTypeData%PropSetsX) -ENDIF -IF (ALLOCATED(InitTypeData%COSMs)) THEN - DEALLOCATE(InitTypeData%COSMs) -ENDIF -IF (ALLOCATED(InitTypeData%CMass)) THEN - DEALLOCATE(InitTypeData%CMass) -ENDIF -IF (ALLOCATED(InitTypeData%JDampings)) THEN - DEALLOCATE(InitTypeData%JDampings) -ENDIF -IF (ALLOCATED(InitTypeData%Members)) THEN - DEALLOCATE(InitTypeData%Members) -ENDIF -IF (ALLOCATED(InitTypeData%SSOutList)) THEN - DEALLOCATE(InitTypeData%SSOutList) -ENDIF -IF (ALLOCATED(InitTypeData%SSIK)) THEN - DEALLOCATE(InitTypeData%SSIK) -ENDIF -IF (ALLOCATED(InitTypeData%SSIM)) THEN - DEALLOCATE(InitTypeData%SSIM) -ENDIF -IF (ALLOCATED(InitTypeData%SSIfile)) THEN - DEALLOCATE(InitTypeData%SSIfile) -ENDIF -IF (ALLOCATED(InitTypeData%Soil_K)) THEN - DEALLOCATE(InitTypeData%Soil_K) -ENDIF -IF (ALLOCATED(InitTypeData%Soil_Points)) THEN - DEALLOCATE(InitTypeData%Soil_Points) -ENDIF -IF (ALLOCATED(InitTypeData%Soil_Nodes)) THEN - DEALLOCATE(InitTypeData%Soil_Nodes) -ENDIF -IF (ALLOCATED(InitTypeData%Nodes)) THEN - DEALLOCATE(InitTypeData%Nodes) -ENDIF -IF (ALLOCATED(InitTypeData%PropsB)) THEN - DEALLOCATE(InitTypeData%PropsB) -ENDIF -IF (ALLOCATED(InitTypeData%PropsC)) THEN - DEALLOCATE(InitTypeData%PropsC) -ENDIF -IF (ALLOCATED(InitTypeData%PropsR)) THEN - DEALLOCATE(InitTypeData%PropsR) -ENDIF -IF (ALLOCATED(InitTypeData%K)) THEN - DEALLOCATE(InitTypeData%K) -ENDIF -IF (ALLOCATED(InitTypeData%M)) THEN - DEALLOCATE(InitTypeData%M) -ENDIF -IF (ALLOCATED(InitTypeData%ElemProps)) THEN - DEALLOCATE(InitTypeData%ElemProps) -ENDIF -IF (ALLOCATED(InitTypeData%MemberNodes)) THEN - DEALLOCATE(InitTypeData%MemberNodes) -ENDIF -IF (ALLOCATED(InitTypeData%NodesConnN)) THEN - DEALLOCATE(InitTypeData%NodesConnN) -ENDIF -IF (ALLOCATED(InitTypeData%NodesConnE)) THEN - DEALLOCATE(InitTypeData%NodesConnE) -ENDIF - END SUBROUTINE SD_DestroyInitType - - SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_InitType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackInitType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + SIZE(InData%TP_RefPoint) ! TP_RefPoint - Re_BufSz = Re_BufSz + 1 ! SubRotateZ - Re_BufSz = Re_BufSz + 1 ! g - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! NJoints - Int_BufSz = Int_BufSz + 1 ! NPropSetsX - Int_BufSz = Int_BufSz + 1 ! NPropSetsB - Int_BufSz = Int_BufSz + 1 ! NPropSetsC - Int_BufSz = Int_BufSz + 1 ! NPropSetsR - Int_BufSz = Int_BufSz + 1 ! NCMass - Int_BufSz = Int_BufSz + 1 ! NCOSMs - Int_BufSz = Int_BufSz + 1 ! FEMMod - Int_BufSz = Int_BufSz + 1 ! NDiv - Int_BufSz = Int_BufSz + 1 ! CBMod - Int_BufSz = Int_BufSz + 1 ! Joints allocated yes/no - IF ( ALLOCATED(InData%Joints) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Joints upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Joints) ! Joints - END IF - Int_BufSz = Int_BufSz + 1 ! PropSetsB allocated yes/no - IF ( ALLOCATED(InData%PropSetsB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropSetsB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropSetsB) ! PropSetsB - END IF - Int_BufSz = Int_BufSz + 1 ! PropSetsC allocated yes/no - IF ( ALLOCATED(InData%PropSetsC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropSetsC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropSetsC) ! PropSetsC - END IF - Int_BufSz = Int_BufSz + 1 ! PropSetsR allocated yes/no - IF ( ALLOCATED(InData%PropSetsR) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropSetsR upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropSetsR) ! PropSetsR - END IF - Int_BufSz = Int_BufSz + 1 ! PropSetsX allocated yes/no - IF ( ALLOCATED(InData%PropSetsX) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropSetsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropSetsX) ! PropSetsX - END IF - Int_BufSz = Int_BufSz + 1 ! COSMs allocated yes/no - IF ( ALLOCATED(InData%COSMs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! COSMs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%COSMs) ! COSMs - END IF - Int_BufSz = Int_BufSz + 1 ! CMass allocated yes/no - IF ( ALLOCATED(InData%CMass) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CMass) ! CMass - END IF - Int_BufSz = Int_BufSz + 1 ! JDampings allocated yes/no - IF ( ALLOCATED(InData%JDampings) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! JDampings upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%JDampings) ! JDampings - END IF - Int_BufSz = Int_BufSz + 1 ! GuyanDampMod - Re_BufSz = Re_BufSz + SIZE(InData%RayleighDamp) ! RayleighDamp - Re_BufSz = Re_BufSz + SIZE(InData%GuyanDampMat) ! GuyanDampMat - Int_BufSz = Int_BufSz + 1 ! Members allocated yes/no - IF ( ALLOCATED(InData%Members) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Members upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Members) ! Members - END IF - Int_BufSz = Int_BufSz + 1 ! SSOutList allocated yes/no - IF ( ALLOCATED(InData%SSOutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SSOutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%SSOutList)*LEN(InData%SSOutList) ! SSOutList - END IF - Int_BufSz = Int_BufSz + 1 ! OutCOSM - Int_BufSz = Int_BufSz + 1 ! TabDelim - Int_BufSz = Int_BufSz + 1 ! SSIK allocated yes/no - IF ( ALLOCATED(InData%SSIK) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SSIK upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%SSIK) ! SSIK - END IF - Int_BufSz = Int_BufSz + 1 ! SSIM allocated yes/no - IF ( ALLOCATED(InData%SSIM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SSIM upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%SSIM) ! SSIM - END IF - Int_BufSz = Int_BufSz + 1 ! SSIfile allocated yes/no - IF ( ALLOCATED(InData%SSIfile) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SSIfile upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%SSIfile)*LEN(InData%SSIfile) ! SSIfile - END IF - Int_BufSz = Int_BufSz + 1 ! Soil_K allocated yes/no - IF ( ALLOCATED(InData%Soil_K) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Soil_K upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Soil_K) ! Soil_K - END IF - Int_BufSz = Int_BufSz + 1 ! Soil_Points allocated yes/no - IF ( ALLOCATED(InData%Soil_Points) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Soil_Points upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Soil_Points) ! Soil_Points - END IF - Int_BufSz = Int_BufSz + 1 ! Soil_Nodes allocated yes/no - IF ( ALLOCATED(InData%Soil_Nodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Soil_Nodes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Soil_Nodes) ! Soil_Nodes - END IF - Int_BufSz = Int_BufSz + 1 ! NElem - Int_BufSz = Int_BufSz + 1 ! NPropB - Int_BufSz = Int_BufSz + 1 ! NPropC - Int_BufSz = Int_BufSz + 1 ! NPropR - Int_BufSz = Int_BufSz + 1 ! Nodes allocated yes/no - IF ( ALLOCATED(InData%Nodes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Nodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Nodes) ! Nodes - END IF - Int_BufSz = Int_BufSz + 1 ! PropsB allocated yes/no - IF ( ALLOCATED(InData%PropsB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropsB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropsB) ! PropsB - END IF - Int_BufSz = Int_BufSz + 1 ! PropsC allocated yes/no - IF ( ALLOCATED(InData%PropsC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropsC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropsC) ! PropsC - END IF - Int_BufSz = Int_BufSz + 1 ! PropsR allocated yes/no - IF ( ALLOCATED(InData%PropsR) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropsR upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropsR) ! PropsR - END IF - Int_BufSz = Int_BufSz + 1 ! K allocated yes/no - IF ( ALLOCATED(InData%K) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! K upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%K) ! K - END IF - Int_BufSz = Int_BufSz + 1 ! M allocated yes/no - IF ( ALLOCATED(InData%M) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%M) ! M - END IF - Int_BufSz = Int_BufSz + 1 ! ElemProps allocated yes/no - IF ( ALLOCATED(InData%ElemProps) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ElemProps upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ElemProps) ! ElemProps - END IF - Int_BufSz = Int_BufSz + 1 ! MemberNodes allocated yes/no - IF ( ALLOCATED(InData%MemberNodes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MemberNodes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%MemberNodes) ! MemberNodes - END IF - Int_BufSz = Int_BufSz + 1 ! NodesConnN allocated yes/no - IF ( ALLOCATED(InData%NodesConnN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! NodesConnN upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodesConnN) ! NodesConnN - END IF - Int_BufSz = Int_BufSz + 1 ! NodesConnE allocated yes/no - IF ( ALLOCATED(InData%NodesConnE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! NodesConnE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodesConnE) ! NodesConnE - END IF - Int_BufSz = Int_BufSz + 1 ! SSSum - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO i1 = LBOUND(InData%TP_RefPoint,1), UBOUND(InData%TP_RefPoint,1) - ReKiBuf(Re_Xferred) = InData%TP_RefPoint(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%SubRotateZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%g - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NJoints - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropSetsX - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropSetsB - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropSetsC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropSetsR - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NCMass - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NCOSMs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%FEMMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NDiv - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CBMod, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Joints) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Joints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Joints,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Joints,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Joints,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Joints,2), UBOUND(InData%Joints,2) - DO i1 = LBOUND(InData%Joints,1), UBOUND(InData%Joints,1) - ReKiBuf(Re_Xferred) = InData%Joints(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropSetsB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropSetsB,2), UBOUND(InData%PropSetsB,2) - DO i1 = LBOUND(InData%PropSetsB,1), UBOUND(InData%PropSetsB,1) - ReKiBuf(Re_Xferred) = InData%PropSetsB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropSetsC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropSetsC,2), UBOUND(InData%PropSetsC,2) - DO i1 = LBOUND(InData%PropSetsC,1), UBOUND(InData%PropSetsC,1) - ReKiBuf(Re_Xferred) = InData%PropSetsC(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropSetsR) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsR,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsR,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsR,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsR,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropSetsR,2), UBOUND(InData%PropSetsR,2) - DO i1 = LBOUND(InData%PropSetsR,1), UBOUND(InData%PropSetsR,1) - ReKiBuf(Re_Xferred) = InData%PropSetsR(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropSetsX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsX,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsX,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsX,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropSetsX,2), UBOUND(InData%PropSetsX,2) - DO i1 = LBOUND(InData%PropSetsX,1), UBOUND(InData%PropSetsX,1) - ReKiBuf(Re_Xferred) = InData%PropSetsX(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%COSMs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%COSMs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%COSMs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%COSMs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%COSMs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%COSMs,2), UBOUND(InData%COSMs,2) - DO i1 = LBOUND(InData%COSMs,1), UBOUND(InData%COSMs,1) - ReKiBuf(Re_Xferred) = InData%COSMs(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CMass) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMass,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMass,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMass,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CMass,2), UBOUND(InData%CMass,2) - DO i1 = LBOUND(InData%CMass,1), UBOUND(InData%CMass,1) - ReKiBuf(Re_Xferred) = InData%CMass(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%JDampings) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%JDampings,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%JDampings,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%JDampings,1), UBOUND(InData%JDampings,1) - ReKiBuf(Re_Xferred) = InData%JDampings(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%GuyanDampMod - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%RayleighDamp,1), UBOUND(InData%RayleighDamp,1) - ReKiBuf(Re_Xferred) = InData%RayleighDamp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%GuyanDampMat,2), UBOUND(InData%GuyanDampMat,2) - DO i1 = LBOUND(InData%GuyanDampMat,1), UBOUND(InData%GuyanDampMat,1) - ReKiBuf(Re_Xferred) = InData%GuyanDampMat(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%Members) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Members,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Members,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Members,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Members,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Members,2), UBOUND(InData%Members,2) - DO i1 = LBOUND(InData%Members,1), UBOUND(InData%Members,1) - IntKiBuf(Int_Xferred) = InData%Members(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SSOutList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SSOutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSOutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SSOutList,1), UBOUND(InData%SSOutList,1) - DO I = 1, LEN(InData%SSOutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%SSOutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutCOSM, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%SSIK) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIK,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIK,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIK,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIK,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SSIK,2), UBOUND(InData%SSIK,2) - DO i1 = LBOUND(InData%SSIK,1), UBOUND(InData%SSIK,1) - DbKiBuf(Db_Xferred) = InData%SSIK(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SSIM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SSIM,2), UBOUND(InData%SSIM,2) - DO i1 = LBOUND(InData%SSIM,1), UBOUND(InData%SSIM,1) - DbKiBuf(Db_Xferred) = InData%SSIM(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SSIfile) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIfile,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIfile,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SSIfile,1), UBOUND(InData%SSIfile,1) - DO I = 1, LEN(InData%SSIfile) - IntKiBuf(Int_Xferred) = ICHAR(InData%SSIfile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Soil_K) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_K,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_K,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_K,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_K,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_K,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_K,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Soil_K,3), UBOUND(InData%Soil_K,3) - DO i2 = LBOUND(InData%Soil_K,2), UBOUND(InData%Soil_K,2) - DO i1 = LBOUND(InData%Soil_K,1), UBOUND(InData%Soil_K,1) - ReKiBuf(Re_Xferred) = InData%Soil_K(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Soil_Points) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_Points,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_Points,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_Points,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_Points,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Soil_Points,2), UBOUND(InData%Soil_Points,2) - DO i1 = LBOUND(InData%Soil_Points,1), UBOUND(InData%Soil_Points,1) - ReKiBuf(Re_Xferred) = InData%Soil_Points(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Soil_Nodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_Nodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_Nodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Soil_Nodes,1), UBOUND(InData%Soil_Nodes,1) - IntKiBuf(Int_Xferred) = InData%Soil_Nodes(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NElem - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropB - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropR - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Nodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Nodes,2), UBOUND(InData%Nodes,2) - DO i1 = LBOUND(InData%Nodes,1), UBOUND(InData%Nodes,1) - ReKiBuf(Re_Xferred) = InData%Nodes(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropsB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropsB,2), UBOUND(InData%PropsB,2) - DO i1 = LBOUND(InData%PropsB,1), UBOUND(InData%PropsB,1) - ReKiBuf(Re_Xferred) = InData%PropsB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropsC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropsC,2), UBOUND(InData%PropsC,2) - DO i1 = LBOUND(InData%PropsC,1), UBOUND(InData%PropsC,1) - ReKiBuf(Re_Xferred) = InData%PropsC(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropsR) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsR,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsR,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsR,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsR,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropsR,2), UBOUND(InData%PropsR,2) - DO i1 = LBOUND(InData%PropsR,1), UBOUND(InData%PropsR,1) - ReKiBuf(Re_Xferred) = InData%PropsR(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%K) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%K,2), UBOUND(InData%K,2) - DO i1 = LBOUND(InData%K,1), UBOUND(InData%K,1) - DbKiBuf(Db_Xferred) = InData%K(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) - DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) - DbKiBuf(Db_Xferred) = InData%M(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElemProps) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemProps,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemProps,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemProps,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemProps,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ElemProps,2), UBOUND(InData%ElemProps,2) - DO i1 = LBOUND(InData%ElemProps,1), UBOUND(InData%ElemProps,1) - ReKiBuf(Re_Xferred) = InData%ElemProps(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MemberNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MemberNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MemberNodes,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MemberNodes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MemberNodes,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MemberNodes,2), UBOUND(InData%MemberNodes,2) - DO i1 = LBOUND(InData%MemberNodes,1), UBOUND(InData%MemberNodes,1) - IntKiBuf(Int_Xferred) = InData%MemberNodes(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodesConnN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesConnN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesConnN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%NodesConnN,2), UBOUND(InData%NodesConnN,2) - DO i1 = LBOUND(InData%NodesConnN,1), UBOUND(InData%NodesConnN,1) - IntKiBuf(Int_Xferred) = InData%NodesConnN(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodesConnE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesConnE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesConnE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%NodesConnE,2), UBOUND(InData%NodesConnE,2) - DO i1 = LBOUND(InData%NodesConnE,1), UBOUND(InData%NodesConnE,1) - IntKiBuf(Int_Xferred) = InData%NodesConnE(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%SSSum, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_PackInitType - - SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_InitType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackInitType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - i1_l = LBOUND(OutData%TP_RefPoint,1) - i1_u = UBOUND(OutData%TP_RefPoint,1) - DO i1 = LBOUND(OutData%TP_RefPoint,1), UBOUND(OutData%TP_RefPoint,1) - OutData%TP_RefPoint(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%SubRotateZ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%g = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NJoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropSetsX = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropSetsB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropSetsC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropSetsR = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NCMass = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NCOSMs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FEMMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NDiv = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CBMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%CBMod) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Joints not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Joints)) DEALLOCATE(OutData%Joints) - ALLOCATE(OutData%Joints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Joints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Joints,2), UBOUND(OutData%Joints,2) - DO i1 = LBOUND(OutData%Joints,1), UBOUND(OutData%Joints,1) - OutData%Joints(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropSetsB)) DEALLOCATE(OutData%PropSetsB) - ALLOCATE(OutData%PropSetsB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropSetsB,2), UBOUND(OutData%PropSetsB,2) - DO i1 = LBOUND(OutData%PropSetsB,1), UBOUND(OutData%PropSetsB,1) - OutData%PropSetsB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropSetsC)) DEALLOCATE(OutData%PropSetsC) - ALLOCATE(OutData%PropSetsC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropSetsC,2), UBOUND(OutData%PropSetsC,2) - DO i1 = LBOUND(OutData%PropSetsC,1), UBOUND(OutData%PropSetsC,1) - OutData%PropSetsC(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsR not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropSetsR)) DEALLOCATE(OutData%PropSetsR) - ALLOCATE(OutData%PropSetsR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropSetsR,2), UBOUND(OutData%PropSetsR,2) - DO i1 = LBOUND(OutData%PropSetsR,1), UBOUND(OutData%PropSetsR,1) - OutData%PropSetsR(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsX not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropSetsX)) DEALLOCATE(OutData%PropSetsX) - ALLOCATE(OutData%PropSetsX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropSetsX,2), UBOUND(OutData%PropSetsX,2) - DO i1 = LBOUND(OutData%PropSetsX,1), UBOUND(OutData%PropSetsX,1) - OutData%PropSetsX(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! COSMs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%COSMs)) DEALLOCATE(OutData%COSMs) - ALLOCATE(OutData%COSMs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%COSMs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%COSMs,2), UBOUND(OutData%COSMs,2) - DO i1 = LBOUND(OutData%COSMs,1), UBOUND(OutData%COSMs,1) - OutData%COSMs(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMass not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CMass)) DEALLOCATE(OutData%CMass) - ALLOCATE(OutData%CMass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CMass,2), UBOUND(OutData%CMass,2) - DO i1 = LBOUND(OutData%CMass,1), UBOUND(OutData%CMass,1) - OutData%CMass(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! JDampings not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%JDampings)) DEALLOCATE(OutData%JDampings) - ALLOCATE(OutData%JDampings(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%JDampings.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%JDampings,1), UBOUND(OutData%JDampings,1) - OutData%JDampings(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%GuyanDampMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RayleighDamp,1) - i1_u = UBOUND(OutData%RayleighDamp,1) - DO i1 = LBOUND(OutData%RayleighDamp,1), UBOUND(OutData%RayleighDamp,1) - OutData%RayleighDamp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%GuyanDampMat,1) - i1_u = UBOUND(OutData%GuyanDampMat,1) - i2_l = LBOUND(OutData%GuyanDampMat,2) - i2_u = UBOUND(OutData%GuyanDampMat,2) - DO i2 = LBOUND(OutData%GuyanDampMat,2), UBOUND(OutData%GuyanDampMat,2) - DO i1 = LBOUND(OutData%GuyanDampMat,1), UBOUND(OutData%GuyanDampMat,1) - OutData%GuyanDampMat(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Members not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Members)) DEALLOCATE(OutData%Members) - ALLOCATE(OutData%Members(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Members.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Members,2), UBOUND(OutData%Members,2) - DO i1 = LBOUND(OutData%Members,1), UBOUND(OutData%Members,1) - OutData%Members(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSOutList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SSOutList)) DEALLOCATE(OutData%SSOutList) - ALLOCATE(OutData%SSOutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSOutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SSOutList,1), UBOUND(OutData%SSOutList,1) - DO I = 1, LEN(OutData%SSOutList) - OutData%SSOutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%OutCOSM = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutCOSM) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSIK not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SSIK)) DEALLOCATE(OutData%SSIK) - ALLOCATE(OutData%SSIK(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SSIK,2), UBOUND(OutData%SSIK,2) - DO i1 = LBOUND(OutData%SSIK,1), UBOUND(OutData%SSIK,1) - OutData%SSIK(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSIM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SSIM)) DEALLOCATE(OutData%SSIM) - ALLOCATE(OutData%SSIM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SSIM,2), UBOUND(OutData%SSIM,2) - DO i1 = LBOUND(OutData%SSIM,1), UBOUND(OutData%SSIM,1) - OutData%SSIM(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSIfile not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SSIfile)) DEALLOCATE(OutData%SSIfile) - ALLOCATE(OutData%SSIfile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIfile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SSIfile,1), UBOUND(OutData%SSIfile,1) - DO I = 1, LEN(OutData%SSIfile) - OutData%SSIfile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Soil_K not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Soil_K)) DEALLOCATE(OutData%Soil_K) - ALLOCATE(OutData%Soil_K(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_K.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Soil_K,3), UBOUND(OutData%Soil_K,3) - DO i2 = LBOUND(OutData%Soil_K,2), UBOUND(OutData%Soil_K,2) - DO i1 = LBOUND(OutData%Soil_K,1), UBOUND(OutData%Soil_K,1) - OutData%Soil_K(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Soil_Points not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Soil_Points)) DEALLOCATE(OutData%Soil_Points) - ALLOCATE(OutData%Soil_Points(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_Points.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Soil_Points,2), UBOUND(OutData%Soil_Points,2) - DO i1 = LBOUND(OutData%Soil_Points,1), UBOUND(OutData%Soil_Points,1) - OutData%Soil_Points(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Soil_Nodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Soil_Nodes)) DEALLOCATE(OutData%Soil_Nodes) - ALLOCATE(OutData%Soil_Nodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Soil_Nodes,1), UBOUND(OutData%Soil_Nodes,1) - OutData%Soil_Nodes(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NElem = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropR = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Nodes)) DEALLOCATE(OutData%Nodes) - ALLOCATE(OutData%Nodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Nodes,2), UBOUND(OutData%Nodes,2) - DO i1 = LBOUND(OutData%Nodes,1), UBOUND(OutData%Nodes,1) - OutData%Nodes(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropsB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropsB)) DEALLOCATE(OutData%PropsB) - ALLOCATE(OutData%PropsB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropsB,2), UBOUND(OutData%PropsB,2) - DO i1 = LBOUND(OutData%PropsB,1), UBOUND(OutData%PropsB,1) - OutData%PropsB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropsC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropsC)) DEALLOCATE(OutData%PropsC) - ALLOCATE(OutData%PropsC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropsC,2), UBOUND(OutData%PropsC,2) - DO i1 = LBOUND(OutData%PropsC,1), UBOUND(OutData%PropsC,1) - OutData%PropsC(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropsR not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropsR)) DEALLOCATE(OutData%PropsR) - ALLOCATE(OutData%PropsR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropsR,2), UBOUND(OutData%PropsR,2) - DO i1 = LBOUND(OutData%PropsR,1), UBOUND(OutData%PropsR,1) - OutData%PropsR(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%K)) DEALLOCATE(OutData%K) - ALLOCATE(OutData%K(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%K,2), UBOUND(OutData%K,2) - DO i1 = LBOUND(OutData%K,1), UBOUND(OutData%K,1) - OutData%K(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%M)) DEALLOCATE(OutData%M) - ALLOCATE(OutData%M(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) - DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) - OutData%M(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElemProps not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ElemProps)) DEALLOCATE(OutData%ElemProps) - ALLOCATE(OutData%ElemProps(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ElemProps,2), UBOUND(OutData%ElemProps,2) - DO i1 = LBOUND(OutData%ElemProps,1), UBOUND(OutData%ElemProps,1) - OutData%ElemProps(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MemberNodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MemberNodes)) DEALLOCATE(OutData%MemberNodes) - ALLOCATE(OutData%MemberNodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MemberNodes,2), UBOUND(OutData%MemberNodes,2) - DO i1 = LBOUND(OutData%MemberNodes,1), UBOUND(OutData%MemberNodes,1) - OutData%MemberNodes(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesConnN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodesConnN)) DEALLOCATE(OutData%NodesConnN) - ALLOCATE(OutData%NodesConnN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%NodesConnN,2), UBOUND(OutData%NodesConnN,2) - DO i1 = LBOUND(OutData%NodesConnN,1), UBOUND(OutData%NodesConnN,1) - OutData%NodesConnN(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesConnE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodesConnE)) DEALLOCATE(OutData%NodesConnE) - ALLOCATE(OutData%NodesConnE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%NodesConnE,2), UBOUND(OutData%NodesConnE,2) - DO i1 = LBOUND(OutData%NodesConnE,1), UBOUND(OutData%NodesConnE,1) - OutData%NodesConnE(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%SSSum = TRANSFER(IntKiBuf(Int_Xferred), OutData%SSSum) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_UnPackInitType - - SUBROUTINE SD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(SD_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%qm)) THEN - i1_l = LBOUND(SrcContStateData%qm,1) - i1_u = UBOUND(SrcContStateData%qm,1) - IF (.NOT. ALLOCATED(DstContStateData%qm)) THEN - ALLOCATE(DstContStateData%qm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%qm = SrcContStateData%qm -ENDIF -IF (ALLOCATED(SrcContStateData%qmdot)) THEN - i1_l = LBOUND(SrcContStateData%qmdot,1) - i1_u = UBOUND(SrcContStateData%qmdot,1) - IF (.NOT. ALLOCATED(DstContStateData%qmdot)) THEN - ALLOCATE(DstContStateData%qmdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qmdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%qmdot = SrcContStateData%qmdot -ENDIF - END SUBROUTINE SD_CopyContState - - SUBROUTINE SD_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(SD_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyContState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ContStateData%qm)) THEN - DEALLOCATE(ContStateData%qm) -ENDIF -IF (ALLOCATED(ContStateData%qmdot)) THEN - DEALLOCATE(ContStateData%qmdot) -ENDIF - END SUBROUTINE SD_DestroyContState - - SUBROUTINE SD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! qm allocated yes/no - IF ( ALLOCATED(InData%qm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! qm upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%qm) ! qm - END IF - Int_BufSz = Int_BufSz + 1 ! qmdot allocated yes/no - IF ( ALLOCATED(InData%qmdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! qmdot upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%qmdot) ! qmdot - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%qm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%qm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%qm,1), UBOUND(InData%qm,1) - DbKiBuf(Db_Xferred) = InData%qm(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%qmdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%qmdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qmdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%qmdot,1), UBOUND(InData%qmdot,1) - DbKiBuf(Db_Xferred) = InData%qmdot(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackContState - - SUBROUTINE SD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qm not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%qm)) DEALLOCATE(OutData%qm) - ALLOCATE(OutData%qm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%qm,1), UBOUND(OutData%qm,1) - OutData%qm(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qmdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%qmdot)) DEALLOCATE(OutData%qmdot) - ALLOCATE(OutData%qmdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%qmdot,1), UBOUND(OutData%qmdot,1) - OutData%qmdot(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackContState - - SUBROUTINE SD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(SD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE SD_CopyDiscState - - SUBROUTINE SD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(SD_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyDiscState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE SD_DestroyDiscState - - SUBROUTINE SD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyDiscState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SD_PackDiscState - - SUBROUTINE SD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SD_UnPackDiscState - - SUBROUTINE SD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(SD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE SD_CopyConstrState - - SUBROUTINE SD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(SD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyConstrState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE SD_DestroyConstrState - - SUBROUTINE SD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SD_PackConstrState - - SUBROUTINE SD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SD_UnPackConstrState - - SUBROUTINE SD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(SD_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%xdot)) THEN - i1_l = LBOUND(SrcOtherStateData%xdot,1) - i1_u = UBOUND(SrcOtherStateData%xdot,1) - IF (.NOT. ALLOCATED(DstOtherStateData%xdot)) THEN - ALLOCATE(DstOtherStateData%xdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL SD_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstOtherStateData%n = SrcOtherStateData%n - END SUBROUTINE SD_CopyOtherState - - SUBROUTINE SD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(SD_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyOtherState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(OtherStateData%xdot)) THEN -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL SD_DestroyContState( OtherStateData%xdot(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(OtherStateData%xdot) -ENDIF - END SUBROUTINE SD_DestroyOtherState - - SUBROUTINE SD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! xdot allocated yes/no - IF ( ALLOCATED(InData%xdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xdot upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdot - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdot - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdot - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! n - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%xdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%n - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_PackOtherState - - SUBROUTINE SD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xdot)) DEALLOCATE(OutData%xdot) - ALLOCATE(OutData%xdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_UnPackOtherState - - SUBROUTINE SD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(SD_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%qmdotdot)) THEN - i1_l = LBOUND(SrcMiscData%qmdotdot,1) - i1_u = UBOUND(SrcMiscData%qmdotdot,1) - IF (.NOT. ALLOCATED(DstMiscData%qmdotdot)) THEN - ALLOCATE(DstMiscData%qmdotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%qmdotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%qmdotdot = SrcMiscData%qmdotdot -ENDIF - DstMiscData%u_TP = SrcMiscData%u_TP - DstMiscData%udot_TP = SrcMiscData%udot_TP - DstMiscData%udotdot_TP = SrcMiscData%udotdot_TP -IF (ALLOCATED(SrcMiscData%F_L)) THEN - i1_l = LBOUND(SrcMiscData%F_L,1) - i1_u = UBOUND(SrcMiscData%F_L,1) - IF (.NOT. ALLOCATED(DstMiscData%F_L)) THEN - ALLOCATE(DstMiscData%F_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_L = SrcMiscData%F_L -ENDIF -IF (ALLOCATED(SrcMiscData%UR_bar)) THEN - i1_l = LBOUND(SrcMiscData%UR_bar,1) - i1_u = UBOUND(SrcMiscData%UR_bar,1) - IF (.NOT. ALLOCATED(DstMiscData%UR_bar)) THEN - ALLOCATE(DstMiscData%UR_bar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UR_bar = SrcMiscData%UR_bar -ENDIF -IF (ALLOCATED(SrcMiscData%UR_bar_dot)) THEN - i1_l = LBOUND(SrcMiscData%UR_bar_dot,1) - i1_u = UBOUND(SrcMiscData%UR_bar_dot,1) - IF (.NOT. ALLOCATED(DstMiscData%UR_bar_dot)) THEN - ALLOCATE(DstMiscData%UR_bar_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UR_bar_dot = SrcMiscData%UR_bar_dot -ENDIF -IF (ALLOCATED(SrcMiscData%UR_bar_dotdot)) THEN - i1_l = LBOUND(SrcMiscData%UR_bar_dotdot,1) - i1_u = UBOUND(SrcMiscData%UR_bar_dotdot,1) - IF (.NOT. ALLOCATED(DstMiscData%UR_bar_dotdot)) THEN - ALLOCATE(DstMiscData%UR_bar_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UR_bar_dotdot = SrcMiscData%UR_bar_dotdot -ENDIF -IF (ALLOCATED(SrcMiscData%UL)) THEN - i1_l = LBOUND(SrcMiscData%UL,1) - i1_u = UBOUND(SrcMiscData%UL,1) - IF (.NOT. ALLOCATED(DstMiscData%UL)) THEN - ALLOCATE(DstMiscData%UL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL = SrcMiscData%UL -ENDIF -IF (ALLOCATED(SrcMiscData%UL_dot)) THEN - i1_l = LBOUND(SrcMiscData%UL_dot,1) - i1_u = UBOUND(SrcMiscData%UL_dot,1) - IF (.NOT. ALLOCATED(DstMiscData%UL_dot)) THEN - ALLOCATE(DstMiscData%UL_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL_dot = SrcMiscData%UL_dot -ENDIF -IF (ALLOCATED(SrcMiscData%UL_dotdot)) THEN - i1_l = LBOUND(SrcMiscData%UL_dotdot,1) - i1_u = UBOUND(SrcMiscData%UL_dotdot,1) - IF (.NOT. ALLOCATED(DstMiscData%UL_dotdot)) THEN - ALLOCATE(DstMiscData%UL_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL_dotdot = SrcMiscData%UL_dotdot -ENDIF -IF (ALLOCATED(SrcMiscData%DU_full)) THEN - i1_l = LBOUND(SrcMiscData%DU_full,1) - i1_u = UBOUND(SrcMiscData%DU_full,1) - IF (.NOT. ALLOCATED(DstMiscData%DU_full)) THEN - ALLOCATE(DstMiscData%DU_full(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DU_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%DU_full = SrcMiscData%DU_full -ENDIF -IF (ALLOCATED(SrcMiscData%U_full)) THEN - i1_l = LBOUND(SrcMiscData%U_full,1) - i1_u = UBOUND(SrcMiscData%U_full,1) - IF (.NOT. ALLOCATED(DstMiscData%U_full)) THEN - ALLOCATE(DstMiscData%U_full(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_full = SrcMiscData%U_full -ENDIF -IF (ALLOCATED(SrcMiscData%U_full_dot)) THEN - i1_l = LBOUND(SrcMiscData%U_full_dot,1) - i1_u = UBOUND(SrcMiscData%U_full_dot,1) - IF (.NOT. ALLOCATED(DstMiscData%U_full_dot)) THEN - ALLOCATE(DstMiscData%U_full_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_full_dot = SrcMiscData%U_full_dot -ENDIF -IF (ALLOCATED(SrcMiscData%U_full_dotdot)) THEN - i1_l = LBOUND(SrcMiscData%U_full_dotdot,1) - i1_u = UBOUND(SrcMiscData%U_full_dotdot,1) - IF (.NOT. ALLOCATED(DstMiscData%U_full_dotdot)) THEN - ALLOCATE(DstMiscData%U_full_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_full_dotdot = SrcMiscData%U_full_dotdot -ENDIF -IF (ALLOCATED(SrcMiscData%U_full_elast)) THEN - i1_l = LBOUND(SrcMiscData%U_full_elast,1) - i1_u = UBOUND(SrcMiscData%U_full_elast,1) - IF (.NOT. ALLOCATED(DstMiscData%U_full_elast)) THEN - ALLOCATE(DstMiscData%U_full_elast(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_elast.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_full_elast = SrcMiscData%U_full_elast -ENDIF -IF (ALLOCATED(SrcMiscData%U_red)) THEN - i1_l = LBOUND(SrcMiscData%U_red,1) - i1_u = UBOUND(SrcMiscData%U_red,1) - IF (.NOT. ALLOCATED(DstMiscData%U_red)) THEN - ALLOCATE(DstMiscData%U_red(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_red = SrcMiscData%U_red -ENDIF -IF (ALLOCATED(SrcMiscData%U_red_dot)) THEN - i1_l = LBOUND(SrcMiscData%U_red_dot,1) - i1_u = UBOUND(SrcMiscData%U_red_dot,1) - IF (.NOT. ALLOCATED(DstMiscData%U_red_dot)) THEN - ALLOCATE(DstMiscData%U_red_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_red_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_red_dot = SrcMiscData%U_red_dot -ENDIF -IF (ALLOCATED(SrcMiscData%U_red_dotdot)) THEN - i1_l = LBOUND(SrcMiscData%U_red_dotdot,1) - i1_u = UBOUND(SrcMiscData%U_red_dotdot,1) - IF (.NOT. ALLOCATED(DstMiscData%U_red_dotdot)) THEN - ALLOCATE(DstMiscData%U_red_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_red_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_red_dotdot = SrcMiscData%U_red_dotdot -ENDIF -IF (ALLOCATED(SrcMiscData%FC_unit)) THEN - i1_l = LBOUND(SrcMiscData%FC_unit,1) - i1_u = UBOUND(SrcMiscData%FC_unit,1) - IF (.NOT. ALLOCATED(DstMiscData%FC_unit)) THEN - ALLOCATE(DstMiscData%FC_unit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FC_unit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FC_unit = SrcMiscData%FC_unit -ENDIF -IF (ALLOCATED(SrcMiscData%SDWrOutput)) THEN - i1_l = LBOUND(SrcMiscData%SDWrOutput,1) - i1_u = UBOUND(SrcMiscData%SDWrOutput,1) - IF (.NOT. ALLOCATED(DstMiscData%SDWrOutput)) THEN - ALLOCATE(DstMiscData%SDWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SDWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SDWrOutput = SrcMiscData%SDWrOutput -ENDIF - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%Decimat = SrcMiscData%Decimat -IF (ALLOCATED(SrcMiscData%Fext)) THEN - i1_l = LBOUND(SrcMiscData%Fext,1) - i1_u = UBOUND(SrcMiscData%Fext,1) - IF (.NOT. ALLOCATED(DstMiscData%Fext)) THEN - ALLOCATE(DstMiscData%Fext(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Fext = SrcMiscData%Fext -ENDIF -IF (ALLOCATED(SrcMiscData%Fext_red)) THEN - i1_l = LBOUND(SrcMiscData%Fext_red,1) - i1_u = UBOUND(SrcMiscData%Fext_red,1) - IF (.NOT. ALLOCATED(DstMiscData%Fext_red)) THEN - ALLOCATE(DstMiscData%Fext_red(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Fext_red = SrcMiscData%Fext_red -ENDIF - END SUBROUTINE SD_CopyMisc - - SUBROUTINE SD_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(SD_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyMisc' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(MiscData%qmdotdot)) THEN - DEALLOCATE(MiscData%qmdotdot) -ENDIF -IF (ALLOCATED(MiscData%F_L)) THEN - DEALLOCATE(MiscData%F_L) -ENDIF -IF (ALLOCATED(MiscData%UR_bar)) THEN - DEALLOCATE(MiscData%UR_bar) -ENDIF -IF (ALLOCATED(MiscData%UR_bar_dot)) THEN - DEALLOCATE(MiscData%UR_bar_dot) -ENDIF -IF (ALLOCATED(MiscData%UR_bar_dotdot)) THEN - DEALLOCATE(MiscData%UR_bar_dotdot) -ENDIF -IF (ALLOCATED(MiscData%UL)) THEN - DEALLOCATE(MiscData%UL) -ENDIF -IF (ALLOCATED(MiscData%UL_dot)) THEN - DEALLOCATE(MiscData%UL_dot) -ENDIF -IF (ALLOCATED(MiscData%UL_dotdot)) THEN - DEALLOCATE(MiscData%UL_dotdot) -ENDIF -IF (ALLOCATED(MiscData%DU_full)) THEN - DEALLOCATE(MiscData%DU_full) -ENDIF -IF (ALLOCATED(MiscData%U_full)) THEN - DEALLOCATE(MiscData%U_full) -ENDIF -IF (ALLOCATED(MiscData%U_full_dot)) THEN - DEALLOCATE(MiscData%U_full_dot) -ENDIF -IF (ALLOCATED(MiscData%U_full_dotdot)) THEN - DEALLOCATE(MiscData%U_full_dotdot) -ENDIF -IF (ALLOCATED(MiscData%U_full_elast)) THEN - DEALLOCATE(MiscData%U_full_elast) -ENDIF -IF (ALLOCATED(MiscData%U_red)) THEN - DEALLOCATE(MiscData%U_red) -ENDIF -IF (ALLOCATED(MiscData%U_red_dot)) THEN - DEALLOCATE(MiscData%U_red_dot) -ENDIF -IF (ALLOCATED(MiscData%U_red_dotdot)) THEN - DEALLOCATE(MiscData%U_red_dotdot) -ENDIF -IF (ALLOCATED(MiscData%FC_unit)) THEN - DEALLOCATE(MiscData%FC_unit) -ENDIF -IF (ALLOCATED(MiscData%SDWrOutput)) THEN - DEALLOCATE(MiscData%SDWrOutput) -ENDIF -IF (ALLOCATED(MiscData%Fext)) THEN - DEALLOCATE(MiscData%Fext) -ENDIF -IF (ALLOCATED(MiscData%Fext_red)) THEN - DEALLOCATE(MiscData%Fext_red) -ENDIF - END SUBROUTINE SD_DestroyMisc - - SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! qmdotdot allocated yes/no - IF ( ALLOCATED(InData%qmdotdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! qmdotdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%qmdotdot) ! qmdotdot - END IF - Re_BufSz = Re_BufSz + SIZE(InData%u_TP) ! u_TP - Re_BufSz = Re_BufSz + SIZE(InData%udot_TP) ! udot_TP - Re_BufSz = Re_BufSz + SIZE(InData%udotdot_TP) ! udotdot_TP - Int_BufSz = Int_BufSz + 1 ! F_L allocated yes/no - IF ( ALLOCATED(InData%F_L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_L upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_L) ! F_L - END IF - Int_BufSz = Int_BufSz + 1 ! UR_bar allocated yes/no - IF ( ALLOCATED(InData%UR_bar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UR_bar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UR_bar) ! UR_bar - END IF - Int_BufSz = Int_BufSz + 1 ! UR_bar_dot allocated yes/no - IF ( ALLOCATED(InData%UR_bar_dot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UR_bar_dot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UR_bar_dot) ! UR_bar_dot - END IF - Int_BufSz = Int_BufSz + 1 ! UR_bar_dotdot allocated yes/no - IF ( ALLOCATED(InData%UR_bar_dotdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UR_bar_dotdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UR_bar_dotdot) ! UR_bar_dotdot - END IF - Int_BufSz = Int_BufSz + 1 ! UL allocated yes/no - IF ( ALLOCATED(InData%UL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL) ! UL - END IF - Int_BufSz = Int_BufSz + 1 ! UL_dot allocated yes/no - IF ( ALLOCATED(InData%UL_dot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL_dot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL_dot) ! UL_dot - END IF - Int_BufSz = Int_BufSz + 1 ! UL_dotdot allocated yes/no - IF ( ALLOCATED(InData%UL_dotdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL_dotdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL_dotdot) ! UL_dotdot - END IF - Int_BufSz = Int_BufSz + 1 ! DU_full allocated yes/no - IF ( ALLOCATED(InData%DU_full) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DU_full upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DU_full) ! DU_full - END IF - Int_BufSz = Int_BufSz + 1 ! U_full allocated yes/no - IF ( ALLOCATED(InData%U_full) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_full upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_full) ! U_full - END IF - Int_BufSz = Int_BufSz + 1 ! U_full_dot allocated yes/no - IF ( ALLOCATED(InData%U_full_dot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_full_dot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_full_dot) ! U_full_dot - END IF - Int_BufSz = Int_BufSz + 1 ! U_full_dotdot allocated yes/no - IF ( ALLOCATED(InData%U_full_dotdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_full_dotdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_full_dotdot) ! U_full_dotdot - END IF - Int_BufSz = Int_BufSz + 1 ! U_full_elast allocated yes/no - IF ( ALLOCATED(InData%U_full_elast) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_full_elast upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_full_elast) ! U_full_elast - END IF - Int_BufSz = Int_BufSz + 1 ! U_red allocated yes/no - IF ( ALLOCATED(InData%U_red) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_red upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_red) ! U_red - END IF - Int_BufSz = Int_BufSz + 1 ! U_red_dot allocated yes/no - IF ( ALLOCATED(InData%U_red_dot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_red_dot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_red_dot) ! U_red_dot - END IF - Int_BufSz = Int_BufSz + 1 ! U_red_dotdot allocated yes/no - IF ( ALLOCATED(InData%U_red_dotdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_red_dotdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_red_dotdot) ! U_red_dotdot - END IF - Int_BufSz = Int_BufSz + 1 ! FC_unit allocated yes/no - IF ( ALLOCATED(InData%FC_unit) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FC_unit upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FC_unit) ! FC_unit - END IF - Int_BufSz = Int_BufSz + 1 ! SDWrOutput allocated yes/no - IF ( ALLOCATED(InData%SDWrOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SDWrOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SDWrOutput) ! SDWrOutput - END IF - Db_BufSz = Db_BufSz + 1 ! LastOutTime - Int_BufSz = Int_BufSz + 1 ! Decimat - Int_BufSz = Int_BufSz + 1 ! Fext allocated yes/no - IF ( ALLOCATED(InData%Fext) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fext upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Fext) ! Fext - END IF - Int_BufSz = Int_BufSz + 1 ! Fext_red allocated yes/no - IF ( ALLOCATED(InData%Fext_red) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fext_red upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Fext_red) ! Fext_red - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%qmdotdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%qmdotdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qmdotdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%qmdotdot,1), UBOUND(InData%qmdotdot,1) - ReKiBuf(Re_Xferred) = InData%qmdotdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%u_TP,1), UBOUND(InData%u_TP,1) - ReKiBuf(Re_Xferred) = InData%u_TP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%udot_TP,1), UBOUND(InData%udot_TP,1) - ReKiBuf(Re_Xferred) = InData%udot_TP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%udotdot_TP,1), UBOUND(InData%udotdot_TP,1) - ReKiBuf(Re_Xferred) = InData%udotdot_TP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%F_L) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_L,1), UBOUND(InData%F_L,1) - ReKiBuf(Re_Xferred) = InData%F_L(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UR_bar) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UR_bar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UR_bar,1), UBOUND(InData%UR_bar,1) - ReKiBuf(Re_Xferred) = InData%UR_bar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UR_bar_dot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UR_bar_dot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar_dot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UR_bar_dot,1), UBOUND(InData%UR_bar_dot,1) - ReKiBuf(Re_Xferred) = InData%UR_bar_dot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UR_bar_dotdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UR_bar_dotdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar_dotdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UR_bar_dotdot,1), UBOUND(InData%UR_bar_dotdot,1) - ReKiBuf(Re_Xferred) = InData%UR_bar_dotdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL,1), UBOUND(InData%UL,1) - ReKiBuf(Re_Xferred) = InData%UL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL_dot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UL_dot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_dot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL_dot,1), UBOUND(InData%UL_dot,1) - ReKiBuf(Re_Xferred) = InData%UL_dot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL_dotdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UL_dotdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_dotdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL_dotdot,1), UBOUND(InData%UL_dotdot,1) - ReKiBuf(Re_Xferred) = InData%UL_dotdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DU_full) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DU_full,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DU_full,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DU_full,1), UBOUND(InData%DU_full,1) - ReKiBuf(Re_Xferred) = InData%DU_full(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_full) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U_full,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_full,1), UBOUND(InData%U_full,1) - ReKiBuf(Re_Xferred) = InData%U_full(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_full_dot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U_full_dot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full_dot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_full_dot,1), UBOUND(InData%U_full_dot,1) - ReKiBuf(Re_Xferred) = InData%U_full_dot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_full_dotdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U_full_dotdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full_dotdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_full_dotdot,1), UBOUND(InData%U_full_dotdot,1) - ReKiBuf(Re_Xferred) = InData%U_full_dotdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_full_elast) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U_full_elast,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full_elast,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_full_elast,1), UBOUND(InData%U_full_elast,1) - ReKiBuf(Re_Xferred) = InData%U_full_elast(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_red) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U_red,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_red,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_red,1), UBOUND(InData%U_red,1) - ReKiBuf(Re_Xferred) = InData%U_red(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_red_dot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U_red_dot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_red_dot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_red_dot,1), UBOUND(InData%U_red_dot,1) - ReKiBuf(Re_Xferred) = InData%U_red_dot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_red_dotdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U_red_dotdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_red_dotdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_red_dotdot,1), UBOUND(InData%U_red_dotdot,1) - ReKiBuf(Re_Xferred) = InData%U_red_dotdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FC_unit) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FC_unit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FC_unit,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FC_unit,1), UBOUND(InData%FC_unit,1) - ReKiBuf(Re_Xferred) = InData%FC_unit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SDWrOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SDWrOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SDWrOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SDWrOutput,1), UBOUND(InData%SDWrOutput,1) - ReKiBuf(Re_Xferred) = InData%SDWrOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%LastOutTime - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Decimat - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Fext) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fext,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fext,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fext,1), UBOUND(InData%Fext,1) - ReKiBuf(Re_Xferred) = InData%Fext(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fext_red) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fext_red,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fext_red,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fext_red,1), UBOUND(InData%Fext_red,1) - ReKiBuf(Re_Xferred) = InData%Fext_red(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackMisc - - SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qmdotdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%qmdotdot)) DEALLOCATE(OutData%qmdotdot) - ALLOCATE(OutData%qmdotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%qmdotdot,1), UBOUND(OutData%qmdotdot,1) - OutData%qmdotdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%u_TP,1) - i1_u = UBOUND(OutData%u_TP,1) - DO i1 = LBOUND(OutData%u_TP,1), UBOUND(OutData%u_TP,1) - OutData%u_TP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%udot_TP,1) - i1_u = UBOUND(OutData%udot_TP,1) - DO i1 = LBOUND(OutData%udot_TP,1), UBOUND(OutData%udot_TP,1) - OutData%udot_TP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%udotdot_TP,1) - i1_u = UBOUND(OutData%udotdot_TP,1) - DO i1 = LBOUND(OutData%udotdot_TP,1), UBOUND(OutData%udotdot_TP,1) - OutData%udotdot_TP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_L not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_L)) DEALLOCATE(OutData%F_L) - ALLOCATE(OutData%F_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_L,1), UBOUND(OutData%F_L,1) - OutData%F_L(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UR_bar)) DEALLOCATE(OutData%UR_bar) - ALLOCATE(OutData%UR_bar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UR_bar,1), UBOUND(OutData%UR_bar,1) - OutData%UR_bar(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar_dot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UR_bar_dot)) DEALLOCATE(OutData%UR_bar_dot) - ALLOCATE(OutData%UR_bar_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UR_bar_dot,1), UBOUND(OutData%UR_bar_dot,1) - OutData%UR_bar_dot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar_dotdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UR_bar_dotdot)) DEALLOCATE(OutData%UR_bar_dotdot) - ALLOCATE(OutData%UR_bar_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UR_bar_dotdot,1), UBOUND(OutData%UR_bar_dotdot,1) - OutData%UR_bar_dotdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UL)) DEALLOCATE(OutData%UL) - ALLOCATE(OutData%UL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL,1), UBOUND(OutData%UL,1) - OutData%UL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_dot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UL_dot)) DEALLOCATE(OutData%UL_dot) - ALLOCATE(OutData%UL_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL_dot,1), UBOUND(OutData%UL_dot,1) - OutData%UL_dot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_dotdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UL_dotdot)) DEALLOCATE(OutData%UL_dotdot) - ALLOCATE(OutData%UL_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL_dotdot,1), UBOUND(OutData%UL_dotdot,1) - OutData%UL_dotdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DU_full not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DU_full)) DEALLOCATE(OutData%DU_full) - ALLOCATE(OutData%DU_full(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DU_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DU_full,1), UBOUND(OutData%DU_full,1) - OutData%DU_full(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U_full)) DEALLOCATE(OutData%U_full) - ALLOCATE(OutData%U_full(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_full,1), UBOUND(OutData%U_full,1) - OutData%U_full(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full_dot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U_full_dot)) DEALLOCATE(OutData%U_full_dot) - ALLOCATE(OutData%U_full_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_full_dot,1), UBOUND(OutData%U_full_dot,1) - OutData%U_full_dot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full_dotdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U_full_dotdot)) DEALLOCATE(OutData%U_full_dotdot) - ALLOCATE(OutData%U_full_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_full_dotdot,1), UBOUND(OutData%U_full_dotdot,1) - OutData%U_full_dotdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full_elast not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U_full_elast)) DEALLOCATE(OutData%U_full_elast) - ALLOCATE(OutData%U_full_elast(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_elast.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_full_elast,1), UBOUND(OutData%U_full_elast,1) - OutData%U_full_elast(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_red not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U_red)) DEALLOCATE(OutData%U_red) - ALLOCATE(OutData%U_red(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_red,1), UBOUND(OutData%U_red,1) - OutData%U_red(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_red_dot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U_red_dot)) DEALLOCATE(OutData%U_red_dot) - ALLOCATE(OutData%U_red_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_red_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_red_dot,1), UBOUND(OutData%U_red_dot,1) - OutData%U_red_dot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_red_dotdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U_red_dotdot)) DEALLOCATE(OutData%U_red_dotdot) - ALLOCATE(OutData%U_red_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_red_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_red_dotdot,1), UBOUND(OutData%U_red_dotdot,1) - OutData%U_red_dotdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FC_unit not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FC_unit)) DEALLOCATE(OutData%FC_unit) - ALLOCATE(OutData%FC_unit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FC_unit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FC_unit,1), UBOUND(OutData%FC_unit,1) - OutData%FC_unit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SDWrOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SDWrOutput)) DEALLOCATE(OutData%SDWrOutput) - ALLOCATE(OutData%SDWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SDWrOutput,1), UBOUND(OutData%SDWrOutput,1) - OutData%SDWrOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%LastOutTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Decimat = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fext not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Fext)) DEALLOCATE(OutData%Fext) - ALLOCATE(OutData%Fext(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fext.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Fext,1), UBOUND(OutData%Fext,1) - OutData%Fext(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fext_red not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Fext_red)) DEALLOCATE(OutData%Fext_red) - ALLOCATE(OutData%Fext_red(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fext_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Fext_red,1), UBOUND(OutData%Fext_red,1) - OutData%Fext_red(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackMisc - - SUBROUTINE SD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SD_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%SDDeltaT = SrcParamData%SDDeltaT - DstParamData%IntMethod = SrcParamData%IntMethod - DstParamData%nDOF = SrcParamData%nDOF - DstParamData%nDOF_red = SrcParamData%nDOF_red - DstParamData%Nmembers = SrcParamData%Nmembers -IF (ALLOCATED(SrcParamData%Elems)) THEN - i1_l = LBOUND(SrcParamData%Elems,1) - i1_u = UBOUND(SrcParamData%Elems,1) - i2_l = LBOUND(SrcParamData%Elems,2) - i2_u = UBOUND(SrcParamData%Elems,2) - IF (.NOT. ALLOCATED(DstParamData%Elems)) THEN - ALLOCATE(DstParamData%Elems(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Elems.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Elems = SrcParamData%Elems -ENDIF -IF (ALLOCATED(SrcParamData%ElemProps)) THEN - i1_l = LBOUND(SrcParamData%ElemProps,1) - i1_u = UBOUND(SrcParamData%ElemProps,1) - IF (.NOT. ALLOCATED(DstParamData%ElemProps)) THEN - ALLOCATE(DstParamData%ElemProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%ElemProps,1), UBOUND(SrcParamData%ElemProps,1) - CALL SD_Copyelemproptype( SrcParamData%ElemProps(i1), DstParamData%ElemProps(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%FG)) THEN - i1_l = LBOUND(SrcParamData%FG,1) - i1_u = UBOUND(SrcParamData%FG,1) - IF (.NOT. ALLOCATED(DstParamData%FG)) THEN - ALLOCATE(DstParamData%FG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FG = SrcParamData%FG -ENDIF -IF (ALLOCATED(SrcParamData%DP0)) THEN - i1_l = LBOUND(SrcParamData%DP0,1) - i1_u = UBOUND(SrcParamData%DP0,1) - i2_l = LBOUND(SrcParamData%DP0,2) - i2_u = UBOUND(SrcParamData%DP0,2) - IF (.NOT. ALLOCATED(DstParamData%DP0)) THEN - ALLOCATE(DstParamData%DP0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DP0 = SrcParamData%DP0 -ENDIF - DstParamData%reduced = SrcParamData%reduced -IF (ALLOCATED(SrcParamData%T_red)) THEN - i1_l = LBOUND(SrcParamData%T_red,1) - i1_u = UBOUND(SrcParamData%T_red,1) - i2_l = LBOUND(SrcParamData%T_red,2) - i2_u = UBOUND(SrcParamData%T_red,2) - IF (.NOT. ALLOCATED(DstParamData%T_red)) THEN - ALLOCATE(DstParamData%T_red(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%T_red = SrcParamData%T_red -ENDIF -IF (ALLOCATED(SrcParamData%T_red_T)) THEN - i1_l = LBOUND(SrcParamData%T_red_T,1) - i1_u = UBOUND(SrcParamData%T_red_T,1) - i2_l = LBOUND(SrcParamData%T_red_T,2) - i2_u = UBOUND(SrcParamData%T_red_T,2) - IF (.NOT. ALLOCATED(DstParamData%T_red_T)) THEN - ALLOCATE(DstParamData%T_red_T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%T_red_T = SrcParamData%T_red_T -ENDIF -IF (ALLOCATED(SrcParamData%NodesDOF)) THEN - i1_l = LBOUND(SrcParamData%NodesDOF,1) - i1_u = UBOUND(SrcParamData%NodesDOF,1) - IF (.NOT. ALLOCATED(DstParamData%NodesDOF)) THEN - ALLOCATE(DstParamData%NodesDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%NodesDOF,1), UBOUND(SrcParamData%NodesDOF,1) - CALL SD_Copyilist( SrcParamData%NodesDOF(i1), DstParamData%NodesDOF(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%NodesDOFred)) THEN - i1_l = LBOUND(SrcParamData%NodesDOFred,1) - i1_u = UBOUND(SrcParamData%NodesDOFred,1) - IF (.NOT. ALLOCATED(DstParamData%NodesDOFred)) THEN - ALLOCATE(DstParamData%NodesDOFred(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOFred.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%NodesDOFred,1), UBOUND(SrcParamData%NodesDOFred,1) - CALL SD_Copyilist( SrcParamData%NodesDOFred(i1), DstParamData%NodesDOFred(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%ElemsDOF)) THEN - i1_l = LBOUND(SrcParamData%ElemsDOF,1) - i1_u = UBOUND(SrcParamData%ElemsDOF,1) - i2_l = LBOUND(SrcParamData%ElemsDOF,2) - i2_u = UBOUND(SrcParamData%ElemsDOF,2) - IF (.NOT. ALLOCATED(DstParamData%ElemsDOF)) THEN - ALLOCATE(DstParamData%ElemsDOF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemsDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ElemsDOF = SrcParamData%ElemsDOF -ENDIF -IF (ALLOCATED(SrcParamData%DOFred2Nodes)) THEN - i1_l = LBOUND(SrcParamData%DOFred2Nodes,1) - i1_u = UBOUND(SrcParamData%DOFred2Nodes,1) - i2_l = LBOUND(SrcParamData%DOFred2Nodes,2) - i2_u = UBOUND(SrcParamData%DOFred2Nodes,2) - IF (.NOT. ALLOCATED(DstParamData%DOFred2Nodes)) THEN - ALLOCATE(DstParamData%DOFred2Nodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOFred2Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DOFred2Nodes = SrcParamData%DOFred2Nodes -ENDIF -IF (ALLOCATED(SrcParamData%CtrlElem2Channel)) THEN - i1_l = LBOUND(SrcParamData%CtrlElem2Channel,1) - i1_u = UBOUND(SrcParamData%CtrlElem2Channel,1) - i2_l = LBOUND(SrcParamData%CtrlElem2Channel,2) - i2_u = UBOUND(SrcParamData%CtrlElem2Channel,2) - IF (.NOT. ALLOCATED(DstParamData%CtrlElem2Channel)) THEN - ALLOCATE(DstParamData%CtrlElem2Channel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CtrlElem2Channel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CtrlElem2Channel = SrcParamData%CtrlElem2Channel -ENDIF - DstParamData%nDOFM = SrcParamData%nDOFM - DstParamData%SttcSolve = SrcParamData%SttcSolve - DstParamData%GuyanLoadCorrection = SrcParamData%GuyanLoadCorrection - DstParamData%Floating = SrcParamData%Floating -IF (ALLOCATED(SrcParamData%KMMDiag)) THEN - i1_l = LBOUND(SrcParamData%KMMDiag,1) - i1_u = UBOUND(SrcParamData%KMMDiag,1) - IF (.NOT. ALLOCATED(DstParamData%KMMDiag)) THEN - ALLOCATE(DstParamData%KMMDiag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KMMDiag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%KMMDiag = SrcParamData%KMMDiag -ENDIF -IF (ALLOCATED(SrcParamData%CMMDiag)) THEN - i1_l = LBOUND(SrcParamData%CMMDiag,1) - i1_u = UBOUND(SrcParamData%CMMDiag,1) - IF (.NOT. ALLOCATED(DstParamData%CMMDiag)) THEN - ALLOCATE(DstParamData%CMMDiag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMMDiag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CMMDiag = SrcParamData%CMMDiag -ENDIF -IF (ALLOCATED(SrcParamData%MMB)) THEN - i1_l = LBOUND(SrcParamData%MMB,1) - i1_u = UBOUND(SrcParamData%MMB,1) - i2_l = LBOUND(SrcParamData%MMB,2) - i2_u = UBOUND(SrcParamData%MMB,2) - IF (.NOT. ALLOCATED(DstParamData%MMB)) THEN - ALLOCATE(DstParamData%MMB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MMB = SrcParamData%MMB -ENDIF -IF (ALLOCATED(SrcParamData%MBmmB)) THEN - i1_l = LBOUND(SrcParamData%MBmmB,1) - i1_u = UBOUND(SrcParamData%MBmmB,1) - i2_l = LBOUND(SrcParamData%MBmmB,2) - i2_u = UBOUND(SrcParamData%MBmmB,2) - IF (.NOT. ALLOCATED(DstParamData%MBmmB)) THEN - ALLOCATE(DstParamData%MBmmB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBmmB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MBmmB = SrcParamData%MBmmB -ENDIF -IF (ALLOCATED(SrcParamData%C1_11)) THEN - i1_l = LBOUND(SrcParamData%C1_11,1) - i1_u = UBOUND(SrcParamData%C1_11,1) - i2_l = LBOUND(SrcParamData%C1_11,2) - i2_u = UBOUND(SrcParamData%C1_11,2) - IF (.NOT. ALLOCATED(DstParamData%C1_11)) THEN - ALLOCATE(DstParamData%C1_11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C1_11 = SrcParamData%C1_11 -ENDIF -IF (ALLOCATED(SrcParamData%C1_12)) THEN - i1_l = LBOUND(SrcParamData%C1_12,1) - i1_u = UBOUND(SrcParamData%C1_12,1) - i2_l = LBOUND(SrcParamData%C1_12,2) - i2_u = UBOUND(SrcParamData%C1_12,2) - IF (.NOT. ALLOCATED(DstParamData%C1_12)) THEN - ALLOCATE(DstParamData%C1_12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_12.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C1_12 = SrcParamData%C1_12 -ENDIF -IF (ALLOCATED(SrcParamData%D1_141)) THEN - i1_l = LBOUND(SrcParamData%D1_141,1) - i1_u = UBOUND(SrcParamData%D1_141,1) - i2_l = LBOUND(SrcParamData%D1_141,2) - i2_u = UBOUND(SrcParamData%D1_141,2) - IF (.NOT. ALLOCATED(DstParamData%D1_141)) THEN - ALLOCATE(DstParamData%D1_141(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_141.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%D1_141 = SrcParamData%D1_141 -ENDIF -IF (ALLOCATED(SrcParamData%D1_142)) THEN - i1_l = LBOUND(SrcParamData%D1_142,1) - i1_u = UBOUND(SrcParamData%D1_142,1) - i2_l = LBOUND(SrcParamData%D1_142,2) - i2_u = UBOUND(SrcParamData%D1_142,2) - IF (.NOT. ALLOCATED(DstParamData%D1_142)) THEN - ALLOCATE(DstParamData%D1_142(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_142.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%D1_142 = SrcParamData%D1_142 -ENDIF -IF (ALLOCATED(SrcParamData%PhiM)) THEN - i1_l = LBOUND(SrcParamData%PhiM,1) - i1_u = UBOUND(SrcParamData%PhiM,1) - i2_l = LBOUND(SrcParamData%PhiM,2) - i2_u = UBOUND(SrcParamData%PhiM,2) - IF (.NOT. ALLOCATED(DstParamData%PhiM)) THEN - ALLOCATE(DstParamData%PhiM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PhiM = SrcParamData%PhiM -ENDIF -IF (ALLOCATED(SrcParamData%C2_61)) THEN - i1_l = LBOUND(SrcParamData%C2_61,1) - i1_u = UBOUND(SrcParamData%C2_61,1) - i2_l = LBOUND(SrcParamData%C2_61,2) - i2_u = UBOUND(SrcParamData%C2_61,2) - IF (.NOT. ALLOCATED(DstParamData%C2_61)) THEN - ALLOCATE(DstParamData%C2_61(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_61.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C2_61 = SrcParamData%C2_61 -ENDIF -IF (ALLOCATED(SrcParamData%C2_62)) THEN - i1_l = LBOUND(SrcParamData%C2_62,1) - i1_u = UBOUND(SrcParamData%C2_62,1) - i2_l = LBOUND(SrcParamData%C2_62,2) - i2_u = UBOUND(SrcParamData%C2_62,2) - IF (.NOT. ALLOCATED(DstParamData%C2_62)) THEN - ALLOCATE(DstParamData%C2_62(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_62.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C2_62 = SrcParamData%C2_62 -ENDIF -IF (ALLOCATED(SrcParamData%PhiRb_TI)) THEN - i1_l = LBOUND(SrcParamData%PhiRb_TI,1) - i1_u = UBOUND(SrcParamData%PhiRb_TI,1) - i2_l = LBOUND(SrcParamData%PhiRb_TI,2) - i2_u = UBOUND(SrcParamData%PhiRb_TI,2) - IF (.NOT. ALLOCATED(DstParamData%PhiRb_TI)) THEN - ALLOCATE(DstParamData%PhiRb_TI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiRb_TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PhiRb_TI = SrcParamData%PhiRb_TI -ENDIF -IF (ALLOCATED(SrcParamData%D2_63)) THEN - i1_l = LBOUND(SrcParamData%D2_63,1) - i1_u = UBOUND(SrcParamData%D2_63,1) - i2_l = LBOUND(SrcParamData%D2_63,2) - i2_u = UBOUND(SrcParamData%D2_63,2) - IF (.NOT. ALLOCATED(DstParamData%D2_63)) THEN - ALLOCATE(DstParamData%D2_63(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_63.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%D2_63 = SrcParamData%D2_63 -ENDIF -IF (ALLOCATED(SrcParamData%D2_64)) THEN - i1_l = LBOUND(SrcParamData%D2_64,1) - i1_u = UBOUND(SrcParamData%D2_64,1) - i2_l = LBOUND(SrcParamData%D2_64,2) - i2_u = UBOUND(SrcParamData%D2_64,2) - IF (.NOT. ALLOCATED(DstParamData%D2_64)) THEN - ALLOCATE(DstParamData%D2_64(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_64.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%D2_64 = SrcParamData%D2_64 -ENDIF -IF (ALLOCATED(SrcParamData%MBB)) THEN - i1_l = LBOUND(SrcParamData%MBB,1) - i1_u = UBOUND(SrcParamData%MBB,1) - i2_l = LBOUND(SrcParamData%MBB,2) - i2_u = UBOUND(SrcParamData%MBB,2) - IF (.NOT. ALLOCATED(DstParamData%MBB)) THEN - ALLOCATE(DstParamData%MBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MBB = SrcParamData%MBB -ENDIF -IF (ALLOCATED(SrcParamData%KBB)) THEN - i1_l = LBOUND(SrcParamData%KBB,1) - i1_u = UBOUND(SrcParamData%KBB,1) - i2_l = LBOUND(SrcParamData%KBB,2) - i2_u = UBOUND(SrcParamData%KBB,2) - IF (.NOT. ALLOCATED(DstParamData%KBB)) THEN - ALLOCATE(DstParamData%KBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%KBB = SrcParamData%KBB -ENDIF -IF (ALLOCATED(SrcParamData%CBB)) THEN - i1_l = LBOUND(SrcParamData%CBB,1) - i1_u = UBOUND(SrcParamData%CBB,1) - i2_l = LBOUND(SrcParamData%CBB,2) - i2_u = UBOUND(SrcParamData%CBB,2) - IF (.NOT. ALLOCATED(DstParamData%CBB)) THEN - ALLOCATE(DstParamData%CBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CBB = SrcParamData%CBB -ENDIF -IF (ALLOCATED(SrcParamData%CMM)) THEN - i1_l = LBOUND(SrcParamData%CMM,1) - i1_u = UBOUND(SrcParamData%CMM,1) - i2_l = LBOUND(SrcParamData%CMM,2) - i2_u = UBOUND(SrcParamData%CMM,2) - IF (.NOT. ALLOCATED(DstParamData%CMM)) THEN - ALLOCATE(DstParamData%CMM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CMM = SrcParamData%CMM -ENDIF -IF (ALLOCATED(SrcParamData%MBM)) THEN - i1_l = LBOUND(SrcParamData%MBM,1) - i1_u = UBOUND(SrcParamData%MBM,1) - i2_l = LBOUND(SrcParamData%MBM,2) - i2_u = UBOUND(SrcParamData%MBM,2) - IF (.NOT. ALLOCATED(DstParamData%MBM)) THEN - ALLOCATE(DstParamData%MBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MBM = SrcParamData%MBM -ENDIF -IF (ALLOCATED(SrcParamData%PhiL_T)) THEN - i1_l = LBOUND(SrcParamData%PhiL_T,1) - i1_u = UBOUND(SrcParamData%PhiL_T,1) - i2_l = LBOUND(SrcParamData%PhiL_T,2) - i2_u = UBOUND(SrcParamData%PhiL_T,2) - IF (.NOT. ALLOCATED(DstParamData%PhiL_T)) THEN - ALLOCATE(DstParamData%PhiL_T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiL_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PhiL_T = SrcParamData%PhiL_T -ENDIF -IF (ALLOCATED(SrcParamData%PhiLInvOmgL2)) THEN - i1_l = LBOUND(SrcParamData%PhiLInvOmgL2,1) - i1_u = UBOUND(SrcParamData%PhiLInvOmgL2,1) - i2_l = LBOUND(SrcParamData%PhiLInvOmgL2,2) - i2_u = UBOUND(SrcParamData%PhiLInvOmgL2,2) - IF (.NOT. ALLOCATED(DstParamData%PhiLInvOmgL2)) THEN - ALLOCATE(DstParamData%PhiLInvOmgL2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiLInvOmgL2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PhiLInvOmgL2 = SrcParamData%PhiLInvOmgL2 -ENDIF -IF (ALLOCATED(SrcParamData%KLLm1)) THEN - i1_l = LBOUND(SrcParamData%KLLm1,1) - i1_u = UBOUND(SrcParamData%KLLm1,1) - i2_l = LBOUND(SrcParamData%KLLm1,2) - i2_u = UBOUND(SrcParamData%KLLm1,2) - IF (.NOT. ALLOCATED(DstParamData%KLLm1)) THEN - ALLOCATE(DstParamData%KLLm1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KLLm1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%KLLm1 = SrcParamData%KLLm1 -ENDIF -IF (ALLOCATED(SrcParamData%AM2Jac)) THEN - i1_l = LBOUND(SrcParamData%AM2Jac,1) - i1_u = UBOUND(SrcParamData%AM2Jac,1) - i2_l = LBOUND(SrcParamData%AM2Jac,2) - i2_u = UBOUND(SrcParamData%AM2Jac,2) - IF (.NOT. ALLOCATED(DstParamData%AM2Jac)) THEN - ALLOCATE(DstParamData%AM2Jac(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AM2Jac = SrcParamData%AM2Jac -ENDIF -IF (ALLOCATED(SrcParamData%AM2JacPiv)) THEN - i1_l = LBOUND(SrcParamData%AM2JacPiv,1) - i1_u = UBOUND(SrcParamData%AM2JacPiv,1) - IF (.NOT. ALLOCATED(DstParamData%AM2JacPiv)) THEN - ALLOCATE(DstParamData%AM2JacPiv(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2JacPiv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AM2JacPiv = SrcParamData%AM2JacPiv -ENDIF -IF (ALLOCATED(SrcParamData%TI)) THEN - i1_l = LBOUND(SrcParamData%TI,1) - i1_u = UBOUND(SrcParamData%TI,1) - i2_l = LBOUND(SrcParamData%TI,2) - i2_u = UBOUND(SrcParamData%TI,2) - IF (.NOT. ALLOCATED(DstParamData%TI)) THEN - ALLOCATE(DstParamData%TI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TI = SrcParamData%TI -ENDIF -IF (ALLOCATED(SrcParamData%TIreact)) THEN - i1_l = LBOUND(SrcParamData%TIreact,1) - i1_u = UBOUND(SrcParamData%TIreact,1) - i2_l = LBOUND(SrcParamData%TIreact,2) - i2_u = UBOUND(SrcParamData%TIreact,2) - IF (.NOT. ALLOCATED(DstParamData%TIreact)) THEN - ALLOCATE(DstParamData%TIreact(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TIreact.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TIreact = SrcParamData%TIreact -ENDIF - DstParamData%nNodes = SrcParamData%nNodes - DstParamData%nNodes_I = SrcParamData%nNodes_I - DstParamData%nNodes_L = SrcParamData%nNodes_L - DstParamData%nNodes_C = SrcParamData%nNodes_C -IF (ALLOCATED(SrcParamData%Nodes_I)) THEN - i1_l = LBOUND(SrcParamData%Nodes_I,1) - i1_u = UBOUND(SrcParamData%Nodes_I,1) - i2_l = LBOUND(SrcParamData%Nodes_I,2) - i2_u = UBOUND(SrcParamData%Nodes_I,2) - IF (.NOT. ALLOCATED(DstParamData%Nodes_I)) THEN - ALLOCATE(DstParamData%Nodes_I(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_I.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Nodes_I = SrcParamData%Nodes_I -ENDIF -IF (ALLOCATED(SrcParamData%Nodes_L)) THEN - i1_l = LBOUND(SrcParamData%Nodes_L,1) - i1_u = UBOUND(SrcParamData%Nodes_L,1) - i2_l = LBOUND(SrcParamData%Nodes_L,2) - i2_u = UBOUND(SrcParamData%Nodes_L,2) - IF (.NOT. ALLOCATED(DstParamData%Nodes_L)) THEN - ALLOCATE(DstParamData%Nodes_L(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Nodes_L = SrcParamData%Nodes_L -ENDIF -IF (ALLOCATED(SrcParamData%Nodes_C)) THEN - i1_l = LBOUND(SrcParamData%Nodes_C,1) - i1_u = UBOUND(SrcParamData%Nodes_C,1) - i2_l = LBOUND(SrcParamData%Nodes_C,2) - i2_u = UBOUND(SrcParamData%Nodes_C,2) - IF (.NOT. ALLOCATED(DstParamData%Nodes_C)) THEN - ALLOCATE(DstParamData%Nodes_C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Nodes_C = SrcParamData%Nodes_C -ENDIF - DstParamData%nDOFI__ = SrcParamData%nDOFI__ - DstParamData%nDOFI_Rb = SrcParamData%nDOFI_Rb - DstParamData%nDOFI_F = SrcParamData%nDOFI_F - DstParamData%nDOFL_L = SrcParamData%nDOFL_L - DstParamData%nDOFC__ = SrcParamData%nDOFC__ - DstParamData%nDOFC_Rb = SrcParamData%nDOFC_Rb - DstParamData%nDOFC_L = SrcParamData%nDOFC_L - DstParamData%nDOFC_F = SrcParamData%nDOFC_F - DstParamData%nDOFR__ = SrcParamData%nDOFR__ - DstParamData%nDOF__Rb = SrcParamData%nDOF__Rb - DstParamData%nDOF__L = SrcParamData%nDOF__L - DstParamData%nDOF__F = SrcParamData%nDOF__F -IF (ALLOCATED(SrcParamData%IDI__)) THEN - i1_l = LBOUND(SrcParamData%IDI__,1) - i1_u = UBOUND(SrcParamData%IDI__,1) - IF (.NOT. ALLOCATED(DstParamData%IDI__)) THEN - ALLOCATE(DstParamData%IDI__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDI__ = SrcParamData%IDI__ -ENDIF -IF (ALLOCATED(SrcParamData%IDI_Rb)) THEN - i1_l = LBOUND(SrcParamData%IDI_Rb,1) - i1_u = UBOUND(SrcParamData%IDI_Rb,1) - IF (.NOT. ALLOCATED(DstParamData%IDI_Rb)) THEN - ALLOCATE(DstParamData%IDI_Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDI_Rb = SrcParamData%IDI_Rb -ENDIF -IF (ALLOCATED(SrcParamData%IDI_F)) THEN - i1_l = LBOUND(SrcParamData%IDI_F,1) - i1_u = UBOUND(SrcParamData%IDI_F,1) - IF (.NOT. ALLOCATED(DstParamData%IDI_F)) THEN - ALLOCATE(DstParamData%IDI_F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDI_F = SrcParamData%IDI_F -ENDIF -IF (ALLOCATED(SrcParamData%IDL_L)) THEN - i1_l = LBOUND(SrcParamData%IDL_L,1) - i1_u = UBOUND(SrcParamData%IDL_L,1) - IF (.NOT. ALLOCATED(DstParamData%IDL_L)) THEN - ALLOCATE(DstParamData%IDL_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDL_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDL_L = SrcParamData%IDL_L -ENDIF -IF (ALLOCATED(SrcParamData%IDC__)) THEN - i1_l = LBOUND(SrcParamData%IDC__,1) - i1_u = UBOUND(SrcParamData%IDC__,1) - IF (.NOT. ALLOCATED(DstParamData%IDC__)) THEN - ALLOCATE(DstParamData%IDC__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDC__ = SrcParamData%IDC__ -ENDIF -IF (ALLOCATED(SrcParamData%IDC_Rb)) THEN - i1_l = LBOUND(SrcParamData%IDC_Rb,1) - i1_u = UBOUND(SrcParamData%IDC_Rb,1) - IF (.NOT. ALLOCATED(DstParamData%IDC_Rb)) THEN - ALLOCATE(DstParamData%IDC_Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDC_Rb = SrcParamData%IDC_Rb -ENDIF -IF (ALLOCATED(SrcParamData%IDC_L)) THEN - i1_l = LBOUND(SrcParamData%IDC_L,1) - i1_u = UBOUND(SrcParamData%IDC_L,1) - IF (.NOT. ALLOCATED(DstParamData%IDC_L)) THEN - ALLOCATE(DstParamData%IDC_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDC_L = SrcParamData%IDC_L -ENDIF -IF (ALLOCATED(SrcParamData%IDC_F)) THEN - i1_l = LBOUND(SrcParamData%IDC_F,1) - i1_u = UBOUND(SrcParamData%IDC_F,1) - IF (.NOT. ALLOCATED(DstParamData%IDC_F)) THEN - ALLOCATE(DstParamData%IDC_F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDC_F = SrcParamData%IDC_F -ENDIF -IF (ALLOCATED(SrcParamData%IDR__)) THEN - i1_l = LBOUND(SrcParamData%IDR__,1) - i1_u = UBOUND(SrcParamData%IDR__,1) - IF (.NOT. ALLOCATED(DstParamData%IDR__)) THEN - ALLOCATE(DstParamData%IDR__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDR__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDR__ = SrcParamData%IDR__ -ENDIF -IF (ALLOCATED(SrcParamData%ID__Rb)) THEN - i1_l = LBOUND(SrcParamData%ID__Rb,1) - i1_u = UBOUND(SrcParamData%ID__Rb,1) - IF (.NOT. ALLOCATED(DstParamData%ID__Rb)) THEN - ALLOCATE(DstParamData%ID__Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ID__Rb = SrcParamData%ID__Rb -ENDIF -IF (ALLOCATED(SrcParamData%ID__L)) THEN - i1_l = LBOUND(SrcParamData%ID__L,1) - i1_u = UBOUND(SrcParamData%ID__L,1) - IF (.NOT. ALLOCATED(DstParamData%ID__L)) THEN - ALLOCATE(DstParamData%ID__L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ID__L = SrcParamData%ID__L -ENDIF -IF (ALLOCATED(SrcParamData%ID__F)) THEN - i1_l = LBOUND(SrcParamData%ID__F,1) - i1_u = UBOUND(SrcParamData%ID__F,1) - IF (.NOT. ALLOCATED(DstParamData%ID__F)) THEN - ALLOCATE(DstParamData%ID__F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ID__F = SrcParamData%ID__F -ENDIF - DstParamData%NMOutputs = SrcParamData%NMOutputs - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%OutSwtch = SrcParamData%OutSwtch - DstParamData%UnJckF = SrcParamData%UnJckF - DstParamData%Delim = SrcParamData%Delim - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutSFmt = SrcParamData%OutSFmt -IF (ALLOCATED(SrcParamData%MoutLst)) THEN - i1_l = LBOUND(SrcParamData%MoutLst,1) - i1_u = UBOUND(SrcParamData%MoutLst,1) - IF (.NOT. ALLOCATED(DstParamData%MoutLst)) THEN - ALLOCATE(DstParamData%MoutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%MoutLst,1), UBOUND(SrcParamData%MoutLst,1) - CALL SD_Copymeshauxdatatype( SrcParamData%MoutLst(i1), DstParamData%MoutLst(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%MoutLst2)) THEN - i1_l = LBOUND(SrcParamData%MoutLst2,1) - i1_u = UBOUND(SrcParamData%MoutLst2,1) - IF (.NOT. ALLOCATED(DstParamData%MoutLst2)) THEN - ALLOCATE(DstParamData%MoutLst2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%MoutLst2,1), UBOUND(SrcParamData%MoutLst2,1) - CALL SD_Copymeshauxdatatype( SrcParamData%MoutLst2(i1), DstParamData%MoutLst2(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%MoutLst3)) THEN - i1_l = LBOUND(SrcParamData%MoutLst3,1) - i1_u = UBOUND(SrcParamData%MoutLst3,1) - IF (.NOT. ALLOCATED(DstParamData%MoutLst3)) THEN - ALLOCATE(DstParamData%MoutLst3(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%MoutLst3,1), UBOUND(SrcParamData%MoutLst3,1) - CALL SD_Copymeshauxdatatype( SrcParamData%MoutLst3(i1), DstParamData%MoutLst3(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,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 - ENDDO -ENDIF - DstParamData%OutAll = SrcParamData%OutAll - DstParamData%OutReact = SrcParamData%OutReact - DstParamData%OutAllInt = SrcParamData%OutAllInt - DstParamData%OutAllDims = SrcParamData%OutAllDims - DstParamData%OutDec = SrcParamData%OutDec -IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcParamData%Jac_u_indx,1) - i1_u = UBOUND(SrcParamData%Jac_u_indx,1) - i2_l = LBOUND(SrcParamData%Jac_u_indx,2) - i2_u = UBOUND(SrcParamData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_u_indx)) THEN - ALLOCATE(DstParamData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx -ENDIF -IF (ALLOCATED(SrcParamData%du)) THEN - i1_l = LBOUND(SrcParamData%du,1) - i1_u = UBOUND(SrcParamData%du,1) - IF (.NOT. ALLOCATED(DstParamData%du)) THEN - ALLOCATE(DstParamData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%du = SrcParamData%du -ENDIF - DstParamData%dx = SrcParamData%dx - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%Jac_nx = SrcParamData%Jac_nx - DstParamData%RotStates = SrcParamData%RotStates - END SUBROUTINE SD_CopyParam - - SUBROUTINE SD_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(SD_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyParam' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ParamData%Elems)) THEN - DEALLOCATE(ParamData%Elems) -ENDIF -IF (ALLOCATED(ParamData%ElemProps)) THEN -DO i1 = LBOUND(ParamData%ElemProps,1), UBOUND(ParamData%ElemProps,1) - CALL SD_Destroyelemproptype( ParamData%ElemProps(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ParamData%ElemProps) -ENDIF -IF (ALLOCATED(ParamData%FG)) THEN - DEALLOCATE(ParamData%FG) -ENDIF -IF (ALLOCATED(ParamData%DP0)) THEN - DEALLOCATE(ParamData%DP0) -ENDIF -IF (ALLOCATED(ParamData%T_red)) THEN - DEALLOCATE(ParamData%T_red) -ENDIF -IF (ALLOCATED(ParamData%T_red_T)) THEN - DEALLOCATE(ParamData%T_red_T) -ENDIF -IF (ALLOCATED(ParamData%NodesDOF)) THEN -DO i1 = LBOUND(ParamData%NodesDOF,1), UBOUND(ParamData%NodesDOF,1) - CALL SD_Destroyilist( ParamData%NodesDOF(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ParamData%NodesDOF) -ENDIF -IF (ALLOCATED(ParamData%NodesDOFred)) THEN -DO i1 = LBOUND(ParamData%NodesDOFred,1), UBOUND(ParamData%NodesDOFred,1) - CALL SD_Destroyilist( ParamData%NodesDOFred(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ParamData%NodesDOFred) -ENDIF -IF (ALLOCATED(ParamData%ElemsDOF)) THEN - DEALLOCATE(ParamData%ElemsDOF) -ENDIF -IF (ALLOCATED(ParamData%DOFred2Nodes)) THEN - DEALLOCATE(ParamData%DOFred2Nodes) -ENDIF -IF (ALLOCATED(ParamData%CtrlElem2Channel)) THEN - DEALLOCATE(ParamData%CtrlElem2Channel) -ENDIF -IF (ALLOCATED(ParamData%KMMDiag)) THEN - DEALLOCATE(ParamData%KMMDiag) -ENDIF -IF (ALLOCATED(ParamData%CMMDiag)) THEN - DEALLOCATE(ParamData%CMMDiag) -ENDIF -IF (ALLOCATED(ParamData%MMB)) THEN - DEALLOCATE(ParamData%MMB) -ENDIF -IF (ALLOCATED(ParamData%MBmmB)) THEN - DEALLOCATE(ParamData%MBmmB) -ENDIF -IF (ALLOCATED(ParamData%C1_11)) THEN - DEALLOCATE(ParamData%C1_11) -ENDIF -IF (ALLOCATED(ParamData%C1_12)) THEN - DEALLOCATE(ParamData%C1_12) -ENDIF -IF (ALLOCATED(ParamData%D1_141)) THEN - DEALLOCATE(ParamData%D1_141) -ENDIF -IF (ALLOCATED(ParamData%D1_142)) THEN - DEALLOCATE(ParamData%D1_142) -ENDIF -IF (ALLOCATED(ParamData%PhiM)) THEN - DEALLOCATE(ParamData%PhiM) -ENDIF -IF (ALLOCATED(ParamData%C2_61)) THEN - DEALLOCATE(ParamData%C2_61) -ENDIF -IF (ALLOCATED(ParamData%C2_62)) THEN - DEALLOCATE(ParamData%C2_62) -ENDIF -IF (ALLOCATED(ParamData%PhiRb_TI)) THEN - DEALLOCATE(ParamData%PhiRb_TI) -ENDIF -IF (ALLOCATED(ParamData%D2_63)) THEN - DEALLOCATE(ParamData%D2_63) -ENDIF -IF (ALLOCATED(ParamData%D2_64)) THEN - DEALLOCATE(ParamData%D2_64) -ENDIF -IF (ALLOCATED(ParamData%MBB)) THEN - DEALLOCATE(ParamData%MBB) -ENDIF -IF (ALLOCATED(ParamData%KBB)) THEN - DEALLOCATE(ParamData%KBB) -ENDIF -IF (ALLOCATED(ParamData%CBB)) THEN - DEALLOCATE(ParamData%CBB) -ENDIF -IF (ALLOCATED(ParamData%CMM)) THEN - DEALLOCATE(ParamData%CMM) -ENDIF -IF (ALLOCATED(ParamData%MBM)) THEN - DEALLOCATE(ParamData%MBM) -ENDIF -IF (ALLOCATED(ParamData%PhiL_T)) THEN - DEALLOCATE(ParamData%PhiL_T) -ENDIF -IF (ALLOCATED(ParamData%PhiLInvOmgL2)) THEN - DEALLOCATE(ParamData%PhiLInvOmgL2) -ENDIF -IF (ALLOCATED(ParamData%KLLm1)) THEN - DEALLOCATE(ParamData%KLLm1) -ENDIF -IF (ALLOCATED(ParamData%AM2Jac)) THEN - DEALLOCATE(ParamData%AM2Jac) -ENDIF -IF (ALLOCATED(ParamData%AM2JacPiv)) THEN - DEALLOCATE(ParamData%AM2JacPiv) -ENDIF -IF (ALLOCATED(ParamData%TI)) THEN - DEALLOCATE(ParamData%TI) -ENDIF -IF (ALLOCATED(ParamData%TIreact)) THEN - DEALLOCATE(ParamData%TIreact) -ENDIF -IF (ALLOCATED(ParamData%Nodes_I)) THEN - DEALLOCATE(ParamData%Nodes_I) -ENDIF -IF (ALLOCATED(ParamData%Nodes_L)) THEN - DEALLOCATE(ParamData%Nodes_L) -ENDIF -IF (ALLOCATED(ParamData%Nodes_C)) THEN - DEALLOCATE(ParamData%Nodes_C) -ENDIF -IF (ALLOCATED(ParamData%IDI__)) THEN - DEALLOCATE(ParamData%IDI__) -ENDIF -IF (ALLOCATED(ParamData%IDI_Rb)) THEN - DEALLOCATE(ParamData%IDI_Rb) -ENDIF -IF (ALLOCATED(ParamData%IDI_F)) THEN - DEALLOCATE(ParamData%IDI_F) -ENDIF -IF (ALLOCATED(ParamData%IDL_L)) THEN - DEALLOCATE(ParamData%IDL_L) -ENDIF -IF (ALLOCATED(ParamData%IDC__)) THEN - DEALLOCATE(ParamData%IDC__) -ENDIF -IF (ALLOCATED(ParamData%IDC_Rb)) THEN - DEALLOCATE(ParamData%IDC_Rb) -ENDIF -IF (ALLOCATED(ParamData%IDC_L)) THEN - DEALLOCATE(ParamData%IDC_L) -ENDIF -IF (ALLOCATED(ParamData%IDC_F)) THEN - DEALLOCATE(ParamData%IDC_F) -ENDIF -IF (ALLOCATED(ParamData%IDR__)) THEN - DEALLOCATE(ParamData%IDR__) -ENDIF -IF (ALLOCATED(ParamData%ID__Rb)) THEN - DEALLOCATE(ParamData%ID__Rb) -ENDIF -IF (ALLOCATED(ParamData%ID__L)) THEN - DEALLOCATE(ParamData%ID__L) -ENDIF -IF (ALLOCATED(ParamData%ID__F)) THEN - DEALLOCATE(ParamData%ID__F) -ENDIF -IF (ALLOCATED(ParamData%MoutLst)) THEN -DO i1 = LBOUND(ParamData%MoutLst,1), UBOUND(ParamData%MoutLst,1) - CALL SD_Destroymeshauxdatatype( ParamData%MoutLst(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ParamData%MoutLst) -ENDIF -IF (ALLOCATED(ParamData%MoutLst2)) THEN -DO i1 = LBOUND(ParamData%MoutLst2,1), UBOUND(ParamData%MoutLst2,1) - CALL SD_Destroymeshauxdatatype( ParamData%MoutLst2(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ParamData%MoutLst2) -ENDIF -IF (ALLOCATED(ParamData%MoutLst3)) THEN -DO i1 = LBOUND(ParamData%MoutLst3,1), UBOUND(ParamData%MoutLst3,1) - CALL SD_Destroymeshauxdatatype( ParamData%MoutLst3(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ParamData%MoutLst3) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%Jac_u_indx)) THEN - DEALLOCATE(ParamData%Jac_u_indx) -ENDIF -IF (ALLOCATED(ParamData%du)) THEN - DEALLOCATE(ParamData%du) -ENDIF - END SUBROUTINE SD_DestroyParam - - SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! SDDeltaT - Int_BufSz = Int_BufSz + 1 ! IntMethod - Int_BufSz = Int_BufSz + 1 ! nDOF - Int_BufSz = Int_BufSz + 1 ! nDOF_red - Int_BufSz = Int_BufSz + 1 ! Nmembers - Int_BufSz = Int_BufSz + 1 ! Elems allocated yes/no - IF ( ALLOCATED(InData%Elems) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Elems upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Elems) ! Elems - END IF - Int_BufSz = Int_BufSz + 1 ! ElemProps allocated yes/no - IF ( ALLOCATED(InData%ElemProps) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ElemProps upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%ElemProps,1), UBOUND(InData%ElemProps,1) - Int_BufSz = Int_BufSz + 3 ! ElemProps: size of buffers for each call to pack subtype - CALL SD_Packelemproptype( Re_Buf, Db_Buf, Int_Buf, InData%ElemProps(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ElemProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ElemProps - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ElemProps - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ElemProps - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! FG allocated yes/no - IF ( ALLOCATED(InData%FG) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FG upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%FG) ! FG - END IF - Int_BufSz = Int_BufSz + 1 ! DP0 allocated yes/no - IF ( ALLOCATED(InData%DP0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DP0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DP0) ! DP0 - END IF - Int_BufSz = Int_BufSz + 1 ! reduced - Int_BufSz = Int_BufSz + 1 ! T_red allocated yes/no - IF ( ALLOCATED(InData%T_red) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! T_red upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%T_red) ! T_red - END IF - Int_BufSz = Int_BufSz + 1 ! T_red_T allocated yes/no - IF ( ALLOCATED(InData%T_red_T) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! T_red_T upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%T_red_T) ! T_red_T - END IF - Int_BufSz = Int_BufSz + 1 ! NodesDOF allocated yes/no - IF ( ALLOCATED(InData%NodesDOF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodesDOF upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NodesDOF,1), UBOUND(InData%NodesDOF,1) - Int_BufSz = Int_BufSz + 3 ! NodesDOF: size of buffers for each call to pack subtype - CALL SD_Packilist( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NodesDOF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NodesDOF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NodesDOF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NodesDOF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NodesDOFred allocated yes/no - IF ( ALLOCATED(InData%NodesDOFred) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodesDOFred upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NodesDOFred,1), UBOUND(InData%NodesDOFred,1) - Int_BufSz = Int_BufSz + 3 ! NodesDOFred: size of buffers for each call to pack subtype - CALL SD_Packilist( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOFred(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NodesDOFred - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NodesDOFred - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NodesDOFred - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NodesDOFred - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ElemsDOF allocated yes/no - IF ( ALLOCATED(InData%ElemsDOF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ElemsDOF upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ElemsDOF) ! ElemsDOF - END IF - Int_BufSz = Int_BufSz + 1 ! DOFred2Nodes allocated yes/no - IF ( ALLOCATED(InData%DOFred2Nodes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DOFred2Nodes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DOFred2Nodes) ! DOFred2Nodes - END IF - Int_BufSz = Int_BufSz + 1 ! CtrlElem2Channel allocated yes/no - IF ( ALLOCATED(InData%CtrlElem2Channel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CtrlElem2Channel upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CtrlElem2Channel) ! CtrlElem2Channel - END IF - Int_BufSz = Int_BufSz + 1 ! nDOFM - Int_BufSz = Int_BufSz + 1 ! SttcSolve - Int_BufSz = Int_BufSz + 1 ! GuyanLoadCorrection - Int_BufSz = Int_BufSz + 1 ! Floating - Int_BufSz = Int_BufSz + 1 ! KMMDiag allocated yes/no - IF ( ALLOCATED(InData%KMMDiag) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! KMMDiag upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%KMMDiag) ! KMMDiag - END IF - Int_BufSz = Int_BufSz + 1 ! CMMDiag allocated yes/no - IF ( ALLOCATED(InData%CMMDiag) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CMMDiag upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CMMDiag) ! CMMDiag - END IF - Int_BufSz = Int_BufSz + 1 ! MMB allocated yes/no - IF ( ALLOCATED(InData%MMB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MMB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MMB) ! MMB - END IF - Int_BufSz = Int_BufSz + 1 ! MBmmB allocated yes/no - IF ( ALLOCATED(InData%MBmmB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MBmmB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MBmmB) ! MBmmB - END IF - Int_BufSz = Int_BufSz + 1 ! C1_11 allocated yes/no - IF ( ALLOCATED(InData%C1_11) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C1_11 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C1_11) ! C1_11 - END IF - Int_BufSz = Int_BufSz + 1 ! C1_12 allocated yes/no - IF ( ALLOCATED(InData%C1_12) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C1_12 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C1_12) ! C1_12 - END IF - Int_BufSz = Int_BufSz + 1 ! D1_141 allocated yes/no - IF ( ALLOCATED(InData%D1_141) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D1_141 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D1_141) ! D1_141 - END IF - Int_BufSz = Int_BufSz + 1 ! D1_142 allocated yes/no - IF ( ALLOCATED(InData%D1_142) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D1_142 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D1_142) ! D1_142 - END IF - Int_BufSz = Int_BufSz + 1 ! PhiM allocated yes/no - IF ( ALLOCATED(InData%PhiM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PhiM) ! PhiM - END IF - Int_BufSz = Int_BufSz + 1 ! C2_61 allocated yes/no - IF ( ALLOCATED(InData%C2_61) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C2_61 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C2_61) ! C2_61 - END IF - Int_BufSz = Int_BufSz + 1 ! C2_62 allocated yes/no - IF ( ALLOCATED(InData%C2_62) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C2_62 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C2_62) ! C2_62 - END IF - Int_BufSz = Int_BufSz + 1 ! PhiRb_TI allocated yes/no - IF ( ALLOCATED(InData%PhiRb_TI) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiRb_TI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PhiRb_TI) ! PhiRb_TI - END IF - Int_BufSz = Int_BufSz + 1 ! D2_63 allocated yes/no - IF ( ALLOCATED(InData%D2_63) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D2_63 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D2_63) ! D2_63 - END IF - Int_BufSz = Int_BufSz + 1 ! D2_64 allocated yes/no - IF ( ALLOCATED(InData%D2_64) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D2_64 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D2_64) ! D2_64 - END IF - Int_BufSz = Int_BufSz + 1 ! MBB allocated yes/no - IF ( ALLOCATED(InData%MBB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MBB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MBB) ! MBB - END IF - Int_BufSz = Int_BufSz + 1 ! KBB allocated yes/no - IF ( ALLOCATED(InData%KBB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! KBB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%KBB) ! KBB - END IF - Int_BufSz = Int_BufSz + 1 ! CBB allocated yes/no - IF ( ALLOCATED(InData%CBB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CBB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CBB) ! CBB - END IF - Int_BufSz = Int_BufSz + 1 ! CMM allocated yes/no - IF ( ALLOCATED(InData%CMM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CMM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CMM) ! CMM - END IF - Int_BufSz = Int_BufSz + 1 ! MBM allocated yes/no - IF ( ALLOCATED(InData%MBM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MBM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MBM) ! MBM - END IF - Int_BufSz = Int_BufSz + 1 ! PhiL_T allocated yes/no - IF ( ALLOCATED(InData%PhiL_T) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiL_T upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PhiL_T) ! PhiL_T - END IF - Int_BufSz = Int_BufSz + 1 ! PhiLInvOmgL2 allocated yes/no - IF ( ALLOCATED(InData%PhiLInvOmgL2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiLInvOmgL2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PhiLInvOmgL2) ! PhiLInvOmgL2 - END IF - Int_BufSz = Int_BufSz + 1 ! KLLm1 allocated yes/no - IF ( ALLOCATED(InData%KLLm1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! KLLm1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%KLLm1) ! KLLm1 - END IF - Int_BufSz = Int_BufSz + 1 ! AM2Jac allocated yes/no - IF ( ALLOCATED(InData%AM2Jac) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AM2Jac upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AM2Jac) ! AM2Jac - END IF - Int_BufSz = Int_BufSz + 1 ! AM2JacPiv allocated yes/no - IF ( ALLOCATED(InData%AM2JacPiv) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AM2JacPiv upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AM2JacPiv) ! AM2JacPiv - END IF - Int_BufSz = Int_BufSz + 1 ! TI allocated yes/no - IF ( ALLOCATED(InData%TI) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI) ! TI - END IF - Int_BufSz = Int_BufSz + 1 ! TIreact allocated yes/no - IF ( ALLOCATED(InData%TIreact) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TIreact upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TIreact) ! TIreact - END IF - Int_BufSz = Int_BufSz + 1 ! nNodes - Int_BufSz = Int_BufSz + 1 ! nNodes_I - Int_BufSz = Int_BufSz + 1 ! nNodes_L - Int_BufSz = Int_BufSz + 1 ! nNodes_C - Int_BufSz = Int_BufSz + 1 ! Nodes_I allocated yes/no - IF ( ALLOCATED(InData%Nodes_I) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Nodes_I upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Nodes_I) ! Nodes_I - END IF - Int_BufSz = Int_BufSz + 1 ! Nodes_L allocated yes/no - IF ( ALLOCATED(InData%Nodes_L) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Nodes_L upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Nodes_L) ! Nodes_L - END IF - Int_BufSz = Int_BufSz + 1 ! Nodes_C allocated yes/no - IF ( ALLOCATED(InData%Nodes_C) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Nodes_C upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Nodes_C) ! Nodes_C - END IF - Int_BufSz = Int_BufSz + 1 ! nDOFI__ - Int_BufSz = Int_BufSz + 1 ! nDOFI_Rb - Int_BufSz = Int_BufSz + 1 ! nDOFI_F - Int_BufSz = Int_BufSz + 1 ! nDOFL_L - Int_BufSz = Int_BufSz + 1 ! nDOFC__ - Int_BufSz = Int_BufSz + 1 ! nDOFC_Rb - Int_BufSz = Int_BufSz + 1 ! nDOFC_L - Int_BufSz = Int_BufSz + 1 ! nDOFC_F - Int_BufSz = Int_BufSz + 1 ! nDOFR__ - Int_BufSz = Int_BufSz + 1 ! nDOF__Rb - Int_BufSz = Int_BufSz + 1 ! nDOF__L - Int_BufSz = Int_BufSz + 1 ! nDOF__F - Int_BufSz = Int_BufSz + 1 ! IDI__ allocated yes/no - IF ( ALLOCATED(InData%IDI__) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDI__ upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDI__) ! IDI__ - END IF - Int_BufSz = Int_BufSz + 1 ! IDI_Rb allocated yes/no - IF ( ALLOCATED(InData%IDI_Rb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDI_Rb upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDI_Rb) ! IDI_Rb - END IF - Int_BufSz = Int_BufSz + 1 ! IDI_F allocated yes/no - IF ( ALLOCATED(InData%IDI_F) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDI_F upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDI_F) ! IDI_F - END IF - Int_BufSz = Int_BufSz + 1 ! IDL_L allocated yes/no - IF ( ALLOCATED(InData%IDL_L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDL_L upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDL_L) ! IDL_L - END IF - Int_BufSz = Int_BufSz + 1 ! IDC__ allocated yes/no - IF ( ALLOCATED(InData%IDC__) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDC__ upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDC__) ! IDC__ - END IF - Int_BufSz = Int_BufSz + 1 ! IDC_Rb allocated yes/no - IF ( ALLOCATED(InData%IDC_Rb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDC_Rb upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDC_Rb) ! IDC_Rb - END IF - Int_BufSz = Int_BufSz + 1 ! IDC_L allocated yes/no - IF ( ALLOCATED(InData%IDC_L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDC_L upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDC_L) ! IDC_L - END IF - Int_BufSz = Int_BufSz + 1 ! IDC_F allocated yes/no - IF ( ALLOCATED(InData%IDC_F) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDC_F upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDC_F) ! IDC_F - END IF - Int_BufSz = Int_BufSz + 1 ! IDR__ allocated yes/no - IF ( ALLOCATED(InData%IDR__) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDR__ upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDR__) ! IDR__ - END IF - Int_BufSz = Int_BufSz + 1 ! ID__Rb allocated yes/no - IF ( ALLOCATED(InData%ID__Rb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ID__Rb upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ID__Rb) ! ID__Rb - END IF - Int_BufSz = Int_BufSz + 1 ! ID__L allocated yes/no - IF ( ALLOCATED(InData%ID__L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ID__L upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ID__L) ! ID__L - END IF - Int_BufSz = Int_BufSz + 1 ! ID__F allocated yes/no - IF ( ALLOCATED(InData%ID__F) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ID__F upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ID__F) ! ID__F - END IF - Int_BufSz = Int_BufSz + 1 ! NMOutputs - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutSwtch - Int_BufSz = Int_BufSz + 1 ! UnJckF - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt - Int_BufSz = Int_BufSz + 1 ! MoutLst allocated yes/no - IF ( ALLOCATED(InData%MoutLst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MoutLst upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MoutLst,1), UBOUND(InData%MoutLst,1) - Int_BufSz = Int_BufSz + 3 ! MoutLst: size of buffers for each call to pack subtype - CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MoutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MoutLst - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MoutLst - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MoutLst - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MoutLst2 allocated yes/no - IF ( ALLOCATED(InData%MoutLst2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MoutLst2 upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MoutLst2,1), UBOUND(InData%MoutLst2,1) - Int_BufSz = Int_BufSz + 3 ! MoutLst2: size of buffers for each call to pack subtype - CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst2(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MoutLst2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MoutLst2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MoutLst2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MoutLst2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MoutLst3 allocated yes/no - IF ( ALLOCATED(InData%MoutLst3) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MoutLst3 upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MoutLst3,1), UBOUND(InData%MoutLst3,1) - Int_BufSz = Int_BufSz + 3 ! MoutLst3: size of buffers for each call to pack subtype - CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst3(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MoutLst3 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MoutLst3 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MoutLst3 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MoutLst3 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OutAll - Int_BufSz = Int_BufSz + 1 ! OutReact - Int_BufSz = Int_BufSz + 1 ! OutAllInt - Int_BufSz = Int_BufSz + 1 ! OutAllDims - Int_BufSz = Int_BufSz + 1 ! OutDec - Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Int_BufSz = Int_BufSz + 1 ! du allocated yes/no - IF ( ALLOCATED(InData%du) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! du upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%du) ! du - END IF - Db_BufSz = Db_BufSz + SIZE(InData%dx) ! dx - Int_BufSz = Int_BufSz + 1 ! Jac_ny - Int_BufSz = Int_BufSz + 1 ! Jac_nx - Int_BufSz = Int_BufSz + 1 ! RotStates - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%SDDeltaT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IntMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOF - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOF_red - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Nmembers - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Elems) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Elems,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Elems,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Elems,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Elems,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Elems,2), UBOUND(InData%Elems,2) - DO i1 = LBOUND(InData%Elems,1), UBOUND(InData%Elems,1) - IntKiBuf(Int_Xferred) = InData%Elems(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElemProps) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemProps,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemProps,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ElemProps,1), UBOUND(InData%ElemProps,1) - CALL SD_Packelemproptype( Re_Buf, Db_Buf, Int_Buf, InData%ElemProps(i1), ErrStat2, ErrMsg2, OnlySize ) ! ElemProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FG) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FG,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FG,1), UBOUND(InData%FG,1) - DbKiBuf(Db_Xferred) = InData%FG(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DP0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DP0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DP0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DP0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DP0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DP0,2), UBOUND(InData%DP0,2) - DO i1 = LBOUND(InData%DP0,1), UBOUND(InData%DP0,1) - ReKiBuf(Re_Xferred) = InData%DP0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%reduced, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%T_red) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T_red,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_red,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T_red,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_red,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%T_red,2), UBOUND(InData%T_red,2) - DO i1 = LBOUND(InData%T_red,1), UBOUND(InData%T_red,1) - DbKiBuf(Db_Xferred) = InData%T_red(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%T_red_T) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T_red_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_red_T,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T_red_T,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_red_T,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%T_red_T,2), UBOUND(InData%T_red_T,2) - DO i1 = LBOUND(InData%T_red_T,1), UBOUND(InData%T_red_T,1) - DbKiBuf(Db_Xferred) = InData%T_red_T(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodesDOF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesDOF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesDOF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodesDOF,1), UBOUND(InData%NodesDOF,1) - CALL SD_Packilist( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOF(i1), ErrStat2, ErrMsg2, OnlySize ) ! NodesDOF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodesDOFred) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesDOFred,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesDOFred,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodesDOFred,1), UBOUND(InData%NodesDOFred,1) - CALL SD_Packilist( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOFred(i1), ErrStat2, ErrMsg2, OnlySize ) ! NodesDOFred - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElemsDOF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemsDOF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemsDOF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemsDOF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemsDOF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ElemsDOF,2), UBOUND(InData%ElemsDOF,2) - DO i1 = LBOUND(InData%ElemsDOF,1), UBOUND(InData%ElemsDOF,1) - IntKiBuf(Int_Xferred) = InData%ElemsDOF(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DOFred2Nodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DOFred2Nodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOFred2Nodes,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DOFred2Nodes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOFred2Nodes,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DOFred2Nodes,2), UBOUND(InData%DOFred2Nodes,2) - DO i1 = LBOUND(InData%DOFred2Nodes,1), UBOUND(InData%DOFred2Nodes,1) - IntKiBuf(Int_Xferred) = InData%DOFred2Nodes(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CtrlElem2Channel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CtrlElem2Channel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CtrlElem2Channel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CtrlElem2Channel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CtrlElem2Channel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CtrlElem2Channel,2), UBOUND(InData%CtrlElem2Channel,2) - DO i1 = LBOUND(InData%CtrlElem2Channel,1), UBOUND(InData%CtrlElem2Channel,1) - IntKiBuf(Int_Xferred) = InData%CtrlElem2Channel(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nDOFM - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SttcSolve - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GuyanLoadCorrection, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Floating, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%KMMDiag) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KMMDiag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KMMDiag,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%KMMDiag,1), UBOUND(InData%KMMDiag,1) - ReKiBuf(Re_Xferred) = InData%KMMDiag(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CMMDiag) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMMDiag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMMDiag,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CMMDiag,1), UBOUND(InData%CMMDiag,1) - ReKiBuf(Re_Xferred) = InData%CMMDiag(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MMB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MMB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MMB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MMB,2), UBOUND(InData%MMB,2) - DO i1 = LBOUND(InData%MMB,1), UBOUND(InData%MMB,1) - ReKiBuf(Re_Xferred) = InData%MMB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MBmmB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBmmB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBmmB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBmmB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBmmB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MBmmB,2), UBOUND(InData%MBmmB,2) - DO i1 = LBOUND(InData%MBmmB,1), UBOUND(InData%MBmmB,1) - ReKiBuf(Re_Xferred) = InData%MBmmB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C1_11) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C1_11,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_11,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C1_11,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_11,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C1_11,2), UBOUND(InData%C1_11,2) - DO i1 = LBOUND(InData%C1_11,1), UBOUND(InData%C1_11,1) - ReKiBuf(Re_Xferred) = InData%C1_11(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C1_12) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C1_12,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_12,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C1_12,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_12,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C1_12,2), UBOUND(InData%C1_12,2) - DO i1 = LBOUND(InData%C1_12,1), UBOUND(InData%C1_12,1) - ReKiBuf(Re_Xferred) = InData%C1_12(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D1_141) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D1_141,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_141,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D1_141,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_141,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D1_141,2), UBOUND(InData%D1_141,2) - DO i1 = LBOUND(InData%D1_141,1), UBOUND(InData%D1_141,1) - ReKiBuf(Re_Xferred) = InData%D1_141(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D1_142) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D1_142,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_142,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D1_142,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_142,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D1_142,2), UBOUND(InData%D1_142,2) - DO i1 = LBOUND(InData%D1_142,1), UBOUND(InData%D1_142,1) - ReKiBuf(Re_Xferred) = InData%D1_142(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiM,2), UBOUND(InData%PhiM,2) - DO i1 = LBOUND(InData%PhiM,1), UBOUND(InData%PhiM,1) - ReKiBuf(Re_Xferred) = InData%PhiM(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C2_61) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C2_61,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_61,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C2_61,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_61,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C2_61,2), UBOUND(InData%C2_61,2) - DO i1 = LBOUND(InData%C2_61,1), UBOUND(InData%C2_61,1) - ReKiBuf(Re_Xferred) = InData%C2_61(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C2_62) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C2_62,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_62,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C2_62,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_62,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C2_62,2), UBOUND(InData%C2_62,2) - DO i1 = LBOUND(InData%C2_62,1), UBOUND(InData%C2_62,1) - ReKiBuf(Re_Xferred) = InData%C2_62(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiRb_TI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiRb_TI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiRb_TI,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiRb_TI,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiRb_TI,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiRb_TI,2), UBOUND(InData%PhiRb_TI,2) - DO i1 = LBOUND(InData%PhiRb_TI,1), UBOUND(InData%PhiRb_TI,1) - ReKiBuf(Re_Xferred) = InData%PhiRb_TI(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D2_63) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D2_63,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_63,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D2_63,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_63,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D2_63,2), UBOUND(InData%D2_63,2) - DO i1 = LBOUND(InData%D2_63,1), UBOUND(InData%D2_63,1) - ReKiBuf(Re_Xferred) = InData%D2_63(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D2_64) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D2_64,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_64,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D2_64,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_64,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D2_64,2), UBOUND(InData%D2_64,2) - DO i1 = LBOUND(InData%D2_64,1), UBOUND(InData%D2_64,1) - ReKiBuf(Re_Xferred) = InData%D2_64(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MBB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MBB,2), UBOUND(InData%MBB,2) - DO i1 = LBOUND(InData%MBB,1), UBOUND(InData%MBB,1) - ReKiBuf(Re_Xferred) = InData%MBB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%KBB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%KBB,2), UBOUND(InData%KBB,2) - DO i1 = LBOUND(InData%KBB,1), UBOUND(InData%KBB,1) - ReKiBuf(Re_Xferred) = InData%KBB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CBB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CBB,2), UBOUND(InData%CBB,2) - DO i1 = LBOUND(InData%CBB,1), UBOUND(InData%CBB,1) - ReKiBuf(Re_Xferred) = InData%CBB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CMM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CMM,2), UBOUND(InData%CMM,2) - DO i1 = LBOUND(InData%CMM,1), UBOUND(InData%CMM,1) - ReKiBuf(Re_Xferred) = InData%CMM(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MBM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MBM,2), UBOUND(InData%MBM,2) - DO i1 = LBOUND(InData%MBM,1), UBOUND(InData%MBM,1) - ReKiBuf(Re_Xferred) = InData%MBM(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiL_T) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiL_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL_T,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiL_T,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL_T,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiL_T,2), UBOUND(InData%PhiL_T,2) - DO i1 = LBOUND(InData%PhiL_T,1), UBOUND(InData%PhiL_T,1) - ReKiBuf(Re_Xferred) = InData%PhiL_T(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiLInvOmgL2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiLInvOmgL2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiLInvOmgL2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiLInvOmgL2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiLInvOmgL2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiLInvOmgL2,2), UBOUND(InData%PhiLInvOmgL2,2) - DO i1 = LBOUND(InData%PhiLInvOmgL2,1), UBOUND(InData%PhiLInvOmgL2,1) - ReKiBuf(Re_Xferred) = InData%PhiLInvOmgL2(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%KLLm1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KLLm1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KLLm1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KLLm1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KLLm1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%KLLm1,2), UBOUND(InData%KLLm1,2) - DO i1 = LBOUND(InData%KLLm1,1), UBOUND(InData%KLLm1,1) - ReKiBuf(Re_Xferred) = InData%KLLm1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AM2Jac) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AM2Jac,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM2Jac,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AM2Jac,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM2Jac,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AM2Jac,2), UBOUND(InData%AM2Jac,2) - DO i1 = LBOUND(InData%AM2Jac,1), UBOUND(InData%AM2Jac,1) - ReKiBuf(Re_Xferred) = InData%AM2Jac(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AM2JacPiv) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AM2JacPiv,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM2JacPiv,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AM2JacPiv,1), UBOUND(InData%AM2JacPiv,1) - IntKiBuf(Int_Xferred) = InData%AM2JacPiv(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TI,2), UBOUND(InData%TI,2) - DO i1 = LBOUND(InData%TI,1), UBOUND(InData%TI,1) - ReKiBuf(Re_Xferred) = InData%TI(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TIreact) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TIreact,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIreact,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TIreact,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIreact,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TIreact,2), UBOUND(InData%TIreact,2) - DO i1 = LBOUND(InData%TIreact,1), UBOUND(InData%TIreact,1) - ReKiBuf(Re_Xferred) = InData%TIreact(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNodes_I - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNodes_L - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNodes_C - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Nodes_I) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_I,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_I,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_I,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_I,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Nodes_I,2), UBOUND(InData%Nodes_I,2) - DO i1 = LBOUND(InData%Nodes_I,1), UBOUND(InData%Nodes_I,1) - IntKiBuf(Int_Xferred) = InData%Nodes_I(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Nodes_L) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_L,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_L,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_L,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Nodes_L,2), UBOUND(InData%Nodes_L,2) - DO i1 = LBOUND(InData%Nodes_L,1), UBOUND(InData%Nodes_L,1) - IntKiBuf(Int_Xferred) = InData%Nodes_L(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Nodes_C) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_C,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_C,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_C,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_C,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Nodes_C,2), UBOUND(InData%Nodes_C,2) - DO i1 = LBOUND(InData%Nodes_C,1), UBOUND(InData%Nodes_C,1) - IntKiBuf(Int_Xferred) = InData%Nodes_C(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nDOFI__ - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFI_Rb - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFI_F - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFL_L - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFC__ - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFC_Rb - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFC_L - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFC_F - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFR__ - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOF__Rb - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOF__L - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOF__F - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%IDI__) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDI__,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDI__,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDI__,1), UBOUND(InData%IDI__,1) - IntKiBuf(Int_Xferred) = InData%IDI__(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDI_Rb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDI_Rb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDI_Rb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDI_Rb,1), UBOUND(InData%IDI_Rb,1) - IntKiBuf(Int_Xferred) = InData%IDI_Rb(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDI_F) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDI_F,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDI_F,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDI_F,1), UBOUND(InData%IDI_F,1) - IntKiBuf(Int_Xferred) = InData%IDI_F(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDL_L) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDL_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDL_L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDL_L,1), UBOUND(InData%IDL_L,1) - IntKiBuf(Int_Xferred) = InData%IDL_L(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDC__) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDC__,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC__,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDC__,1), UBOUND(InData%IDC__,1) - IntKiBuf(Int_Xferred) = InData%IDC__(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDC_Rb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDC_Rb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC_Rb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDC_Rb,1), UBOUND(InData%IDC_Rb,1) - IntKiBuf(Int_Xferred) = InData%IDC_Rb(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDC_L) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDC_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC_L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDC_L,1), UBOUND(InData%IDC_L,1) - IntKiBuf(Int_Xferred) = InData%IDC_L(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDC_F) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDC_F,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC_F,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDC_F,1), UBOUND(InData%IDC_F,1) - IntKiBuf(Int_Xferred) = InData%IDC_F(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDR__) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDR__,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDR__,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDR__,1), UBOUND(InData%IDR__,1) - IntKiBuf(Int_Xferred) = InData%IDR__(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ID__Rb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ID__Rb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ID__Rb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ID__Rb,1), UBOUND(InData%ID__Rb,1) - IntKiBuf(Int_Xferred) = InData%ID__Rb(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ID__L) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ID__L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ID__L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ID__L,1), UBOUND(InData%ID__L,1) - IntKiBuf(Int_Xferred) = InData%ID__L(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ID__F) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ID__F,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ID__F,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ID__F,1), UBOUND(InData%ID__F,1) - IntKiBuf(Int_Xferred) = InData%ID__F(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NMOutputs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnJckF - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%MoutLst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MoutLst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MoutLst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MoutLst,1), UBOUND(InData%MoutLst,1) - CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst(i1), ErrStat2, ErrMsg2, OnlySize ) ! MoutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MoutLst2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MoutLst2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MoutLst2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MoutLst2,1), UBOUND(InData%MoutLst2,1) - CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst2(i1), ErrStat2, ErrMsg2, OnlySize ) ! MoutLst2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MoutLst3) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MoutLst3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MoutLst3,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MoutLst3,1), UBOUND(InData%MoutLst3,1) - CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst3(i1), ErrStat2, ErrMsg2, OnlySize ) ! MoutLst3 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutReact, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutAllInt - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutAllDims - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutDec - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) - DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%du) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%du,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) - DbKiBuf(Db_Xferred) = InData%du(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) - DbKiBuf(Db_Xferred) = InData%dx(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Jac_nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotStates, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_PackParam - - SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%SDDeltaT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%IntMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOF_red = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Nmembers = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Elems not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Elems)) DEALLOCATE(OutData%Elems) - ALLOCATE(OutData%Elems(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Elems.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Elems,2), UBOUND(OutData%Elems,2) - DO i1 = LBOUND(OutData%Elems,1), UBOUND(OutData%Elems,1) - OutData%Elems(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElemProps not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ElemProps)) DEALLOCATE(OutData%ElemProps) - ALLOCATE(OutData%ElemProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ElemProps,1), UBOUND(OutData%ElemProps,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_Unpackelemproptype( Re_Buf, Db_Buf, Int_Buf, OutData%ElemProps(i1), ErrStat2, ErrMsg2 ) ! ElemProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FG not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FG)) DEALLOCATE(OutData%FG) - ALLOCATE(OutData%FG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FG,1), UBOUND(OutData%FG,1) - OutData%FG(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DP0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DP0)) DEALLOCATE(OutData%DP0) - ALLOCATE(OutData%DP0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DP0,2), UBOUND(OutData%DP0,2) - DO i1 = LBOUND(OutData%DP0,1), UBOUND(OutData%DP0,1) - OutData%DP0(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%reduced = TRANSFER(IntKiBuf(Int_Xferred), OutData%reduced) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T_red not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%T_red)) DEALLOCATE(OutData%T_red) - ALLOCATE(OutData%T_red(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%T_red,2), UBOUND(OutData%T_red,2) - DO i1 = LBOUND(OutData%T_red,1), UBOUND(OutData%T_red,1) - OutData%T_red(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T_red_T not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%T_red_T)) DEALLOCATE(OutData%T_red_T) - ALLOCATE(OutData%T_red_T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_red_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%T_red_T,2), UBOUND(OutData%T_red_T,2) - DO i1 = LBOUND(OutData%T_red_T,1), UBOUND(OutData%T_red_T,1) - OutData%T_red_T(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesDOF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodesDOF)) DEALLOCATE(OutData%NodesDOF) - ALLOCATE(OutData%NodesDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodesDOF,1), UBOUND(OutData%NodesDOF,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_Unpackilist( Re_Buf, Db_Buf, Int_Buf, OutData%NodesDOF(i1), ErrStat2, ErrMsg2 ) ! NodesDOF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesDOFred not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodesDOFred)) DEALLOCATE(OutData%NodesDOFred) - ALLOCATE(OutData%NodesDOFred(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesDOFred.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodesDOFred,1), UBOUND(OutData%NodesDOFred,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_Unpackilist( Re_Buf, Db_Buf, Int_Buf, OutData%NodesDOFred(i1), ErrStat2, ErrMsg2 ) ! NodesDOFred - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElemsDOF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ElemsDOF)) DEALLOCATE(OutData%ElemsDOF) - ALLOCATE(OutData%ElemsDOF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemsDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ElemsDOF,2), UBOUND(OutData%ElemsDOF,2) - DO i1 = LBOUND(OutData%ElemsDOF,1), UBOUND(OutData%ElemsDOF,1) - OutData%ElemsDOF(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DOFred2Nodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DOFred2Nodes)) DEALLOCATE(OutData%DOFred2Nodes) - ALLOCATE(OutData%DOFred2Nodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOFred2Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DOFred2Nodes,2), UBOUND(OutData%DOFred2Nodes,2) - DO i1 = LBOUND(OutData%DOFred2Nodes,1), UBOUND(OutData%DOFred2Nodes,1) - OutData%DOFred2Nodes(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CtrlElem2Channel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CtrlElem2Channel)) DEALLOCATE(OutData%CtrlElem2Channel) - ALLOCATE(OutData%CtrlElem2Channel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CtrlElem2Channel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CtrlElem2Channel,2), UBOUND(OutData%CtrlElem2Channel,2) - DO i1 = LBOUND(OutData%CtrlElem2Channel,1), UBOUND(OutData%CtrlElem2Channel,1) - OutData%CtrlElem2Channel(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%nDOFM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SttcSolve = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%GuyanLoadCorrection = TRANSFER(IntKiBuf(Int_Xferred), OutData%GuyanLoadCorrection) - Int_Xferred = Int_Xferred + 1 - OutData%Floating = TRANSFER(IntKiBuf(Int_Xferred), OutData%Floating) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KMMDiag not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%KMMDiag)) DEALLOCATE(OutData%KMMDiag) - ALLOCATE(OutData%KMMDiag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KMMDiag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%KMMDiag,1), UBOUND(OutData%KMMDiag,1) - OutData%KMMDiag(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMMDiag not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CMMDiag)) DEALLOCATE(OutData%CMMDiag) - ALLOCATE(OutData%CMMDiag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMMDiag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CMMDiag,1), UBOUND(OutData%CMMDiag,1) - OutData%CMMDiag(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MMB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MMB)) DEALLOCATE(OutData%MMB) - ALLOCATE(OutData%MMB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MMB,2), UBOUND(OutData%MMB,2) - DO i1 = LBOUND(OutData%MMB,1), UBOUND(OutData%MMB,1) - OutData%MMB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBmmB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MBmmB)) DEALLOCATE(OutData%MBmmB) - ALLOCATE(OutData%MBmmB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBmmB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MBmmB,2), UBOUND(OutData%MBmmB,2) - DO i1 = LBOUND(OutData%MBmmB,1), UBOUND(OutData%MBmmB,1) - OutData%MBmmB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C1_11 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C1_11)) DEALLOCATE(OutData%C1_11) - ALLOCATE(OutData%C1_11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C1_11,2), UBOUND(OutData%C1_11,2) - DO i1 = LBOUND(OutData%C1_11,1), UBOUND(OutData%C1_11,1) - OutData%C1_11(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C1_12 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C1_12)) DEALLOCATE(OutData%C1_12) - ALLOCATE(OutData%C1_12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_12.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C1_12,2), UBOUND(OutData%C1_12,2) - DO i1 = LBOUND(OutData%C1_12,1), UBOUND(OutData%C1_12,1) - OutData%C1_12(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D1_141 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D1_141)) DEALLOCATE(OutData%D1_141) - ALLOCATE(OutData%D1_141(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_141.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D1_141,2), UBOUND(OutData%D1_141,2) - DO i1 = LBOUND(OutData%D1_141,1), UBOUND(OutData%D1_141,1) - OutData%D1_141(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D1_142 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D1_142)) DEALLOCATE(OutData%D1_142) - ALLOCATE(OutData%D1_142(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_142.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D1_142,2), UBOUND(OutData%D1_142,2) - DO i1 = LBOUND(OutData%D1_142,1), UBOUND(OutData%D1_142,1) - OutData%D1_142(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PhiM)) DEALLOCATE(OutData%PhiM) - ALLOCATE(OutData%PhiM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiM,2), UBOUND(OutData%PhiM,2) - DO i1 = LBOUND(OutData%PhiM,1), UBOUND(OutData%PhiM,1) - OutData%PhiM(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C2_61 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C2_61)) DEALLOCATE(OutData%C2_61) - ALLOCATE(OutData%C2_61(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_61.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C2_61,2), UBOUND(OutData%C2_61,2) - DO i1 = LBOUND(OutData%C2_61,1), UBOUND(OutData%C2_61,1) - OutData%C2_61(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C2_62 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C2_62)) DEALLOCATE(OutData%C2_62) - ALLOCATE(OutData%C2_62(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_62.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C2_62,2), UBOUND(OutData%C2_62,2) - DO i1 = LBOUND(OutData%C2_62,1), UBOUND(OutData%C2_62,1) - OutData%C2_62(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiRb_TI not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PhiRb_TI)) DEALLOCATE(OutData%PhiRb_TI) - ALLOCATE(OutData%PhiRb_TI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiRb_TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiRb_TI,2), UBOUND(OutData%PhiRb_TI,2) - DO i1 = LBOUND(OutData%PhiRb_TI,1), UBOUND(OutData%PhiRb_TI,1) - OutData%PhiRb_TI(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D2_63 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D2_63)) DEALLOCATE(OutData%D2_63) - ALLOCATE(OutData%D2_63(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_63.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D2_63,2), UBOUND(OutData%D2_63,2) - DO i1 = LBOUND(OutData%D2_63,1), UBOUND(OutData%D2_63,1) - OutData%D2_63(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D2_64 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D2_64)) DEALLOCATE(OutData%D2_64) - ALLOCATE(OutData%D2_64(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_64.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D2_64,2), UBOUND(OutData%D2_64,2) - DO i1 = LBOUND(OutData%D2_64,1), UBOUND(OutData%D2_64,1) - OutData%D2_64(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MBB)) DEALLOCATE(OutData%MBB) - ALLOCATE(OutData%MBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MBB,2), UBOUND(OutData%MBB,2) - DO i1 = LBOUND(OutData%MBB,1), UBOUND(OutData%MBB,1) - OutData%MBB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%KBB)) DEALLOCATE(OutData%KBB) - ALLOCATE(OutData%KBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%KBB,2), UBOUND(OutData%KBB,2) - DO i1 = LBOUND(OutData%KBB,1), UBOUND(OutData%KBB,1) - OutData%KBB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CBB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CBB)) DEALLOCATE(OutData%CBB) - ALLOCATE(OutData%CBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CBB,2), UBOUND(OutData%CBB,2) - DO i1 = LBOUND(OutData%CBB,1), UBOUND(OutData%CBB,1) - OutData%CBB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CMM)) DEALLOCATE(OutData%CMM) - ALLOCATE(OutData%CMM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CMM,2), UBOUND(OutData%CMM,2) - DO i1 = LBOUND(OutData%CMM,1), UBOUND(OutData%CMM,1) - OutData%CMM(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MBM)) DEALLOCATE(OutData%MBM) - ALLOCATE(OutData%MBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MBM,2), UBOUND(OutData%MBM,2) - DO i1 = LBOUND(OutData%MBM,1), UBOUND(OutData%MBM,1) - OutData%MBM(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiL_T not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PhiL_T)) DEALLOCATE(OutData%PhiL_T) - ALLOCATE(OutData%PhiL_T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiL_T,2), UBOUND(OutData%PhiL_T,2) - DO i1 = LBOUND(OutData%PhiL_T,1), UBOUND(OutData%PhiL_T,1) - OutData%PhiL_T(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiLInvOmgL2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PhiLInvOmgL2)) DEALLOCATE(OutData%PhiLInvOmgL2) - ALLOCATE(OutData%PhiLInvOmgL2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiLInvOmgL2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiLInvOmgL2,2), UBOUND(OutData%PhiLInvOmgL2,2) - DO i1 = LBOUND(OutData%PhiLInvOmgL2,1), UBOUND(OutData%PhiLInvOmgL2,1) - OutData%PhiLInvOmgL2(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KLLm1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%KLLm1)) DEALLOCATE(OutData%KLLm1) - ALLOCATE(OutData%KLLm1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KLLm1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%KLLm1,2), UBOUND(OutData%KLLm1,2) - DO i1 = LBOUND(OutData%KLLm1,1), UBOUND(OutData%KLLm1,1) - OutData%KLLm1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AM2Jac not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AM2Jac)) DEALLOCATE(OutData%AM2Jac) - ALLOCATE(OutData%AM2Jac(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AM2Jac,2), UBOUND(OutData%AM2Jac,2) - DO i1 = LBOUND(OutData%AM2Jac,1), UBOUND(OutData%AM2Jac,1) - OutData%AM2Jac(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AM2JacPiv not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AM2JacPiv)) DEALLOCATE(OutData%AM2JacPiv) - ALLOCATE(OutData%AM2JacPiv(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2JacPiv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AM2JacPiv,1), UBOUND(OutData%AM2JacPiv,1) - OutData%AM2JacPiv(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TI)) DEALLOCATE(OutData%TI) - ALLOCATE(OutData%TI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TI,2), UBOUND(OutData%TI,2) - DO i1 = LBOUND(OutData%TI,1), UBOUND(OutData%TI,1) - OutData%TI(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TIreact not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TIreact)) DEALLOCATE(OutData%TIreact) - ALLOCATE(OutData%TIreact(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIreact.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TIreact,2), UBOUND(OutData%TIreact,2) - DO i1 = LBOUND(OutData%TIreact,1), UBOUND(OutData%TIreact,1) - OutData%TIreact(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%nNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNodes_I = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNodes_L = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNodes_C = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes_I not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Nodes_I)) DEALLOCATE(OutData%Nodes_I) - ALLOCATE(OutData%Nodes_I(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_I.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Nodes_I,2), UBOUND(OutData%Nodes_I,2) - DO i1 = LBOUND(OutData%Nodes_I,1), UBOUND(OutData%Nodes_I,1) - OutData%Nodes_I(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes_L not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Nodes_L)) DEALLOCATE(OutData%Nodes_L) - ALLOCATE(OutData%Nodes_L(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Nodes_L,2), UBOUND(OutData%Nodes_L,2) - DO i1 = LBOUND(OutData%Nodes_L,1), UBOUND(OutData%Nodes_L,1) - OutData%Nodes_L(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes_C not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Nodes_C)) DEALLOCATE(OutData%Nodes_C) - ALLOCATE(OutData%Nodes_C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Nodes_C,2), UBOUND(OutData%Nodes_C,2) - DO i1 = LBOUND(OutData%Nodes_C,1), UBOUND(OutData%Nodes_C,1) - OutData%Nodes_C(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%nDOFI__ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFI_Rb = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFI_F = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFL_L = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFC__ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFC_Rb = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFC_L = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFC_F = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFR__ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOF__Rb = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOF__L = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOF__F = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDI__ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDI__)) DEALLOCATE(OutData%IDI__) - ALLOCATE(OutData%IDI__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDI__,1), UBOUND(OutData%IDI__,1) - OutData%IDI__(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDI_Rb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDI_Rb)) DEALLOCATE(OutData%IDI_Rb) - ALLOCATE(OutData%IDI_Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI_Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDI_Rb,1), UBOUND(OutData%IDI_Rb,1) - OutData%IDI_Rb(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDI_F not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDI_F)) DEALLOCATE(OutData%IDI_F) - ALLOCATE(OutData%IDI_F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDI_F,1), UBOUND(OutData%IDI_F,1) - OutData%IDI_F(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDL_L not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDL_L)) DEALLOCATE(OutData%IDL_L) - ALLOCATE(OutData%IDL_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDL_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDL_L,1), UBOUND(OutData%IDL_L,1) - OutData%IDL_L(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC__ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDC__)) DEALLOCATE(OutData%IDC__) - ALLOCATE(OutData%IDC__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDC__,1), UBOUND(OutData%IDC__,1) - OutData%IDC__(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC_Rb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDC_Rb)) DEALLOCATE(OutData%IDC_Rb) - ALLOCATE(OutData%IDC_Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDC_Rb,1), UBOUND(OutData%IDC_Rb,1) - OutData%IDC_Rb(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC_L not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDC_L)) DEALLOCATE(OutData%IDC_L) - ALLOCATE(OutData%IDC_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDC_L,1), UBOUND(OutData%IDC_L,1) - OutData%IDC_L(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC_F not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDC_F)) DEALLOCATE(OutData%IDC_F) - ALLOCATE(OutData%IDC_F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDC_F,1), UBOUND(OutData%IDC_F,1) - OutData%IDC_F(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDR__ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDR__)) DEALLOCATE(OutData%IDR__) - ALLOCATE(OutData%IDR__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDR__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDR__,1), UBOUND(OutData%IDR__,1) - OutData%IDR__(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ID__Rb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ID__Rb)) DEALLOCATE(OutData%ID__Rb) - ALLOCATE(OutData%ID__Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ID__Rb,1), UBOUND(OutData%ID__Rb,1) - OutData%ID__Rb(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ID__L not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ID__L)) DEALLOCATE(OutData%ID__L) - ALLOCATE(OutData%ID__L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ID__L,1), UBOUND(OutData%ID__L,1) - OutData%ID__L(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ID__F not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ID__F)) DEALLOCATE(OutData%ID__F) - ALLOCATE(OutData%ID__F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ID__F,1), UBOUND(OutData%ID__F,1) - OutData%ID__F(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NMOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnJckF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MoutLst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MoutLst)) DEALLOCATE(OutData%MoutLst) - ALLOCATE(OutData%MoutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MoutLst,1), UBOUND(OutData%MoutLst,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_Unpackmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, OutData%MoutLst(i1), ErrStat2, ErrMsg2 ) ! MoutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MoutLst2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MoutLst2)) DEALLOCATE(OutData%MoutLst2) - ALLOCATE(OutData%MoutLst2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MoutLst2,1), UBOUND(OutData%MoutLst2,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_Unpackmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, OutData%MoutLst2(i1), ErrStat2, ErrMsg2 ) ! MoutLst2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MoutLst3 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MoutLst3)) DEALLOCATE(OutData%MoutLst3) - ALLOCATE(OutData%MoutLst3(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MoutLst3,1), UBOUND(OutData%MoutLst3,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_Unpackmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, OutData%MoutLst3(i1), ErrStat2, ErrMsg2 ) ! MoutLst3 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) - Int_Xferred = Int_Xferred + 1 - OutData%OutReact = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutReact) - Int_Xferred = Int_Xferred + 1 - OutData%OutAllInt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutAllDims = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutDec = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) - DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) - OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%du)) DEALLOCATE(OutData%du) - ALLOCATE(OutData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) - OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%dx,1) - i1_u = UBOUND(OutData%dx,1) - DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) - OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Jac_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RotStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotStates) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_UnPackParam - - SUBROUTINE SD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_InputType), INTENT(INOUT) :: SrcInputData - TYPE(SD_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%TPMesh, DstInputData%TPMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%LMesh, DstInputData%LMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInputData%CableDeltaL)) THEN - i1_l = LBOUND(SrcInputData%CableDeltaL,1) - i1_u = UBOUND(SrcInputData%CableDeltaL,1) - IF (.NOT. ALLOCATED(DstInputData%CableDeltaL)) THEN - ALLOCATE(DstInputData%CableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%CableDeltaL = SrcInputData%CableDeltaL -ENDIF - END SUBROUTINE SD_CopyInput - - SUBROUTINE SD_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(SD_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshDestroy( InputData%TPMesh, ErrStat, ErrMsg ) - CALL MeshDestroy( InputData%LMesh, ErrStat, ErrMsg ) -IF (ALLOCATED(InputData%CableDeltaL)) THEN - DEALLOCATE(InputData%CableDeltaL) -ENDIF - END SUBROUTINE SD_DestroyInput - - SUBROUTINE SD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! TPMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TPMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TPMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TPMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TPMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! LMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! LMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! CableDeltaL allocated yes/no - IF ( ALLOCATED(InData%CableDeltaL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableDeltaL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CableDeltaL) ! CableDeltaL - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TPMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! LMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%CableDeltaL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CableDeltaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableDeltaL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableDeltaL,1), UBOUND(InData%CableDeltaL,1) - ReKiBuf(Re_Xferred) = InData%CableDeltaL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackInput - - SUBROUTINE SD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TPMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! LMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableDeltaL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CableDeltaL)) DEALLOCATE(OutData%CableDeltaL) - ALLOCATE(OutData%CableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableDeltaL,1), UBOUND(OutData%CableDeltaL,1) - OutData%CableDeltaL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackInput - - SUBROUTINE SD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(SD_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%Y1Mesh, DstOutputData%Y1Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%Y2Mesh, DstOutputData%Y2Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - END SUBROUTINE SD_CopyOutput - - SUBROUTINE SD_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(SD_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshDestroy( OutputData%Y1Mesh, ErrStat, ErrMsg ) - CALL MeshDestroy( OutputData%Y2Mesh, ErrStat, ErrMsg ) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE SD_DestroyOutput - - SUBROUTINE SD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Y1Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Y1Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Y1Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Y1Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Y1Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Y1Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Y2Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Y2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Y2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Y2Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Y2Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Y2Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%Y1Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Y1Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%Y2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Y2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackOutput - - SUBROUTINE SD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%Y1Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Y1Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%Y2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Y2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackOutput - - - SUBROUTINE SD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(SD_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(SD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL SD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL SD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE SD_Input_ExtrapInterp - - - SUBROUTINE SD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = u1, f(t2) = u2 -! -!.................................................................................................................................. - - TYPE(SD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(SD_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(SD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(u1%TPMesh, u2%TPMesh, tin, u_out%TPMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%LMesh, u2%LMesh, tin, u_out%LMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%CableDeltaL) .AND. ALLOCATED(u1%CableDeltaL)) THEN - DO i1 = LBOUND(u_out%CableDeltaL,1),UBOUND(u_out%CableDeltaL,1) - b = -(u1%CableDeltaL(i1) - u2%CableDeltaL(i1)) - u_out%CableDeltaL(i1) = u1%CableDeltaL(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SD_Input_ExtrapInterp1 - - - SUBROUTINE SD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 -! -!.................................................................................................................................. - - TYPE(SD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(SD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(SD_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(SD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(u1%TPMesh, u2%TPMesh, u3%TPMesh, tin, u_out%TPMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%LMesh, u2%LMesh, u3%LMesh, tin, u_out%LMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%CableDeltaL) .AND. ALLOCATED(u1%CableDeltaL)) THEN - DO i1 = LBOUND(u_out%CableDeltaL,1),UBOUND(u_out%CableDeltaL,1) - b = (t(3)**2*(u1%CableDeltaL(i1) - u2%CableDeltaL(i1)) + t(2)**2*(-u1%CableDeltaL(i1) + u3%CableDeltaL(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%CableDeltaL(i1) + t(3)*u2%CableDeltaL(i1) - t(2)*u3%CableDeltaL(i1) ) * scaleFactor - u_out%CableDeltaL(i1) = u1%CableDeltaL(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SD_Input_ExtrapInterp2 - - - SUBROUTINE SD_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(SD_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(SD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL SD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL SD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE SD_Output_ExtrapInterp - - - SUBROUTINE SD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = y1, f(t2) = y2 -! -!.................................................................................................................................. - - TYPE(SD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(SD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(SD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(y1%Y1Mesh, y2%Y1Mesh, tin, y_out%Y1Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%Y2Mesh, y2%Y2Mesh, tin, y_out%Y2Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SD_Output_ExtrapInterp1 - - - SUBROUTINE SD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 -! -!.................................................................................................................................. - - TYPE(SD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(SD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(SD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(SD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(y1%Y1Mesh, y2%Y1Mesh, y3%Y1Mesh, tin, y_out%Y1Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%Y2Mesh, y2%Y2Mesh, y3%Y2Mesh, tin, y_out%Y2Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SD_Output_ExtrapInterp2 - -END MODULE SubDyn_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/OpenFAST/modules/subdyn/src/Yaml.f90 b/OpenFAST/modules/subdyn/src/Yaml.f90 deleted file mode 100644 index ec3043c23..000000000 --- a/OpenFAST/modules/subdyn/src/Yaml.f90 +++ /dev/null @@ -1,609 +0,0 @@ -!.................................................................................................................................. -! LICENSING -! Copyright (C) 2013-2016 National Renewable Energy Laboratory -! -! This file is part of SubDyn. -! -! 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. -! -!********************************************************************************************************************************** -module YAML - use NWTC_Library - - implicit none - - integer(IntKi), parameter :: INDENT_SPACES = 2 - - !> Write 1D or 2D array to file - interface yaml_write_array - module procedure yaml_write_array1I ! Single dimension array (Ary) of IntKi - module procedure yaml_write_array1R4 ! Single dimension array (Ary) of SiKi - module procedure yaml_write_array2R4 ! Two dimension array of SiKi - module procedure yaml_write_array1R8 ! Single dimension array (Ary) of R8Ki - module procedure yaml_write_array2R8 ! Two dimension array of R8Ki - module procedure yaml_write_array2I ! Two dimension array of IntKi - module procedure yaml_write_array1R16 ! Single dimension array (Ary) of QuKi - module procedure yaml_write_array2R16 ! Two dimension array of QuKi - end interface - - !> Write variable to file - interface yaml_write_var - module procedure yaml_write_varC ! Character - module procedure yaml_write_varI ! IntKi - module procedure yaml_write_varR4 ! SiKi - module procedure yaml_write_varR8 ! R8Ki - module procedure yaml_write_varR16 ! QuKi - end interface - private - - public :: yaml_write_var - public :: yaml_write_array - -contains - -! -------------------------------------------------------------------------------- -! --- Write variable -! -------------------------------------------------------------------------------- -!> Write simple key/variable to yaml file -subroutine yaml_write_varC(fid, key, val, VarFmt, ErrStat, ErrMsg, level, comment) - integer(IntKi), intent(in ) :: fid !< File Unit - character(len=*), intent(in ) :: key !< Variable name - character(len=*), intent(in ) :: val !< Value - character(len=*), intent(in ) :: VarFmt !< Format for printing real numbers - integer, intent( out) :: ErrStat !< A non-zero value indicates an error occurred - character(len=*), intent( out) :: ErrMsg !< Error message if errstat /= errid_none - integer(IntKi), optional, intent(in ) :: level !< indentation level - character(len=*), optional, intent(in ) :: comment !< - character(256) :: Fmt - ErrStat = ErrID_None - ErrMsg = "" - Fmt = '' - if (present(level)) Fmt = trim(Num2LStr(level*INDENT_SPACES))//'X,' - if (present(comment)) then - Fmt = '('//trim(Fmt)//'A,": ",'//trim(VarFmt)//', " # ",A)' - write(fid, Fmt, iostat=ErrStat) key, val, comment - else - Fmt = '('//trim(Fmt)//'A,": ",'//trim(VarFmt)//')' - write(fid, Fmt, iostat=ErrStat) key, val - endif - if (ErrStat /= 0) then - ErrMsg='Error writting variable '//trim(key)//' to YAML file' - return - endif -end subroutine yaml_write_varC - -subroutine yaml_write_varI(fid, key, val, VarFmt, ErrStat, ErrMsg, level, comment) - integer(IntKi), intent(in ) :: fid !< File Unit - character(len=*), intent(in ) :: key !< Variable name - integer(IntKi), intent(in ) :: val !< Value - character(len=*), intent(in ) :: VarFmt !< Format for printing real numbers - integer, intent( out) :: ErrStat !< A non-zero value indicates an error occurred - character(len=*), intent( out) :: ErrMsg !< Error message if errstat /= errid_none - integer(IntKi), optional, intent(in ) :: level !< indentation level - character(len=*), optional, intent(in ) :: comment !< - character(256) :: Fmt - ErrStat = ErrID_None - ErrMsg = "" - Fmt = '' - if (present(level)) Fmt = trim(Num2LStr(level*INDENT_SPACES))//'X,' - if (present(comment)) then - Fmt = '('//trim(Fmt)//'A,": ",'//trim(VarFmt)//', " # ",A)' - write(fid, Fmt, iostat=ErrStat) key, val, comment - else - Fmt = '('//trim(Fmt)//'A,": ",'//trim(VarFmt)//')' - write(fid, Fmt, iostat=ErrStat) key, val - endif - if (ErrStat /= 0) then - ErrMsg='Error writting variable '//trim(key)//' to YAML file' - return - endif -end subroutine yaml_write_varI - -subroutine yaml_write_varR4(fid, key, val, VarFmt, ErrStat, ErrMsg, level, comment) - integer(IntKi), intent(in ) :: fid !< File Unit - character(len=*), intent(in ) :: key !< Variable name - real(SiKi), intent(in ) :: val !< Value - character(len=*), intent(in ) :: VarFmt !< Format for printing real numbers - integer, intent( out) :: ErrStat !< A non-zero value indicates an error occurred - character(len=*), intent( out) :: ErrMsg !< Error message if errstat /= errid_none - integer(IntKi), optional, intent(in ) :: level !< indentation level - character(len=*), optional, intent(in ) :: comment !< - character(256) :: Fmt - ErrStat = ErrID_None - ErrMsg = "" - Fmt = '' - if (present(level)) Fmt = trim(Num2LStr(level*INDENT_SPACES))//'X,' - if (present(comment)) then - Fmt = '('//trim(Fmt)//'A,": ",'//trim(VarFmt)//', " # ",A)' - write(fid, Fmt, iostat=ErrStat) key, val, comment - else - Fmt = '('//trim(Fmt)//'A,": ",'//trim(VarFmt)//')' - write(fid, Fmt, iostat=ErrStat) key, val - endif - if (ErrStat /= 0) then - ErrMsg='Error writting variable '//trim(key)//' to YAML file' - return - endif -end subroutine yaml_write_varR4 - -subroutine yaml_write_varR8(fid, key, val, VarFmt, ErrStat, ErrMsg, level, comment) - integer(IntKi), intent(in ) :: fid !< File Unit - character(len=*), intent(in ) :: key !< Variable name - real(R8Ki), intent(in ) :: val !< Value - character(len=*), intent(in ) :: VarFmt !< Format for printing real numbers - integer, intent( out) :: ErrStat !< A non-zero value indicates an error occurred - character(len=*), intent( out) :: ErrMsg !< Error message if errstat /= errid_none - integer(IntKi), optional, intent(in ) :: level !< indentation level - character(len=*), optional, intent(in ) :: comment !< - character(256) :: Fmt - ErrStat = ErrID_None - ErrMsg = "" - Fmt = '' - if (present(level)) Fmt = trim(Num2LStr(level*INDENT_SPACES))//'X,' - if (present(comment)) then - Fmt = '('//trim(Fmt)//'A,": ",'//trim(VarFmt)//', " # ",A)' - write(fid, Fmt, iostat=ErrStat) key, val, comment - else - Fmt = '('//trim(Fmt)//'A,": ",'//trim(VarFmt)//')' - write(fid, Fmt, iostat=ErrStat) key, val - endif - if (ErrStat /= 0) then - ErrMsg='Error writting variable '//trim(key)//' to YAML file' - return - endif -end subroutine yaml_write_varR8 - -subroutine yaml_write_varR16(fid, key, val, VarFmt, ErrStat, ErrMsg, level, comment) - integer(IntKi), intent(in ) :: fid !< File Unit - character(len=*), intent(in ) :: key !< Variable name - real(QuKi), intent(in ) :: val !< Value - character(len=*), intent(in ) :: VarFmt !< Format for printing real numbers - integer, intent( out) :: ErrStat !< A non-zero value indicates an error occurred - character(len=*), intent( out) :: ErrMsg !< Error message if errstat /= errid_none - integer(IntKi), optional, intent(in ) :: level !< indentation level - character(len=*), optional, intent(in ) :: comment !< - character(256) :: Fmt - ErrStat = ErrID_None - ErrMsg = "" - Fmt = '' - if (present(level)) Fmt = trim(Num2LStr(level*INDENT_SPACES))//'X,' - if (present(comment)) then - Fmt = '('//trim(Fmt)//'A,": ",'//trim(VarFmt)//', " # ",A)' - write(fid, Fmt, iostat=ErrStat) key, val, comment - else - Fmt = '('//trim(Fmt)//'A,": ",'//trim(VarFmt)//')' - write(fid, Fmt, iostat=ErrStat) key, val - endif - if (ErrStat /= 0) then - ErrMsg='Error writting variable '//trim(key)//' to YAML file' - return - endif -end subroutine yaml_write_varR16 - -! -------------------------------------------------------------------------------- -! --- Write array -! -------------------------------------------------------------------------------- -!> Write 1D or 2D array to file -subroutine yaml_write_array1I(fid, key, A, VarFmt, ErrStat, ErrMsg, level, comment) - integer(IntKi), intent(in ) :: fid !< File Unit - character(len=*), intent(in ) :: key !< Array name - integer(IntKi), dimension(:), intent(in ) :: A !< Array - character(len=*), intent(in ) :: VarFmt !< Format for printing real numbers - integer, intent( out) :: ErrStat !< A non-zero value indicates an error occurred - character(len=*), intent( out) :: ErrMsg !< Error message if errstat /= errid_none - integer(IntKi), optional, intent(in ) :: level !< indentation level - character(len=*), optional, intent(in ) :: comment !< - integer :: nc ! size (rows and columns) of A - integer :: nSpaces ! number of indentation spaces - character(256) :: Fmt - ErrStat = ErrID_None - ErrMsg = "" - nc = size(A,1) - - if (present(level)) then - Fmt = trim(Num2LStr(level*INDENT_SPACES))//'X,' - else - Fmt = '' - endif - - if (present(comment)) then - write(fid, '('//trim(Fmt)//'A,": # ",I0," x ",I0,1X,A)', iostat=ErrStat ) trim(key), 1, nc, trim(comment) - - else - write(fid, '('//trim(Fmt)//'A,": # ",I0," x ",I0)' , iostat=ErrStat ) trim(key), 1, nc - end if - - if (present(level)) then - Fmt = trim(Num2LStr((level+1)*INDENT_SPACES))//'X,' - else - Fmt = trim(Num2LStr(INDENT_SPACES))//'X,' - endif - - if (nc==0) then - write(fid, '('//trim(Fmt)//'"- [ ]")', iostat=ErrStat) - else - Fmt = '('//trim(Fmt)//'"- [",'//trim(Num2LStr(nc))//'('//VarFmt//',","),"]")' - write(fid, Fmt, iostat=ErrStat) A(:) - if (ErrStat /= 0) then - ErrMsg='Error writting array '//trim(key)//' to YAML file' - return - end if - endif -end subroutine yaml_write_array1I - -subroutine yaml_write_array1R4(fid, key, A, VarFmt, ErrStat, ErrMsg, level, comment) - integer(IntKi), intent(in ) :: fid !< File Unit - character(len=*), intent(in ) :: key !< Array name - real(SiKi), dimension(:), intent(in ) :: A !< Array - character(len=*), intent(in ) :: VarFmt !< Format for printing real numbers - integer, intent( out) :: ErrStat !< A non-zero value indicates an error occurred - character(len=*), intent( out) :: ErrMsg !< Error message if errstat /= errid_none - integer(IntKi), optional, intent(in ) :: level !< indentation level - character(len=*), optional, intent(in ) :: comment !< - integer :: nc ! size (rows and columns) of A - integer :: nSpaces ! number of indentation spaces - character(256) :: Fmt - ErrStat = ErrID_None - ErrMsg = "" - nc = size(A,1) - - if (present(level)) then - Fmt = trim(Num2LStr(level*INDENT_SPACES))//'X,' - else - Fmt = '' - endif - - if (present(comment)) then - write(fid, '('//trim(Fmt)//'A,": # ",I0," x ",I0,1X,A)', iostat=ErrStat ) trim(key), 1, nc, trim(comment) - - else - write(fid, '('//trim(Fmt)//'A,": # ",I0," x ",I0)' , iostat=ErrStat ) trim(key),1,nc - end if - - if (present(level)) then - Fmt = trim(Num2LStr((level+1)*INDENT_SPACES))//'X,' - else - Fmt = trim(Num2LStr(INDENT_SPACES))//'X,' - endif - - if (nc==0) then - write(fid, '('//trim(Fmt)//'"- [ ]")', iostat=ErrStat) - else - Fmt = '('//trim(Fmt)//'"- [",'//trim(Num2LStr(nc))//'('//VarFmt//',","),"]")' - write(fid, Fmt, iostat=ErrStat) A(:) - if (ErrStat /= 0) then - ErrMsg='Error writting array '//trim(key)//' to YAML file' - return - end if - endif -end subroutine yaml_write_array1R4 - -subroutine yaml_write_array1R8(fid, key, A, VarFmt, ErrStat, ErrMsg, level, comment) - integer(IntKi), intent(in ) :: fid !< File Unit - character(len=*), intent(in ) :: key !< Array name - real(R8Ki), dimension(:), intent(in ) :: A !< Array - character(len=*), intent(in ) :: VarFmt !< Format for printing real numbers - integer, intent( out) :: ErrStat !< A non-zero value indicates an error occurred - character(len=*), intent( out) :: ErrMsg !< Error message if errstat /= errid_none - integer(IntKi), optional, intent(in ) :: level !< indentation level - character(len=*), optional, intent(in ) :: comment !< - integer :: nc ! size (rows and columns) of A - integer :: nSpaces ! number of indentation spaces - character(256) :: Fmt - ErrStat = ErrID_None - ErrMsg = "" - nc = size(A,1) - - if (present(level)) then - Fmt = trim(Num2LStr(level*INDENT_SPACES))//'X,' - else - Fmt = '' - endif - - if (present(comment)) then - write(fid, '('//trim(Fmt)//'A,": # ",I0," x ",I0,1X,A)', iostat=ErrStat ) trim(key), 1, nc, trim(comment) - else - write(fid, '('//trim(Fmt)//'A,": # ",I0," x ",I0)' , iostat=ErrStat ) trim(key), 1, nc - end if - - if (present(level)) then - Fmt = trim(Num2LStr((level+1)*INDENT_SPACES))//'X,' - else - Fmt = trim(Num2LStr(INDENT_SPACES))//'X,' - endif - - if (nc==0) then - write(fid, '('//trim(Fmt)//'"- [ ]")', iostat=ErrStat) - else - Fmt = '('//trim(Fmt)//'"- [",'//trim(Num2LStr(nc))//'('//VarFmt//',","),"]")' - write(fid, Fmt, iostat=ErrStat) A(:) - if (ErrStat /= 0) then - ErrMsg='Error writting array '//trim(key)//' to YAML file' - return - end if - endif -end subroutine yaml_write_array1R8 - -subroutine yaml_write_array1R16(fid, key, A, VarFmt, ErrStat, ErrMsg, level, comment) - integer(IntKi), intent(in ) :: fid !< File Unit - character(len=*), intent(in ) :: key !< Array name - real(QuKi), dimension(:), intent(in ) :: A !< Array - character(len=*), intent(in ) :: VarFmt !< Format for printing real numbers - integer, intent( out) :: ErrStat !< A non-zero value indicates an error occurred - character(len=*), intent( out) :: ErrMsg !< Error message if errstat /= errid_none - integer(IntKi), optional, intent(in ) :: level !< indentation level - character(len=*), optional, intent(in ) :: comment !< - integer :: nc ! size (rows and columns) of A - integer :: nSpaces ! number of indentation spaces - character(256) :: Fmt - ErrStat = ErrID_None - ErrMsg = "" - nc = size(A,1) - - if (present(level)) then - Fmt = trim(Num2LStr(level*INDENT_SPACES))//'X,' - else - Fmt = '' - endif - - if (present(comment)) then - write(fid, '('//trim(Fmt)//'A,": # ",I0," x ",I0,1X,A)', iostat=ErrStat ) trim(key), 1, nc, trim(comment) - - else - write(fid, '('//trim(Fmt)//'A,": # ",I0," x ",I0)' , iostat=ErrStat ) trim(key),1,nc - end if - - if (present(level)) then - Fmt = trim(Num2LStr((level+1)*INDENT_SPACES))//'X,' - else - Fmt = trim(Num2LStr(INDENT_SPACES))//'X,' - endif - - if (nc==0) then - write(fid, '('//trim(Fmt)//'"- [ ]")', iostat=ErrStat) - else - Fmt = '('//trim(Fmt)//'"- [",'//trim(Num2LStr(nc))//'('//VarFmt//',","),"]")' - write(fid, Fmt, iostat=ErrStat) A(:) - if (ErrStat /= 0) then - ErrMsg='Error writting array '//trim(key)//' to YAML file' - return - end if - endif -end subroutine yaml_write_array1R16 - -subroutine yaml_write_array2I(fid, key, A, VarFmt, ErrStat, ErrMsg, level, comment, label) - integer(IntKi), intent(in ) :: fid !< File Unit - character(len=*), intent(in ) :: key !< Array name - integer(IntKi), dimension(:,:), intent(in ) :: A !< Array - character(len=*), intent(in ) :: VarFmt !< Format for printing real numbers - integer, intent( out) :: ErrStat !< A non-zero value indicates an error occurred - character(len=*), intent( out) :: ErrMsg !< Error message if errstat /= errid_none - integer(IntKi), optional, intent(in ) :: level !< indentation level - character(len=*), optional, intent(in ) :: comment !< - logical, optional, intent(in ) :: label !< If present, add a index label at end of line - integer :: nr, nc, i ! size (rows and columns) of A - integer :: nSpaces ! number of indentation spaces - character(256) :: Fmt - ErrStat = ErrID_None - ErrMsg = "" - nr = size(A,1) - nc = size(A,2) - - Fmt = '' - if (present(level)) Fmt = trim(Num2LStr(level*INDENT_SPACES))//'X,' - if (present(comment)) then - write(fid, '('//trim(Fmt)//'A,": # ",I0," x ",I0,1X,A)', iostat=ErrStat ) trim(key), nr, nc, trim(comment) - - else - write(fid, '('//trim(Fmt)//'A,": # ",I0," x ",I0)' , iostat=ErrStat ) trim(key),nr,nc - end if - - if (present(level)) then - Fmt = trim(Num2LStr((level+1)*INDENT_SPACES))//'X,' - else - Fmt = trim(Num2LStr(INDENT_SPACES))//'X,' - endif - if (nr==0) then - write(fid, '('//trim(Fmt)//'"- [ ]")', iostat=ErrStat) - else - if (present(label)) then - Fmt = '('//trim(Fmt)//'"- [",'//trim(Num2LStr(nc))//'('//VarFmt//',","),"] # ",I0)' - else - Fmt = '('//trim(Fmt)//'"- [",'//trim(Num2LStr(nc))//'('//VarFmt//',","),"]")' - endif - do i=1,nr - if (present(label)) then - write(fid, Fmt, iostat=ErrStat) A(i,:), i - else - write(fid, Fmt, iostat=ErrStat) A(i,:) - endif - if (ErrStat /= 0) then - ErrMsg='Error writting array '//trim(key)//' to YAML file' - return - end if - end do - endif -end subroutine yaml_write_array2I - -subroutine yaml_write_array2R4(fid, key, A, VarFmt, ErrStat, ErrMsg, level, comment, AllFmt) - integer(IntKi), intent(in ) :: fid !< File Unit - character(len=*), intent(in ) :: key !< Array name - real(SiKi), dimension(:,:), intent(in ) :: A !< Array - character(len=*), intent(in ) :: VarFmt !< Format for printing real numbers - integer, intent( out) :: ErrStat !< A non-zero value indicates an error occurred - character(len=*), intent( out) :: ErrMsg !< Error message if errstat /= errid_none - integer(IntKi), optional, intent(in ) :: level !< indentation level - character(len=*), optional, intent(in ) :: comment !< - character(len=*), optional, intent(in ) :: AllFmt !< Format for printing a line - integer :: nr, nc, i ! size (rows and columns) of A - integer :: nSpaces ! number of indentation spaces - character(256) :: Fmt - ErrStat = ErrID_None - ErrMsg = "" - nr = size(A,1) - nc = size(A,2) - - if (present(level)) then - Fmt = trim(Num2LStr(level*INDENT_SPACES))//'X,' - else - Fmt = '' - endif - - if (present(comment)) then - write(fid, '('//trim(Fmt)//'A,": # ",I0," x ",I0,1X,A)', iostat=ErrStat ) trim(key), nr, nc, trim(comment) - - else - write(fid, '('//trim(Fmt)//'A,": # ",I0," x ",I0)' , iostat=ErrStat ) trim(key),nr,nc - end if - - if (present(level)) then - Fmt = trim(Num2LStr((level+1)*INDENT_SPACES))//'X,' - else - Fmt = trim(Num2LStr(INDENT_SPACES))//'X,' - endif - - if (nr==0) then - write(fid, '('//trim(Fmt)//'"- [ ]")', iostat=ErrStat) - else - if (nc==0) then - Fmt = '('//trim(Fmt)//'"- []")' - else - if (present(AllFmt)) then - Fmt = '('//trim(Fmt)//'"- [",'//trim(AllFmt)//'"]")' - else - Fmt = '('//trim(Fmt)//'"- [",'//trim(Num2LStr(nc))//'('//VarFmt//',","),"]")' - endif - endif - do i=1,nr - write(fid, Fmt, iostat=ErrStat) A(i,:) - if (ErrStat /= 0) then - ErrMsg='Error writting array '//trim(key)//' to YAML file' - return - end if - end do - endif -end subroutine yaml_write_array2R4 - -subroutine yaml_write_array2R8(fid, key, A, VarFmt, ErrStat, ErrMsg, level, comment, AllFmt) - integer(IntKi), intent(in ) :: fid !< File Unit - character(len=*), intent(in ) :: key !< Array name - real(R8Ki), dimension(:,:), intent(in ) :: A !< Array - character(len=*), intent(in ) :: VarFmt !< Format for printing real numbers - integer, intent( out) :: ErrStat !< A non-zero value indicates an error occurred - character(len=*), intent( out) :: ErrMsg !< Error message if errstat /= errid_none - integer(IntKi), optional, intent(in ) :: level !< indentation level - character(len=*), optional, intent(in ) :: comment !< - character(len=*), optional, intent(in ) :: AllFmt !< Format for printing a line - integer :: nr, nc, i ! size (rows and columns) of A - integer :: nSpaces ! number of indentation spaces - character(256) :: Fmt - ErrStat = ErrID_None - ErrMsg = "" - nr = size(A,1) - nc = size(A,2) - - if (present(level)) then - Fmt = trim(Num2LStr(level*INDENT_SPACES))//'X,' - else - Fmt = '' - endif - if (present(comment)) then - write(fid, '('//trim(Fmt)//'A,": # ",I0," x ",I0,1X,A)', iostat=ErrStat ) trim(key), nr, nc, trim(comment) - - else - write(fid, '('//trim(Fmt)//'A,": # ",I0," x ",I0)' , iostat=ErrStat ) trim(key),nr,nc - end if - - if (present(level)) then - Fmt = trim(Num2LStr((level+1)*INDENT_SPACES))//'X,' - else - Fmt = trim(Num2LStr(INDENT_SPACES))//'X,' - endif - if (nr==0) then - write(fid, '('//trim(Fmt)//'"- [ ]")', iostat=ErrStat) - else - if (nc==0) then - Fmt = '('//trim(Fmt)//'"- []")' - else - if (present(AllFmt)) then - Fmt = '('//trim(Fmt)//'"- [",'//trim(AllFmt)//'"]")' - else - Fmt = '('//trim(Fmt)//'"- [",'//trim(Num2LStr(nc))//'('//VarFmt//',","),"]")' - endif - endif - do i=1,nr - write(fid, Fmt, iostat=ErrStat) A(i,:) - if (ErrStat /= 0) then - ErrMsg='Error writting array '//trim(key)//' to YAML file' - return - end if - end do - endif -end subroutine yaml_write_array2R8 - -subroutine yaml_write_array2R16(fid, key, A, VarFmt, ErrStat, ErrMsg, level, comment, AllFmt) - integer(IntKi), intent(in ) :: fid !< File Unit - character(len=*), intent(in ) :: key !< Array name - real(QuKi), dimension(:,:), intent(in ) :: A !< Array - character(len=*), intent(in ) :: VarFmt !< Format for printing real numbers - integer, intent( out) :: ErrStat !< A non-zero value indicates an error occurred - character(len=*), intent( out) :: ErrMsg !< Error message if errstat /= errid_none - integer(IntKi), optional, intent(in ) :: level !< indentation level - character(len=*), optional, intent(in ) :: comment !< - character(len=*), optional, intent(in ) :: AllFmt !< Format for printing a line - integer :: nr, nc, i ! size (rows and columns) of A - integer :: nSpaces ! number of indentation spaces - character(256) :: Fmt - ErrStat = ErrID_None - ErrMsg = "" - nr = size(A,1) - nc = size(A,2) - - Fmt = '' - if (present(level)) Fmt = trim(Num2LStr(level*INDENT_SPACES))//'X,' - if (present(comment)) then - write(fid, '('//trim(Fmt)//'A,": # ",I0," x ",I0,1X,A)', iostat=ErrStat ) trim(key), nr, nc, trim(comment) - - else - write(fid, '('//trim(Fmt)//'A,": # ",I0," x ",I0)' , iostat=ErrStat ) trim(key),nr,nc - end if - - if (present(level)) then - Fmt = trim(Num2LStr((level+1)*INDENT_SPACES))//'X,' - else - Fmt = trim(Num2LStr(INDENT_SPACES))//'X,' - endif - if (nr==0) then - write(fid, '('//trim(Fmt)//'"- [ ]")', iostat=ErrStat) - else - if (nc==0) then - Fmt = '('//trim(Fmt)//'"- []")' - else - if (present(AllFmt)) then - Fmt = '('//trim(Fmt)//'"- [",'//trim(AllFmt)//'"]")' - else - Fmt = '('//trim(Fmt)//'"- [",'//trim(Num2LStr(nc))//'('//VarFmt//',","),"]")' - endif - endif - do i=1,nr - write(fid, Fmt, iostat=ErrStat) A(i,:) - if (ErrStat /= 0) then - ErrMsg='Error writting array '//trim(key)//' to YAML file' - return - end if - end do - endif -end subroutine yaml_write_array2R16 - - -end module YAML diff --git a/OpenFAST/modules/supercontroller/CMakeLists.txt b/OpenFAST/modules/supercontroller/CMakeLists.txt deleted file mode 100644 index 4dfde3048..000000000 --- a/OpenFAST/modules/supercontroller/CMakeLists.txt +++ /dev/null @@ -1,48 +0,0 @@ -# -# Copyright 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. -# - -if (GENERATE_TYPES) - generate_f90_types(src/SuperController_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/SuperController_Types.f90 -ccode) - generate_f90_types(src/SC_DataEx_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/SCDataEx_Types.f90 -ccode -noextrap) -endif() - -# copy the header files to their build location -configure_file(src/SuperController_Types.h ${CMAKE_CURRENT_BINARY_DIR} COPYONLY) -configure_file(src/SCDataEx_Types.h ${CMAKE_CURRENT_BINARY_DIR} COPYONLY) - -add_library(scdataextypeslib src/SCDataEx_Types.f90) -target_link_libraries(scdataextypeslib nwtclibs) - -add_library(scdataexlib src/SC_DataEx.f90) -target_link_libraries(scdataexlib scdataextypeslib openfast_prelib nwtclibs) - -add_library(sctypeslib src/SuperController_Types.f90) -target_link_libraries(sctypeslib nwtclibs) - -add_library(scfastlib - src/SuperController.f90) -target_link_libraries(scfastlib sctypeslib openfast_prelib nwtclibs) - -install(TARGETS sctypeslib scfastlib scdataextypeslib scdataexlib - EXPORT "${CMAKE_PROJECT_NAME}Libraries" - RUNTIME DESTINATION bin - LIBRARY DESTINATION lib - ARCHIVE DESTINATION lib) - -install(FILES - ${CMAKE_CURRENT_BINARY_DIR}/SuperController_Types.h - ${CMAKE_CURRENT_BINARY_DIR}/SCDataEx_Types.h - DESTINATION include) diff --git a/OpenFAST/modules/supercontroller/README.md b/OpenFAST/modules/supercontroller/README.md deleted file mode 100644 index 3d2552ea8..000000000 --- a/OpenFAST/modules/supercontroller/README.md +++ /dev/null @@ -1,5 +0,0 @@ -# SuperController Module - -## Overview -This is a pseudo module used to couple OpenFAST with SuperController; -it is considered part of the OpenFAST glue code diff --git a/OpenFAST/modules/supercontroller/src/SCDataEx_Types.f90 b/OpenFAST/modules/supercontroller/src/SCDataEx_Types.f90 deleted file mode 100644 index 87f9b8325..000000000 --- a/OpenFAST/modules/supercontroller/src/SCDataEx_Types.f90 +++ /dev/null @@ -1,1257 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'SCDataEx_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 -!********************************************************************************************************************************* -! SCDataEx_Types -!................................................................................................................................. -! This file is part of SCDataEx. -! -! 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 SCDataEx. 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 SCDataEx_Types -!--------------------------------------------------------------------------------------------------------------------------------- -!USE, INTRINSIC :: ISO_C_Binding -USE NWTC_Library -IMPLICIT NONE -! ========= SC_DX_InitInputType_C ======= - TYPE, BIND(C) :: SC_DX_InitInputType_C - TYPE(C_PTR) :: object = C_NULL_PTR - INTEGER(KIND=C_INT) :: NumSC2Ctrl - INTEGER(KIND=C_INT) :: NumSC2CtrlGlob - INTEGER(KIND=C_INT) :: NumCtrl2SC - END TYPE SC_DX_InitInputType_C - TYPE, PUBLIC :: SC_DX_InitInputType - TYPE( SC_DX_InitInputType_C ) :: C_obj - INTEGER(IntKi) :: NumSC2Ctrl !< number of turbine specific controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumSC2CtrlGlob !< number of global controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumCtrl2SC !< number of controller outputs [to supercontroller] [-] - END TYPE SC_DX_InitInputType -! ======================= -! ========= SC_DX_InitOutputType_C ======= - TYPE, BIND(C) :: SC_DX_InitOutputType_C - TYPE(C_PTR) :: object = C_NULL_PTR - END TYPE SC_DX_InitOutputType_C - TYPE, PUBLIC :: SC_DX_InitOutputType - TYPE( SC_DX_InitOutputType_C ) :: C_obj - TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - END TYPE SC_DX_InitOutputType -! ======================= -! ========= SC_DX_ParameterType_C ======= - TYPE, BIND(C) :: SC_DX_ParameterType_C - TYPE(C_PTR) :: object = C_NULL_PTR - LOGICAL(KIND=C_BOOL) :: useSC - END TYPE SC_DX_ParameterType_C - TYPE, PUBLIC :: SC_DX_ParameterType - TYPE( SC_DX_ParameterType_C ) :: C_obj - LOGICAL :: useSC = .FALSE. !< Flag that tells this module if supercontroller is on. [-] - END TYPE SC_DX_ParameterType -! ======================= -! ========= SC_DX_InputType_C ======= - TYPE, BIND(C) :: SC_DX_InputType_C - TYPE(C_PTR) :: object = C_NULL_PTR - TYPE(C_ptr) :: toSC = C_NULL_PTR - INTEGER(C_int) :: toSC_Len = 0 - END TYPE SC_DX_InputType_C - TYPE, PUBLIC :: SC_DX_InputType - TYPE( SC_DX_InputType_C ) :: C_obj - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: toSC => NULL() !< inputs to the super controller (from the turbine controller) [-] - END TYPE SC_DX_InputType -! ======================= -! ========= SC_DX_OutputType_C ======= - TYPE, BIND(C) :: SC_DX_OutputType_C - TYPE(C_PTR) :: object = C_NULL_PTR - TYPE(C_ptr) :: fromSC = C_NULL_PTR - INTEGER(C_int) :: fromSC_Len = 0 - TYPE(C_ptr) :: fromSCglob = C_NULL_PTR - INTEGER(C_int) :: fromSCglob_Len = 0 - END TYPE SC_DX_OutputType_C - TYPE, PUBLIC :: SC_DX_OutputType - TYPE( SC_DX_OutputType_C ) :: C_obj - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: fromSC => NULL() !< global outputs of the super controller (to the turbine controller) [-] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: fromSCglob => NULL() !< turbine specific outputs of the super controller (to the turbine controller) [-] - END TYPE SC_DX_OutputType -! ======================= -CONTAINS - SUBROUTINE SC_DX_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_DX_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(SC_DX_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%NumSC2Ctrl = SrcInitInputData%NumSC2Ctrl - DstInitInputData%C_obj%NumSC2Ctrl = SrcInitInputData%C_obj%NumSC2Ctrl - DstInitInputData%NumSC2CtrlGlob = SrcInitInputData%NumSC2CtrlGlob - DstInitInputData%C_obj%NumSC2CtrlGlob = SrcInitInputData%C_obj%NumSC2CtrlGlob - DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC - DstInitInputData%C_obj%NumCtrl2SC = SrcInitInputData%C_obj%NumCtrl2SC - END SUBROUTINE SC_DX_CopyInitInput - - SUBROUTINE SC_DX_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(SC_DX_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyInitInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE SC_DX_DestroyInitInput - - SUBROUTINE SC_DX_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_DX_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl - Int_BufSz = Int_BufSz + 1 ! NumSC2CtrlGlob - Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2CtrlGlob - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SC_DX_PackInitInput - - SUBROUTINE SC_DX_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_DX_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl - OutData%NumSC2CtrlGlob = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob - OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC - END SUBROUTINE SC_DX_UnPackInitInput - - SUBROUTINE SC_DX_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%NumSC2Ctrl = InitInputData%C_obj%NumSC2Ctrl - InitInputData%NumSC2CtrlGlob = InitInputData%C_obj%NumSC2CtrlGlob - InitInputData%NumCtrl2SC = InitInputData%C_obj%NumCtrl2SC - END SUBROUTINE SC_DX_C2Fary_CopyInitInput - - SUBROUTINE SC_DX_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%C_obj%NumSC2Ctrl = InitInputData%NumSC2Ctrl - InitInputData%C_obj%NumSC2CtrlGlob = InitInputData%NumSC2CtrlGlob - InitInputData%C_obj%NumCtrl2SC = InitInputData%NumCtrl2SC - END SUBROUTINE SC_DX_F2C_CopyInitInput - - SUBROUTINE SC_DX_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_DX_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SC_DX_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE SC_DX_CopyInitOutput - - SUBROUTINE SC_DX_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(SC_DX_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyInitOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, ErrMsg ) - END SUBROUTINE SC_DX_DestroyInitOutput - - SUBROUTINE SC_DX_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_DX_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE SC_DX_PackInitOutput - - SUBROUTINE SC_DX_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_DX_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE SC_DX_UnPackInitOutput - - SUBROUTINE SC_DX_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - END SUBROUTINE SC_DX_C2Fary_CopyInitOutput - - SUBROUTINE SC_DX_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - END SUBROUTINE SC_DX_F2C_CopyInitOutput - - SUBROUTINE SC_DX_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_DX_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SC_DX_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%useSC = SrcParamData%useSC - DstParamData%C_obj%useSC = SrcParamData%C_obj%useSC - END SUBROUTINE SC_DX_CopyParam - - SUBROUTINE SC_DX_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(SC_DX_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyParam' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE SC_DX_DestroyParam - - SUBROUTINE SC_DX_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_DX_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! useSC - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = TRANSFER(InData%useSC, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SC_DX_PackParam - - SUBROUTINE SC_DX_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_DX_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%useSC = TRANSFER(IntKiBuf(Int_Xferred), OutData%useSC) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%useSC = OutData%useSC - END SUBROUTINE SC_DX_UnPackParam - - SUBROUTINE SC_DX_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%useSC = ParamData%C_obj%useSC - END SUBROUTINE SC_DX_C2Fary_CopyParam - - SUBROUTINE SC_DX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%C_obj%useSC = ParamData%useSC - END SUBROUTINE SC_DX_F2C_CopyParam - - SUBROUTINE SC_DX_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_DX_InputType), INTENT(IN) :: SrcInputData - TYPE(SC_DX_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcInputData%toSC)) THEN - i1_l = LBOUND(SrcInputData%toSC,1) - i1_u = UBOUND(SrcInputData%toSC,1) - IF (.NOT. ASSOCIATED(DstInputData%toSC)) THEN - ALLOCATE(DstInputData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%toSC_Len = SIZE(DstInputData%toSC) - IF (DstInputData%c_obj%toSC_Len > 0) & - DstInputData%c_obj%toSC = C_LOC( DstInputData%toSC(i1_l) ) - END IF - DstInputData%toSC = SrcInputData%toSC -ENDIF - END SUBROUTINE SC_DX_CopyInput - - SUBROUTINE SC_DX_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(SC_DX_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(InputData%toSC)) THEN - DEALLOCATE(InputData%toSC) - InputData%toSC => NULL() - InputData%C_obj%toSC = C_NULL_PTR - InputData%C_obj%toSC_Len = 0 -ENDIF - END SUBROUTINE SC_DX_DestroyInput - - SUBROUTINE SC_DX_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_DX_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! toSC allocated yes/no - IF ( ASSOCIATED(InData%toSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! toSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%toSC) ! toSC - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%toSC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%toSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%toSC,1), UBOUND(InData%toSC,1) - ReKiBuf(Re_Xferred) = InData%toSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_DX_PackInput - - SUBROUTINE SC_DX_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_DX_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! toSC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%toSC)) DEALLOCATE(OutData%toSC) - ALLOCATE(OutData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%toSC_Len = SIZE(OutData%toSC) - IF (OutData%c_obj%toSC_Len > 0) & - OutData%c_obj%toSC = C_LOC( OutData%toSC(i1_l) ) - DO i1 = LBOUND(OutData%toSC,1), UBOUND(OutData%toSC,1) - OutData%toSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_DX_UnPackInput - - SUBROUTINE SC_DX_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- toSC Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%toSC ) ) THEN - NULLIFY( InputData%toSC ) - ELSE - CALL C_F_POINTER(InputData%C_obj%toSC, InputData%toSC, (/InputData%C_obj%toSC_Len/)) - END IF - END IF - END SUBROUTINE SC_DX_C2Fary_CopyInput - - SUBROUTINE SC_DX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- toSC Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%toSC)) THEN - InputData%c_obj%toSC_Len = 0 - InputData%c_obj%toSC = C_NULL_PTR - ELSE - InputData%c_obj%toSC_Len = SIZE(InputData%toSC) - IF (InputData%c_obj%toSC_Len > 0) & - InputData%c_obj%toSC = C_LOC( InputData%toSC( LBOUND(InputData%toSC,1) ) ) - END IF - END IF - END SUBROUTINE SC_DX_F2C_CopyInput - - SUBROUTINE SC_DX_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_DX_OutputType), INTENT(IN) :: SrcOutputData - TYPE(SC_DX_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcOutputData%fromSC)) THEN - i1_l = LBOUND(SrcOutputData%fromSC,1) - i1_u = UBOUND(SrcOutputData%fromSC,1) - IF (.NOT. ASSOCIATED(DstOutputData%fromSC)) THEN - ALLOCATE(DstOutputData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%c_obj%fromSC_Len = SIZE(DstOutputData%fromSC) - IF (DstOutputData%c_obj%fromSC_Len > 0) & - DstOutputData%c_obj%fromSC = C_LOC( DstOutputData%fromSC(i1_l) ) - END IF - DstOutputData%fromSC = SrcOutputData%fromSC -ENDIF -IF (ASSOCIATED(SrcOutputData%fromSCglob)) THEN - i1_l = LBOUND(SrcOutputData%fromSCglob,1) - i1_u = UBOUND(SrcOutputData%fromSCglob,1) - IF (.NOT. ASSOCIATED(DstOutputData%fromSCglob)) THEN - ALLOCATE(DstOutputData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%fromSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%c_obj%fromSCglob_Len = SIZE(DstOutputData%fromSCglob) - IF (DstOutputData%c_obj%fromSCglob_Len > 0) & - DstOutputData%c_obj%fromSCglob = C_LOC( DstOutputData%fromSCglob(i1_l) ) - END IF - DstOutputData%fromSCglob = SrcOutputData%fromSCglob -ENDIF - END SUBROUTINE SC_DX_CopyOutput - - SUBROUTINE SC_DX_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(SC_DX_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(OutputData%fromSC)) THEN - DEALLOCATE(OutputData%fromSC) - OutputData%fromSC => NULL() - OutputData%C_obj%fromSC = C_NULL_PTR - OutputData%C_obj%fromSC_Len = 0 -ENDIF -IF (ASSOCIATED(OutputData%fromSCglob)) THEN - DEALLOCATE(OutputData%fromSCglob) - OutputData%fromSCglob => NULL() - OutputData%C_obj%fromSCglob = C_NULL_PTR - OutputData%C_obj%fromSCglob_Len = 0 -ENDIF - END SUBROUTINE SC_DX_DestroyOutput - - SUBROUTINE SC_DX_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_DX_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! fromSC allocated yes/no - IF ( ASSOCIATED(InData%fromSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSC) ! fromSC - END IF - Int_BufSz = Int_BufSz + 1 ! fromSCglob allocated yes/no - IF ( ASSOCIATED(InData%fromSCglob) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSCglob upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSCglob) ! fromSCglob - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%fromSC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSC,1), UBOUND(InData%fromSC,1) - ReKiBuf(Re_Xferred) = InData%fromSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%fromSCglob) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSCglob,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSCglob,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSCglob,1), UBOUND(InData%fromSCglob,1) - ReKiBuf(Re_Xferred) = InData%fromSCglob(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_DX_PackOutput - - SUBROUTINE SC_DX_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_DX_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%fromSC)) DEALLOCATE(OutData%fromSC) - ALLOCATE(OutData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%fromSC_Len = SIZE(OutData%fromSC) - IF (OutData%c_obj%fromSC_Len > 0) & - OutData%c_obj%fromSC = C_LOC( OutData%fromSC(i1_l) ) - DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) - OutData%fromSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSCglob not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%fromSCglob)) DEALLOCATE(OutData%fromSCglob) - ALLOCATE(OutData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%fromSCglob_Len = SIZE(OutData%fromSCglob) - IF (OutData%c_obj%fromSCglob_Len > 0) & - OutData%c_obj%fromSCglob = C_LOC( OutData%fromSCglob(i1_l) ) - DO i1 = LBOUND(OutData%fromSCglob,1), UBOUND(OutData%fromSCglob,1) - OutData%fromSCglob(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_DX_UnPackOutput - - SUBROUTINE SC_DX_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- fromSC Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSC ) ) THEN - NULLIFY( OutputData%fromSC ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%fromSC, OutputData%fromSC, (/OutputData%C_obj%fromSC_Len/)) - END IF - END IF - - ! -- fromSCglob Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSCglob ) ) THEN - NULLIFY( OutputData%fromSCglob ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%fromSCglob, OutputData%fromSCglob, (/OutputData%C_obj%fromSCglob_Len/)) - END IF - END IF - END SUBROUTINE SC_DX_C2Fary_CopyOutput - - SUBROUTINE SC_DX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- fromSC Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%fromSC)) THEN - OutputData%c_obj%fromSC_Len = 0 - OutputData%c_obj%fromSC = C_NULL_PTR - ELSE - OutputData%c_obj%fromSC_Len = SIZE(OutputData%fromSC) - IF (OutputData%c_obj%fromSC_Len > 0) & - OutputData%c_obj%fromSC = C_LOC( OutputData%fromSC( LBOUND(OutputData%fromSC,1) ) ) - END IF - END IF - - ! -- fromSCglob Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%fromSCglob)) THEN - OutputData%c_obj%fromSCglob_Len = 0 - OutputData%c_obj%fromSCglob = C_NULL_PTR - ELSE - OutputData%c_obj%fromSCglob_Len = SIZE(OutputData%fromSCglob) - IF (OutputData%c_obj%fromSCglob_Len > 0) & - OutputData%c_obj%fromSCglob = C_LOC( OutputData%fromSCglob( LBOUND(OutputData%fromSCglob,1) ) ) - END IF - END IF - END SUBROUTINE SC_DX_F2C_CopyOutput - -END MODULE SCDataEx_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/OpenFAST/modules/supercontroller/src/SCDataEx_Types.h b/OpenFAST/modules/supercontroller/src/SCDataEx_Types.h deleted file mode 100644 index 8be949b34..000000000 --- a/OpenFAST/modules/supercontroller/src/SCDataEx_Types.h +++ /dev/null @@ -1,57 +0,0 @@ -//!STARTOFREGISTRYGENERATEDFILE 'SCDataEx_Types.h' -//! -//! WARNING This file is generated automatically by the FAST registry. -//! Do not edit. Your changes to this file will be lost. -//! - -#ifndef _SCDataEx_TYPES_H -#define _SCDataEx_TYPES_H - - -#ifdef _WIN32 //define something for Windows (32-bit) -# include "stdbool.h" -# define CALL __declspec( dllexport ) -#elif _WIN64 //define something for Windows (64-bit) -# include "stdbool.h" -# define CALL __declspec( dllexport ) -#else -# include -# define CALL -#endif - - - typedef struct SC_DX_InitInputType { - void * object ; - int NumSC2Ctrl ; - int NumSC2CtrlGlob ; - int NumCtrl2SC ; - } SC_DX_InitInputType_t ; - typedef struct SC_DX_InitOutputType { - void * object ; - - } SC_DX_InitOutputType_t ; - typedef struct SC_DX_ParameterType { - void * object ; - bool useSC ; - } SC_DX_ParameterType_t ; - typedef struct SC_DX_InputType { - void * object ; - float * toSC ; int toSC_Len ; - } SC_DX_InputType_t ; - typedef struct SC_DX_OutputType { - void * object ; - float * fromSC ; int fromSC_Len ; - float * fromSCglob ; int fromSCglob_Len ; - } SC_DX_OutputType_t ; - typedef struct SC_DX_UserData { - SC_DX_InitInputType_t SC_DX_InitInput ; - SC_DX_InitOutputType_t SC_DX_InitOutput ; - SC_DX_ParameterType_t SC_DX_Param ; - SC_DX_InputType_t SC_DX_Input ; - SC_DX_OutputType_t SC_DX_Output ; - } SC_DX_t ; - -#endif // _SCDataEx_TYPES_H - - -//!ENDOFREGISTRYGENERATEDFILE diff --git a/OpenFAST/modules/supercontroller/src/SC_DLL.F90 b/OpenFAST/modules/supercontroller/src/SC_DLL.F90 deleted file mode 100644 index 7d138a376..000000000 --- a/OpenFAST/modules/supercontroller/src/SC_DLL.F90 +++ /dev/null @@ -1,323 +0,0 @@ - -!subroutine sc_init_obfuscator() -! -! CALL RANDOM_SEED ( SIZE = 1 ) -! CALL RANDOM_SEED ( PUT=3459872 ) -! -!end subroutine sc_init_obfuscator - - - -!======================================================================= -!SUBROUTINE sc_init ( ) BIND (C, NAME='sc_init') -!subroutine sc_init ( nTurbines, nInpGlobal, NumCtrl2SC, NumParamGlobal, ParamGlobal, NumParamTurbine, & -! ParamTurbine, NumStatesGlobal, NumStatesTurbine, NumSC2CtrlGlob, & -! NumSC2Ctrl, errStat, errMsg ) bind (C, NAME='sc_init') -subroutine sc_init ( nTurbines, nInpGlobal, NumCtrl2SC, NumParamGlobal, NumParamTurbine, & - NumStatesGlobal, NumStatesTurbine, NumSC2CtrlGlob, & - NumSC2Ctrl, errStat, errMsg ) bind (C, NAME='sc_init') -!subroutine sc_init ( t, nTurbines, nInpGlobal, to_SCglob, NumCtrl2SC, to_SC, & -! nStatesGlobal, StatesGlob, nStatesTurbine, StatesTurbine, NumSC2CtrlGlob, from_SCglob, & -! NumSC2Ctrl, from_SC, errStat, errMsg ) bind (C, NAME='sc_calcOutputs') - - - ! This DLL super controller is used to implement a ... - - ! Modified by B. Jonkman to conform to ISO C Bindings (standard Fortran 2003) and - ! compile with either gfortran or Intel Visual Fortran (IVF) - ! DO NOT REMOVE or MODIFY LINES starting with "!DEC$" or "!GCC$" - ! !DEC$ specifies attributes for IVF and !GCC$ specifies attributes for gfortran - ! - ! Note that gfortran v5.x on Mac produces compiler errors with the DLLEXPORT attribute, - ! so I've added the compiler directive IMPLICIT_DLLEXPORT. - - use, intrinsic :: ISO_C_Binding - - implicit none -#ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: sc_init -!GCC$ ATTRIBUTES DLLEXPORT :: sc_init -#endif - integer(C_INT), intent(in ) :: nTurbines !< number of turbines connected to this supercontroller - integer(C_INT), intent( out) :: nInpGlobal !< number of global inputs to supercontroller - integer(C_INT), intent( out) :: NumCtrl2SC !< number of turbine controller outputs [inputs to supercontroller] - integer(C_INT), intent( out) :: NumParamGlobal !< number of global parameters - integer(C_INT), intent( out) :: NumParamTurbine !< number of parameters per turbine - integer(C_INT), intent( out) :: NumStatesGlobal !< number of global states - integer(C_INT), intent( out) :: NumStatesTurbine !< number of states per turbine - integer(C_INT), intent( out) :: NumSC2CtrlGlob !< number of global controller inputs [from supercontroller] - integer(C_INT), intent( out) :: NumSC2Ctrl !< number of turbine specific controller inputs [output from supercontroller] - integer(C_INT), intent( out) :: errStat !< error status code (uses NWTC_Library error codes) - character(kind=C_CHAR), intent(inout) :: errMsg (*) !< Error Message from DLL to simulation code - - !errMsg = TRANSFER( TRIM(avcMSG)//C_NULL_CHAR, avcMSG, SIZE(avcMSG) ) - errStat = 0 - !errMsg = '' - - nInpGlobal = 0 - NumCtrl2SC = 2 - NumParamGlobal = 5 - NumParamTurbine = 4 - NumStatesGlobal = 1 - NumStatesTurbine = 2 - NumSC2CtrlGlob = 2 - NumSC2Ctrl = 3 - - - return - - end subroutine sc_init -subroutine sc_getInitData(nTurbines, NumParamGlobal, NumParamTurbine, ParamGlobal, ParamTurbine, & - NumSC2CtrlGlob, from_SCglob, NumSC2Ctrl, from_SC,& - & nStatesGlobal, StatesGlob, nStatesTurbine, StatesTurbine,& - & errStat, errMsg ) bind (C, NAME='sc_getInitData') -use, intrinsic :: ISO_C_Binding - - implicit none -#ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: sc_getInitData -!GCC$ ATTRIBUTES DLLEXPORT :: sc_getInitData -#endif - integer(C_INT), intent(in ) :: nTurbines !< number of turbines connected to this supercontroller - integer(C_INT), intent(in ) :: NumParamGlobal !< number of global parameters - integer(C_INT), intent(in ) :: NumParamTurbine !< number of parameters per turbine - real(C_FLOAT), intent(inout) :: ParamGlobal (*) !< global parameters - real(C_FLOAT), intent(inout) :: ParamTurbine (*) !< turbine-based parameters - integer(C_INT), intent(in ) :: NumSC2CtrlGlob !< number of global controller inputs [from supercontroller] - real(C_FLOAT), intent(inout) :: from_SCglob (*) !< global outputs of the super controller (to the turbine controller) - integer(C_INT), intent(in ) :: NumSC2Ctrl !< number of turbine specific controller inputs [output from supercontroller] - real(C_FLOAT), intent(inout) :: from_SC (*) !< turbine specific outputs of the super controller (to the turbine controller) - integer(C_INT), intent(in ) :: nStatesGlobal !< number of global states - real(C_FLOAT), intent(inout) :: StatesGlob (*) !< global states at time increment, n=0 (total of nStatesGlobal of these states) - integer(C_INT), intent(in ) :: nStatesTurbine !< number of states per turbine - real(C_FLOAT), intent(inout) :: StatesTurbine(*) !< turbine-dependent states at time increment, n=0 (total of nTurbines*nStatesTurbine of these states) - - integer(C_INT), intent(inout) :: errStat !< error status code (uses NWTC_Library error codes) - character(kind=C_CHAR), intent(inout) :: errMsg (*) !< Error Message from DLL to simulation code - integer :: i,j - real(C_FLOAT), allocatable :: mask1(:) - integer :: seedVal(1), nSeeds - - ! Add a data obfuscator for your proprietary Parameter data - - - - !nSeeds = 1 - !seedVal(1) = 3459872 - !call random_seed ( size = nSeeds ) - !call random_seed ( put = seedVal ) - !allocate(mask1(NumParamGlobal), stat = errStat) - !call random_number( mask1 ) - do i = 1, NumParamGlobal - ParamGlobal(i) = real(0.6,C_FLOAT) !real(i*mask1(i),C_FLOAT) - end do - - do j = 1, nTurbines - do i = 1, NumParamTurbine - ParamTurbine((j-1)*NumParamTurbine+i) = real((j-1)*NumParamTurbine+i,C_FLOAT) - end do - end do - - do i = 1, NumSC2CtrlGlob - from_SCglob(i) = real(i,C_FLOAT) !real(i*mask1(i),C_FLOAT) - end do - - do j = 1, nTurbines - do i = 1, NumSC2Ctrl - from_SC((j-1)*NumSC2Ctrl+i) = real((j-1)*NumSC2Ctrl+i,C_FLOAT) - end do - end do - - end subroutine sc_getInitData -!======================================================================= -!SUBROUTINE sc_calcOutputs ( ) BIND (C, NAME='sc_calcOutputs') -subroutine sc_calcOutputs ( t, nTurbines, nParamGlobal, paramGlobal, nParamTurbine, paramTurbine, nInpGlobal, to_SCglob, NumCtrl2SC, to_SC, & - nStatesGlobal, StatesGlob, nStatesTurbine, StatesTurbine, NumSC2CtrlGlob, from_SCglob, & - NumSC2Ctrl, from_SC, errStat, errMsg ) bind (C, NAME='sc_calcOutputs') - - - ! This DLL super controller is used to implement a ... - - ! Modified by B. Jonkman to conform to ISO C Bindings (standard Fortran 2003) and - ! compile with either gfortran or Intel Visual Fortran (IVF) - ! DO NOT REMOVE or MODIFY LINES starting with "!DEC$" or "!GCC$" - ! !DEC$ specifies attributes for IVF and !GCC$ specifies attributes for gfortran - ! - ! Note that gfortran v5.x on Mac produces compiler errors with the DLLEXPORT attribute, - ! so I've added the compiler directive IMPLICIT_DLLEXPORT. - - use, intrinsic :: ISO_C_Binding - - implicit none -#ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: sc_calcOutputs -!GCC$ ATTRIBUTES DLLEXPORT :: sc_calcOutputs -#endif - - real(C_DOUBLE), INTENT(IN ) :: t !< time (s) - integer(C_INT), intent(in ) :: nTurbines !< number of turbines connected to this supercontroller - integer(C_INT), intent(in ) :: nParamGlobal !< number of global parameters for the supercontroller - real(C_FLOAT), intent(in ) :: paramGlobal (*) !< global parameters for the supercontroller - integer(C_INT), intent(in ) :: nParamTurbine !< number of turbine-based parameters for supercontroller - real(C_FLOAT), intent(in ) :: paramTurbine (*) !< turbine-based parameters for the supercontroller - integer(C_INT), intent(in ) :: nInpGlobal !< number of global inputs to supercontroller - real(C_FLOAT), intent(in ) :: to_SCglob (*) !< global inputs to the supercontroller - integer(C_INT), intent(in ) :: NumCtrl2SC !< number of turbine controller outputs [inputs to supercontroller] - real(C_FLOAT), intent(in ) :: to_SC (*) !< inputs to the super controller (from the turbine controller) - integer(C_INT), intent(in ) :: nStatesGlobal !< number of global states - real(C_FLOAT), intent(in ) :: StatesGlob (*) !< global states at time increment, n (total of nStatesGlobal of these states) - integer(C_INT), intent(in ) :: nStatesTurbine !< number of states per turbine - real(C_FLOAT), intent(in ) :: StatesTurbine(*) !< turbine-dependent states at time increment, n (total of nTurbines*nStatesTurbine of these states) - integer(C_INT), intent(in ) :: NumSC2CtrlGlob !< number of global controller inputs [from supercontroller] - real(C_FLOAT), intent(inout) :: from_SCglob (*) !< global outputs of the super controller (to the turbine controller) - integer(C_INT), intent(in ) :: NumSC2Ctrl !< number of turbine specific controller inputs [output from supercontroller] - real(C_FLOAT), intent(inout) :: from_SC (*) !< turbine specific outputs of the super controller (to the turbine controller) - integer(C_INT), intent(inout) :: errStat !< error status code (uses NWTC_Library error codes) - character(kind=C_CHAR), intent(inout) :: errMsg (*) !< Error Message from DLL to simulation code - integer :: i, j, c - - ! For this demo control we have: - ! nInpGlobal = 0 - ! NumCtrl2SC = 2 - ! NumParamGlobal = 5 - ! NumParamTurbine = 4 - ! NumStatesGlobal = 1 - ! NumStatesTurbine = 2 - ! NumSC2CtrlGlob = 2 - ! NumSC2Ctrl = 3 - - !c = 1 - do j = 1, nTurbines - do i = 1, NumSC2Ctrl - from_SC((j-1)*NumSC2Ctrl+i) = (j-1)*NumSC2Ctrl+i! StatesTurbine(c) + StatesTurbine(c+2) - !from_SC((i-1)*NumSC2Ctrl+2) = StatesTurbine(c+1) + StatesTurbine(c+2) - !c = c+3 - end do - end do - - do i = 1, NumSC2CtrlGlob - from_SCglob(i) = StatesGlob(1) - end do - - !errMsg = TRANSFER( TRIM(avcMSG)//C_NULL_CHAR, avcMSG, SIZE(avcMSG) ) - return -end subroutine sc_calcOutputs - -!======================================================================= -!SUBROUTINE sc_updateStates ( ) BIND (C, NAME='sc_updateStates') -subroutine sc_updateStates ( t, nTurbines, nParamGlobal, paramGlobal, nParamTurbine, paramTurbine, nInpGlobal, to_SCglob, NumCtrl2SC, to_SC, & - nStatesGlobal, StatesGlob, nStatesTurbine, StatesTurbine, errStat, errMsg ) bind (C, NAME='sc_updateStates') - - - ! This DLL super controller is used to implement a ... - - ! Modified by B. Jonkman to conform to ISO C Bindings (standard Fortran 2003) and - ! compile with either gfortran or Intel Visual Fortran (IVF) - ! DO NOT REMOVE or MODIFY LINES starting with "!DEC$" or "!GCC$" - ! !DEC$ specifies attributes for IVF and !GCC$ specifies attributes for gfortran - ! - ! Note that gfortran v5.x on Mac produces compiler errors with the DLLEXPORT attribute, - ! so I've added the compiler directive IMPLICIT_DLLEXPORT. - - use, intrinsic :: ISO_C_Binding - - implicit none -#ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: sc_updateStates -!GCC$ ATTRIBUTES DLLEXPORT :: sc_updateStates -#endif - - real(C_DOUBLE), INTENT(IN ) :: t !< time (s) - integer(C_INT), intent(in ) :: nTurbines !< number of turbines connected to this supercontroller - integer(C_INT), intent(in ) :: nParamGlobal !< number of global parameters for the supercontroller - real(C_FLOAT), intent(in ) :: paramGlobal (*) !< global parameters for the supercontroller - integer(C_INT), intent(in ) :: nParamTurbine !< number of turbine-based parameters for supercontroller - real(C_FLOAT), intent(in ) :: paramTurbine (*) !< turbine-based parameters for the supercontroller - integer(C_INT), intent(in ) :: nInpGlobal !< number of global inputs to supercontroller - real(C_FLOAT), intent(in ) :: to_SCglob (*) !< global inputs to the supercontroller - integer(C_INT), intent(in ) :: NumCtrl2SC !< number of turbine controller outputs [inputs to supercontroller] - real(C_FLOAT), intent(in ) :: to_SC (*) !< inputs to the super controller (from the turbine controller) - integer(C_INT), intent(in ) :: nStatesGlobal !< number of global states - real(C_FLOAT), intent(inout) :: StatesGlob (*) !< global states at time increment, n (total of nStatesGlobal of these states) - integer(C_INT), intent(in ) :: nStatesTurbine !< number of states per turbine - real(C_FLOAT), intent(inout) :: StatesTurbine(*) !< turbine-dependent states at time increment, n (total of nTurbines*nStatesTurbine of these states) - integer(C_INT), intent(inout) :: errStat !< error status code (uses NWTC_Library error codes) - character(kind=C_CHAR), intent(inout) :: errMsg (*) !< Error Message from DLL to simulation code - integer :: i - real(C_FLOAT) :: sum - ! Turbine-based inputs (one per turbine): to_SC - ! 0 - Time - ! 1 - GenTorque - ! - ! Meaning of scOutputs - ! 0 - Minimum Blade pitch - - ! Update the turbine-related states - - ! For this demo control we have: - ! nInpGlobal = 0 - ! NumCtrl2SC = 2 - ! NumParamGlobal = 5 - ! NumParamTurbine = 4 - ! NumStatesGlobal = 1 - ! NumStatesTurbine = 2 - ! NumSC2CtrlGlob = 2 - ! NumSC2Ctrl = 3 - sum = 0.0 - do i = 1, nTurbines*nStatesTurbine - StatesTurbine(i) = i !paramGlobal(1)*to_SC(i)*paramTurbine(2*i-1) / paramTurbine(2*i) + (1-paramGlobal(1)*StatesTurbine(i)) - sum = sum + StatesTurbine(i) - end do - - do i = 1,nStatesGlobal - StatesGlob(i) = paramGlobal(2)*sum - end do - - !double d2R = M_PI/180.0; - ! Copy inputs into states first - !for(int iTurb=0; iTurb < nTurbines; iTurb++) { - ! for(int i=0; i < nScInputsTurbine; i++) { - ! turbineStates_np1[iTurb][i] = sc_inputsTurbine[iTurb][i]; - ! } - !} - ! - !turbineStates_np1[0][nScInputsTurbine] = sc_inputsTurbine[0][0]/60.0 * 0.2 * d2R ; - !turbineStates_np1[1][nScInputsTurbine] = sc_inputsTurbine[1][0]/60.0 * 0.45 * d2R ; - !errMsg = TRANSFER( TRIM(avcMSG)//C_NULL_CHAR, avcMSG, SIZE(avcMSG) ) - - return -end subroutine sc_updateStates - -subroutine sc_end ( errStat, errMsg ) bind (C, NAME='sc_end') - - - ! This DLL super controller is used to implement a ... - - ! Modified by B. Jonkman to conform to ISO C Bindings (standard Fortran 2003) and - ! compile with either gfortran or Intel Visual Fortran (IVF) - ! DO NOT REMOVE or MODIFY LINES starting with "!DEC$" or "!GCC$" - ! !DEC$ specifies attributes for IVF and !GCC$ specifies attributes for gfortran - ! - ! Note that gfortran v5.x on Mac produces compiler errors with the DLLEXPORT attribute, - ! so I've added the compiler directive IMPLICIT_DLLEXPORT. - - use, intrinsic :: ISO_C_Binding - - implicit none -#ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: sc_end -!GCC$ ATTRIBUTES DLLEXPORT :: sc_end -#endif - - integer(C_INT), intent(inout) :: errStat !< error status code (uses NWTC_Library error codes) - character(kind=C_CHAR), intent(inout) :: errMsg (*) !< Error Message from DLL to simulation code - - - - return -end subroutine sc_end - - - - - diff --git a/OpenFAST/modules/supercontroller/src/SC_DataEx.f90 b/OpenFAST/modules/supercontroller/src/SC_DataEx.f90 deleted file mode 100644 index f0a7ab05e..000000000 --- a/OpenFAST/modules/supercontroller/src/SC_DataEx.f90 +++ /dev/null @@ -1,192 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2015 National Renewable Energy Laboratory -! -! SuperController DataExchange, a submodule of openfast -! -! 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. -! -!********************************************************************************************************************************** -! File last committed: $Date: $ -! (File) Revision #: $Rev: $ -! URL: $HeadURL: $ -!********************************************************************************************************************************** -MODULE SC_DataEx - -! This is a pseudo module used to couple FAST v8 with SuperController; it is considered part of the FAST glue code - USE FAST_Types - USE SCDataEx_Types - - IMPLICIT NONE - - PRIVATE - - TYPE(ProgDesc), PARAMETER :: SC_DX_Ver = ProgDesc( 'SuperController DataExchange', '', '' ) - - -! ===================================================================================================" - - - ! ..... Public Subroutines ................................................................................................... - - PUBLIC :: SC_DX_Init ! Initialization routine - PUBLIC :: SC_DX_SetInputs ! Glue-code routine to update inputs for SuperController - PUBLIC :: SC_DX_SetOutputs ! Glue-code routine to update inputs to turbine controller from SuperController - - -CONTAINS -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE SC_DX_Init( NumSC2CtrlGlob, NumSC2Ctrl, NumCtrl2SC, SC_DX, ErrStat, ErrMsg ) -!.................................................................................................................................. - INTEGER(IntKi), INTENT(IN ) :: NumSC2CtrlGlob - INTEGER(IntKi), INTENT(IN ) :: NumSC2Ctrl - INTEGER(IntKi), INTENT(IN ) :: NumCtrl2SC - TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX ! data for the SuperController integration module - 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 of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_Init' - - ! Initialize variables - - ErrStat = ErrID_None - ErrMsg = "" - - IF (NumCtrl2SC > 0) THEN - CALL AllocPAry( SC_DX%u%toSC, NumCtrl2SC, 'u%toSC', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - IF (ErrStat >= AbortErrLev) RETURN - - ! make sure the C versions are synced with these arrays - if (NumCtrl2SC > 0) then - SC_DX%u%c_obj%toSC_Len = NumCtrl2SC - SC_DX%u%c_obj%toSC = C_LOC( SC_DX%u%toSC(1) ) - else - SC_DX%u%c_obj%toSC_Len = 0 - SC_DX%u%c_obj%toSC = C_NULL_PTR - end if - - - !............................................................................................ - ! Define system output initializations (set up mesh) here: - !............................................................................................ - if (NumSC2CtrlGlob > 0) then - CALL AllocPAry( SC_DX%y%fromSCglob, NumSC2CtrlGlob, 'y%fromSCglob', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if - - IF (ErrStat >= AbortErrLev) RETURN - - ! make sure the C versions are synced with these arrays - if (NumSC2CtrlGlob > 0) then - SC_DX%y%c_obj%fromSCglob_Len = NumSC2CtrlGlob - SC_DX%y%c_obj%fromSCglob = C_LOC( SC_DX%y%fromSCglob(1) ) - else - SC_DX%y%c_obj%fromSCglob_Len = 0 - SC_DX%y%c_obj%fromSCglob = C_NULL_PTR - end if - - if (NumSC2Ctrl > 0) then - CALL AllocPAry( SC_DX%y%fromSC, NumSC2Ctrl, 'y%fromSC', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if - - IF (ErrStat >= AbortErrLev) RETURN - - ! make sure the C versions are synced with these arrays - if (NumSC2Ctrl > 0) then - SC_DX%y%c_obj%fromSC_Len = NumSC2Ctrl - SC_DX%y%c_obj%fromSC = C_LOC( SC_DX%y%fromSC(1) ) - else - SC_DX%y%c_obj%fromSC_Len = 0 - SC_DX%y%c_obj%fromSC = C_NULL_PTR - end if - - if( (NumSC2CtrlGlob > 0) .or. (NumSC2Ctrl > 0) .or. (NumSC2Ctrl > 0)) then - SC_DX%p%UseSC = .true. - else - SC_DX%p%UseSC = .false. - end if - - RETURN - -END SUBROUTINE SC_DX_Init - -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE SC_DX_SetInputs(p_FAST, y_SrvD, SC_DX, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST ! Parameters for the glue code - TYPE(SrvD_OutputType), INTENT(IN) :: y_SrvD ! The outputs of the ServoDyn module (control) - TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX ! data for the SuperController integration module - 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 of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_SetInputs' - - - ErrStat = ErrID_None - ErrMsg = "" - - ! set SuperController inputs - if (SC_DX%p%UseSC) then - if (allocated(y_SrvD%toSC).and. associated(SC_DX%u%toSC)) SC_DX%u%toSC = y_SrvD%toSC - end if - - -END SUBROUTINE SC_DX_SetInputs -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE SC_DX_SetOutputs(p_FAST, u_SrvD, SC_DX, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST ! Parameters for the glue code - TYPE(SrvD_InputType), INTENT(INOUT) :: u_SrvD ! The inputs of the ServoDyn module (control) - TYPE(SCDataEx_Data), INTENT(IN ) :: SC_DX ! data for the SuperController integration module - 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 of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_SetOutputs' - - - ErrStat = ErrID_None - ErrMsg = "" - - ! set SuperController inputs - if (SC_DX%p%UseSC) then - if (allocated(u_SrvD%fromSC) .and. associated(SC_DX%y%fromSC)) u_SrvD%fromSC = SC_DX%y%fromSC - if (allocated(u_SrvD%fromSCglob).and. associated(SC_DX%y%fromSCglob)) u_SrvD%fromSCglob = SC_DX%y%fromSCglob - end if - - -END SUBROUTINE SC_DX_SetOutputs -!---------------------------------------------------------------------------------------------------------------------------------- -END MODULE SC_DataEx -!********************************************************************************************************************************** - - - - diff --git a/OpenFAST/modules/supercontroller/src/SC_DataEx_Registry.txt b/OpenFAST/modules/supercontroller/src/SC_DataEx_Registry.txt deleted file mode 100644 index d4b49aa31..000000000 --- a/OpenFAST/modules/supercontroller/src/SC_DataEx_Registry.txt +++ /dev/null @@ -1,36 +0,0 @@ -################################################################################################################################### -# Registry for SuperController DataExchange types in the FAST Modularization Framework -# Entries are of the form -# -# -# Use ^ as a shortcut for the value in the same column from the previous line. -################################################################################################################################### -# File last committed $Date$ -# (File) Revision #: $Rev$ -# URL: $HeadURL$ -################################################################################################################################### -# ...... Include files (definitions from NWTC Library) ............................................................................ -include Registry_NWTC_Library.txt - - - -# ..... SC_DX_InitInputType data ....................................................................................................... -typedef SCDataEx/SC_DX InitInputType IntKi NumSC2Ctrl - - - "number of turbine specific controller inputs [from supercontroller]" - -typedef ^ ^ IntKi NumSC2CtrlGlob - - - "number of global controller inputs [from supercontroller]" - -typedef ^ ^ IntKi NumCtrl2SC - - - "number of controller outputs [to supercontroller]" - - -# ..... SuperController_InitOutputType data ....................................................................................................... -# Define outputs from the initialization routine here: -typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - - -# ..... MiscVars ................................................................................................................ - -# ..... Parameters ................................................................................................................ -typedef SCDataEx/SC_DX ParameterType Logical useSC - .FALSE. - "Flag that tells this module if supercontroller is on." - - -# ..... SC_DX_InputType data ....................................................................................................... -typedef SCDataEx/SC_DX InputType ReKi toSC {:} - - "inputs to the super controller (from the turbine controller)" - - -# ..... SC_DX_OutputType data ....................................................................................................... -typedef SCDataEx/SC_DX OutputType ReKi fromSC {:} - - "global outputs of the super controller (to the turbine controller)" - -typedef SCDataEx/SC_DX OutputType ReKi fromSCglob {:} - - "turbine specific outputs of the super controller (to the turbine controller)" - diff --git a/OpenFAST/modules/supercontroller/src/SuperController.f90 b/OpenFAST/modules/supercontroller/src/SuperController.f90 deleted file mode 100644 index 52f427b3a..000000000 --- a/OpenFAST/modules/supercontroller/src/SuperController.f90 +++ /dev/null @@ -1,551 +0,0 @@ -!********************************************************************************************************************************** -!> ## SC -!! The SuperController module implements a super controller for the FAST.Farm code. -!! SuperController_Types will be auto-generated by the FAST registry program, based on the variables specified in the -!! SuperController_Registry.txt file. -!! -! .................................................................................................................................. -!! ## LICENSING -!! Copyright (C) 2017 National Renewable Energy Laboratory -!! -!! This file is part of FAST_Farm. -!! -!! 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. -!********************************************************************************************************************************** -module SuperController - - use SuperController_Types - use NWTC_Library - - implicit none - private - - type(ProgDesc), parameter :: SC_Ver = ProgDesc( 'Super Controller', '', '' ) - - !> Definition of the DLL Interface for the SuperController - !! - abstract interface - subroutine SC_DLL_Init_PROC ( nTurbines, nInpGlobal, NumCtrl2SC, NumParamGlobal, NumParamTurbine, NumStatesGlobal, NumStatesTurbine, NumSC2CtrlGlob, NumSC2Ctrl, errStat, errMsg ) BIND(C) - use, intrinsic :: ISO_C_Binding - integer(C_INT), intent(in ) :: nTurbines !< number of turbines connected to this supercontroller - integer(C_INT), intent( out) :: nInpGlobal !< number of global inputs to supercontroller - integer(C_INT), intent( out) :: NumCtrl2SC !< number of turbine controller outputs [inputs to supercontroller] - integer(C_INT), intent( out) :: NumParamGlobal !< number of global parameters - integer(C_INT), intent( out) :: NumParamTurbine !< number of parameters per turbine - integer(C_INT), intent( out) :: NumStatesGlobal !< number of global states - integer(C_INT), intent( out) :: NumStatesTurbine !< number of states per turbine - integer(C_INT), intent( out) :: NumSC2CtrlGlob !< number of global controller inputs [from supercontroller] - integer(C_INT), intent( out) :: NumSC2Ctrl !< number of turbine specific controller inputs [output from supercontroller] - integer(C_INT), intent( out) :: errStat !< error status code (uses NWTC_Library error codes) - character(kind=C_CHAR), intent(inout) :: errMsg (*) !< Error Message from DLL to simulation code - end subroutine SC_DLL_Init_PROC - end interface - -#ifdef STATIC_DLL_LOAD - interface - subroutine SC_DLL_Init ( nTurbines, nInpGlobal, NumCtrl2SC, NumParamGlobal, NumParamTurbine, NumStatesGlobal, NumStatesTurbine, NumSC2CtrlGlob, NumSC2Ctrl, errStat, errMsg ) BIND(C) - use, intrinsic :: ISO_C_Binding - integer(C_INT), intent(in ) :: nTurbines !< number of turbines connected to this supercontroller - integer(C_INT), intent( out) :: nInpGlobal !< number of global inputs to supercontroller - integer(C_INT), intent( out) :: NumCtrl2SC !< number of turbine controller outputs [inputs to supercontroller] - integer(C_INT), intent( out) :: NumParamGlobal !< number of global parameters - integer(C_INT), intent( out) :: NumParamTurbine !< number of parameters per turbine - integer(C_INT), intent( out) :: NumStatesGlobal !< number of global states - integer(C_INT), intent( out) :: NumStatesTurbine !< number of states per turbine - integer(C_INT), intent( out) :: NumSC2CtrlGlob !< number of global controller inputs [from supercontroller] - integer(C_INT), intent( out) :: NumSC2Ctrl !< number of turbine specific controller inputs [output from supercontroller] - integer(C_INT), intent( out) :: errStat !< error status code (uses NWTC_Library error codes) - character(kind=C_CHAR), intent(inout) :: errMsg (*) !< Error Message from DLL to simulation code - end subroutine SC_DLL_Init - end interface -#endif - - abstract interface - subroutine SC_DLL_GetInitData_PROC (nTurbines, NumParamGlobal, NumParamTurbine, ParamGlobal, ParamTurbine, NumSC2CtrlGlob, from_SCglob, NumSC2Ctrl, from_SC, nStatesGlobal, StatesGlob, nStatesTurbine, StatesTurbine, errStat, errMsg ) BIND(C) - use, intrinsic :: ISO_C_Binding - integer(C_INT), intent(in ) :: nTurbines !< number of turbines connected to this supercontroller - integer(C_INT), intent(in ) :: NumParamGlobal !< number of global parameters - integer(C_INT), intent(in ) :: NumParamTurbine !< number of parameters per turbine - real(C_FLOAT), intent(inout) :: ParamGlobal (*) !< global parameters - real(C_FLOAT), intent(inout) :: ParamTurbine (*) !< turbine-based parameters - integer(C_INT), intent(in ) :: NumSC2CtrlGlob !< number of global controller inputs [from supercontroller] - real(C_FLOAT), intent(inout) :: from_SCglob (*) !< global outputs of the super controller (to the turbine controller) - integer(C_INT), intent(in ) :: NumSC2Ctrl !< number of turbine specific controller inputs [output from supercontroller] - real(C_FLOAT), intent(inout) :: from_SC (*) !< turbine specific outputs of the super controller (to the turbine controller) - integer(C_INT), intent(in ) :: nStatesGlobal !< number of global states - real(C_FLOAT), intent(inout) :: StatesGlob (*) !< global states at time increment, n (total of nStatesGlobal of these states) - integer(C_INT), intent(in ) :: nStatesTurbine !< number of states per turbine - real(C_FLOAT), intent(inout) :: StatesTurbine(*) !< turbine-dependent states at time increment, n (total of nTurbines*nStatesTurbine of these states) - integer(C_INT), intent(inout) :: errStat !< error status code (uses NWTC_Library error codes) - character(kind=C_CHAR), intent(inout) :: errMsg (*) !< Error Message from DLL to simulation code - end subroutine SC_DLL_GetInitData_PROC - end interface - -#ifdef STATIC_DLL_LOAD - interface - subroutine SC_DLL_GetInitData ( nTurbines, NumParamGlobal, NumParamTurbine, ParamGlobal, ParamTurbine, NumSC2CtrlGlob, from_SCglob, NumSC2Ctrl, from_SC, nStatesGlobal, StatesGlob, nStatesTurbine, StatesTurbine, errStat, errMsg ) BIND(C) - use, intrinsic :: ISO_C_Binding - integer(C_INT), intent(in ) :: nTurbines !< number of turbines connected to this supercontroller - integer(C_INT), intent(in ) :: NumParamGlobal !< number of global parameters - integer(C_INT), intent(in ) :: NumParamTurbine !< number of parameters per turbine - real(C_FLOAT), intent(inout) :: ParamGlobal (*) !< global parameters - real(C_FLOAT), intent(inout) :: ParamTurbine (*) !< turbine-based parameters - integer(C_INT), intent(in ) :: NumSC2CtrlGlob !< number of global controller inputs [from supercontroller] - real(C_FLOAT), intent(inout) :: from_SCglob (*) !< global outputs of the super controller (to the turbine controller) - integer(C_INT), intent(in ) :: NumSC2Ctrl !< number of turbine specific controller inputs [output from supercontroller] - real(C_FLOAT), intent(inout) :: from_SC (*) !< turbine specific outputs of the super controller (to the turbine controller) - integer(C_INT), intent(in ) :: nStatesGlobal !< number of global states - real(C_FLOAT), intent(inout) :: StatesGlob (*) !< global states at time increment, n (total of nStatesGlobal of these states) - integer(C_INT), intent(in ) :: nStatesTurbine !< number of states per turbine - real(C_FLOAT), intent(inout) :: StatesTurbine(*) !< turbine-dependent states at time increment, n (total of nTurbines*nStatesTurbine of these states) - integer(C_INT), intent(inout) :: errStat !< error status code (uses NWTC_Library error codes) - character(kind=C_CHAR), intent(inout) :: errMsg (*) !< Error Message from DLL to simulation code - end subroutine SC_DLL_GetInitData - end interface -#endif - - - abstract interface - subroutine SC_DLL_CalcOutput_PROC ( t, nTurbines, NumParamGlobal, ParamGlobal, NumParamTurbine, ParamTurbine, nInpGlobal, to_SCglob, NumCtrl2SC, to_SC, & - nStatesGlobal, StatesGlob, nStatesTurbine, StatesTurbine, NumSC2CtrlGlob, from_SCglob, & - NumSC2Ctrl, from_SC, errStat, errMsg ) BIND(C) - use, intrinsic :: ISO_C_Binding - real(C_DOUBLE), INTENT(IN ) :: t !< time (s) - integer(C_INT), intent(in ) :: nTurbines !< number of turbines connected to this supercontroller - integer(C_INT), intent(in ) :: NumParamGlobal !< number of global parameters - real(C_FLOAT), intent(in ) :: ParamGlobal (*) !< global parameters - integer(C_INT), intent(in ) :: NumParamTurbine !< number of parameters per turbine - real(C_FLOAT), intent(in ) :: ParamTurbine (*) !< turbine-based parameters - integer(C_INT), intent(in ) :: nInpGlobal !< number of global inputs to supercontroller - real(C_FLOAT), intent(in ) :: to_SCglob (*) !< global inputs to the supercontroller - integer(C_INT), intent(in ) :: NumCtrl2SC !< number of turbine controller outputs [inputs to supercontroller] - real(C_FLOAT), intent(in ) :: to_SC (*) !< inputs to the super controller (from the turbine controller) - integer(C_INT), intent(in ) :: nStatesGlobal !< number of global states - real(C_FLOAT), intent(in ) :: StatesGlob (*) !< global states at time increment, n (total of nStatesGlobal of these states) - integer(C_INT), intent(in ) :: nStatesTurbine !< number of states per turbine - real(C_FLOAT), intent(in ) :: StatesTurbine(*) !< turbine-dependent states at time increment, n (total of nTurbines*nStatesTurbine of these states) - integer(C_INT), intent(in ) :: NumSC2CtrlGlob !< number of global controller inputs [from supercontroller] - real(C_FLOAT), intent(inout) :: from_SCglob (*) !< global outputs of the super controller (to the turbine controller) - integer(C_INT), intent(in ) :: NumSC2Ctrl !< number of turbine specific controller inputs [output from supercontroller] - real(C_FLOAT), intent(inout) :: from_SC (*) !< turbine specific outputs of the super controller (to the turbine controller) - integer(C_INT), intent(inout) :: errStat !< error status code (uses NWTC_Library error codes) - character(kind=C_CHAR), intent(inout) :: errMsg (*) !< Error Message from DLL to simulation code - end subroutine SC_DLL_CalcOutput_PROC - end interface - -#ifdef STATIC_DLL_LOAD - interface - subroutine SC_DLL_CalcOutput ( t, nTurbines, NumParamGlobal, ParamGlobal, NumParamTurbine, ParamTurbine, nInpGlobal, to_SCglob, NumCtrl2SC, to_SC, & - nStatesGlobal, StatesGlob, nStatesTurbine, StatesTurbine, NumSC2CtrlGlob, from_SCglob, & - NumSC2Ctrl, from_SC, errStat, errMsg ) BIND(C) - use, intrinsic :: ISO_C_Binding - real(C_DOUBLE), INTENT(IN ) :: t !< time (s) - integer(C_INT), intent(in ) :: nTurbines !< number of turbines connected to this supercontroller - integer(C_INT), intent(in ) :: NumParamGlobal !< number of global parameters - real(C_FLOAT), intent(in ) :: ParamGlobal (*) !< global parameters - integer(C_INT), intent(in ) :: NumParamTurbine !< number of parameters per turbine - real(C_FLOAT), intent(in ) :: ParamTurbine (*) !< turbine-based parameters - integer(C_INT), intent(in ) :: nInpGlobal !< number of global inputs to supercontroller - real(C_FLOAT), intent(in ) :: to_SCglob (*) !< global inputs to the supercontroller - integer(C_INT), intent(in ) :: NumCtrl2SC !< number of turbine controller outputs [inputs to supercontroller] - real(C_FLOAT), intent(in ) :: to_SC (*) !< inputs to the super controller (from the turbine controller) - integer(C_INT), intent(in ) :: nStatesGlobal !< number of global states - real(C_FLOAT), intent(in ) :: StatesGlob (*) !< global states at time increment, n (total of nStatesGlobal of these states) - integer(C_INT), intent(in ) :: nStatesTurbine !< number of states per turbine - real(C_FLOAT), intent(in ) :: StatesTurbine(*) !< turbine-dependent states at time increment, n (total of nTurbines*nStatesTurbine of these states) - integer(C_INT), intent(in ) :: NumSC2CtrlGlob !< number of global controller inputs [from supercontroller] - real(C_FLOAT), intent(inout) :: from_SCglob (*) !< global outputs of the super controller (to the turbine controller) - integer(C_INT), intent(in ) :: NumSC2Ctrl !< number of turbine specific controller inputs [output from supercontroller] - real(C_FLOAT), intent(inout) :: from_SC (*) !< turbine specific outputs of the super controller (to the turbine controller) - integer(C_INT), intent(inout) :: errStat !< error status code (uses NWTC_Library error codes) - character(kind=C_CHAR), intent(inout) :: errMsg (*) !< Error Message from DLL to simulation code - end subroutine SC_DLL_CalcOutput - end interface -#endif - -abstract interface - subroutine SC_DLL_UpdateStates_PROC ( t, nTurbines, NumParamGlobal, ParamGlobal, NumParamTurbine, ParamTurbine, nInpGlobal, to_SCglob, NumCtrl2SC, to_SC, & - nStatesGlobal, StatesGlob, nStatesTurbine, StatesTurbine, errStat, errMsg ) BIND(C) - use, intrinsic :: ISO_C_Binding - real(C_DOUBLE), INTENT(IN ) :: t !< time (s) - integer(C_INT), intent(in ) :: nTurbines !< number of turbines connected to this supercontroller - integer(C_INT), intent(in ) :: NumParamGlobal !< number of global parameters - real(C_FLOAT), intent(in ) :: ParamGlobal (*) !< global parameters - integer(C_INT), intent(in ) :: NumParamTurbine !< number of parameters per turbine - real(C_FLOAT), intent(in ) :: ParamTurbine (*) !< turbine-based parameters - integer(C_INT), intent(in ) :: nInpGlobal !< number of global inputs to supercontroller - real(C_FLOAT), intent(in ) :: to_SCglob (*) !< global inputs to the supercontroller - integer(C_INT), intent(in ) :: NumCtrl2SC !< number of turbine controller outputs [inputs to supercontroller] - real(C_FLOAT), intent(in ) :: to_SC (*) !< inputs to the super controller (from the turbine controller) - integer(C_INT), intent(in ) :: nStatesGlobal !< number of global states - real(C_FLOAT), intent(inout) :: StatesGlob (*) !< global states at time increment, n (total of nStatesGlobal of these states) - integer(C_INT), intent(in ) :: nStatesTurbine !< number of states per turbine - real(C_FLOAT), intent(inout) :: StatesTurbine(*) !< turbine-dependent states at time increment, n (total of nTurbines*nStatesTurbine of these states) - integer(C_INT), intent(inout) :: errStat !< error status code (uses NWTC_Library error codes) - character(kind=C_CHAR), intent(inout) :: errMsg (*) !< Error Message from DLL to simulation code - end subroutine SC_DLL_UpdateStates_PROC - end interface - -#ifdef STATIC_DLL_LOAD - interface - subroutine SC_DLL_UpdateStates ( t, nTurbines, NumParamGlobal, ParamGlobal, NumParamTurbine, ParamTurbine, nInpGlobal, to_SCglob, NumCtrl2SC, to_SC, & - nStatesGlobal, StatesGlob, nStatesTurbine, StatesTurbine, errStat, errMsg ) BIND(C) - use, intrinsic :: ISO_C_Binding - real(C_DOUBLE), INTENT(IN ) :: t !< time (s) - integer(C_INT), intent(in ) :: nTurbines !< number of turbines connected to this supercontroller - integer(C_INT), intent(in ) :: NumParamGlobal !< number of global parameters - real(C_FLOAT), intent(in ) :: ParamGlobal (*) !< global parameters - integer(C_INT), intent(in ) :: NumParamTurbine !< number of parameters per turbine - real(C_FLOAT), intent(in ) :: ParamTurbine (*) !< turbine-based parameters - integer(C_INT), intent(in ) :: nInpGlobal !< number of global inputs to supercontroller - real(C_FLOAT), intent(in ) :: to_SCglob (*) !< global inputs to the supercontroller - integer(C_INT), intent(in ) :: NumCtrl2SC !< number of turbine controller outputs [inputs to supercontroller] - real(C_FLOAT), intent(in ) :: to_SC (*) !< inputs to the super controller (from the turbine controller) - integer(C_INT), intent(in ) :: nStatesGlobal !< number of global states - real(C_FLOAT), intent(inout) :: StatesGlob (*) !< global states at time increment, n (total of nStatesGlobal of these states) - integer(C_INT), intent(in ) :: nStatesTurbine !< number of states per turbine - real(C_FLOAT), intent(inout) :: StatesTurbine(*) !< turbine-dependent states at time increment, n (total of nTurbines*nStatesTurbine of these states) - integer(C_INT), intent(inout) :: errStat !< error status code (uses NWTC_Library error codes) - character(kind=C_CHAR), intent(inout) :: errMsg (*) !< Error Message from DLL to simulation code - end subroutine SC_DLL_UpdateStates - end interface -#endif - - abstract interface - subroutine SC_DLL_End_PROC ( errStat, errMsg ) BIND(C) - use, intrinsic :: ISO_C_Binding - integer(C_INT), intent(inout) :: errStat !< error status code (uses NWTC_Library error codes) - character(kind=C_CHAR), intent(inout) :: errMsg (*) !< Error Message from DLL to simulation code - end subroutine SC_DLL_End_PROC - end interface - -#ifdef STATIC_DLL_LOAD - interface - subroutine SC_DLL_End ( errStat, errMsg ) BIND(C) - use, intrinsic :: ISO_C_Binding - integer(C_INT), intent(inout) :: errStat !< error status code (uses NWTC_Library error codes) - character(kind=C_CHAR), intent(inout) :: errMsg (*) !< Error Message from DLL to simulation code - end subroutine SC_DLL_End - end interface -#endif - public :: SC_Init ! Initialization routine - public :: SC_End ! Ending routine (includes clean up) - public :: SC_UpdateStates ! Loose coupling routine for solving for constraint states, integrating - ! continuous states, and updating discrete states - public :: SC_CalcOutput ! Routine for computing outputs - !public :: SC_CalcContStateDeriv ! Tight coupling routine for computing derivatives of continuous states - - - contains - - SUBROUTINE SC_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) - - TYPE(SC_InputType), INTENT(INOUT) :: u !< System inputs - TYPE(SC_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(SC_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states - TYPE(SC_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states - TYPE(SC_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states - TYPE(SC_OtherStateType), INTENT(INOUT) :: OtherState !< Other states - TYPE(SC_OutputType), INTENT(INOUT) :: y !< System outputs - TYPE(SC_MiscVarType), INTENT(INOUT) :: m !< Initial misc (optimization) variables - 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 = 'SC_End' - integer(IntKi) :: errStat2 ! The error status code - character(ErrMsgLen) :: errMsg2 ! The error message, if an error occurred - procedure(SC_DLL_End_PROC), pointer :: DLL_SC_Subroutine ! The address of the supercontroller sc_end procedure in the DLL - - errStat = ErrID_None - errMsg= '' - -#ifdef STATIC_DLL_LOAD - - ! if we're statically loading the library (i.e., OpenFOAM), we can just call DISCON(); - ! I'll leave some options for whether the supercontroller is being used - - call SC_DLL_End ( errStat, errMsg ) - -#else - - ! Call the DLL (first associate the address from the procedure in the DLL with the subroutine): - call C_F_PROCPOINTER( p%DLL_Trgt%ProcAddr(5), DLL_SC_Subroutine) - call DLL_SC_Subroutine ( errStat, errMsg ) - -#endif - - - call FreeDynamicLib( p%DLL_Trgt, errStat2, errMsg2 ) ! this doesn't do anything #ifdef STATIC_DLL_LOAD because p%DLL_Trgt is 0 (NULL) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, routineName ) - - end subroutine SC_End - - subroutine SC_Init(InitInp, u, p, x, xd, z, OtherState, y, m, interval, InitOut, errStat, errMsg ) - type(SC_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine - type(SC_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined - type(SC_ParameterType), intent( out) :: p !< Parameters - type(SC_ContinuousStateType), intent( out) :: x !< Initial continuous states - type(SC_DiscreteStateType), intent( out) :: xd !< Initial discrete states - type(SC_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states - type(SC_OtherStateType), intent( out) :: OtherState !< Initial other states - type(SC_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated; - !! only the output mesh is initialized) - type(SC_MiscVarType), intent( out) :: m !< Misc variables for optimization (not copied in glue code) - real(DbKi), intent(in ) :: interval !< Coupling interval in seconds - type(SC_InitOutputType), intent( out) :: InitOut !< Output for initialization routine - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(1024), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - - - ! local variables - character(*), parameter :: routineName = 'SC_Init' - integer(IntKi) :: errStat2 ! The error status code - character(ErrMsgLen) :: errMsg2 ! The error message, if an error occurred - procedure(SC_DLL_Init_PROC),pointer :: DLL_SC_Init_Subroutine ! The address of the supercontroller sc_init procedure in the DLL - procedure(SC_DLL_GetInitData_PROC),pointer :: DLL_SC_GetInitData_Subroutine - - integer(IntKi) :: nParams - - - errStat2 = ErrID_None - errMsg2 = '' - - call DispNVD( SC_Ver ) ! Display the version of this interface - - ! p%UseSC = InitInp%UseSC - ! if ( p%UseSC ) then - - ! The Glue code needs to tell the super controller how many turbines are in the plant/farm. - p%nTurbines = InitInp%nTurbines - - - - ! The following parameters are determined by the super controller implementation, which is done inside the shared - ! library, so first load the library. -#ifdef STATIC_DLL_LOAD - ! because OpenFOAM needs the MPI task to copy the library, we're not going to dynamically load it; it needs to be loaded at runtime. - p%DLL_Trgt%FileName = '' - p%DLL_Trgt%ProcName = '' -#else - - ! Define and load the DLL: - - p%DLL_Trgt%FileName = InitInp%DLL_FileName - - p%DLL_Trgt%ProcName = "" ! initialize all procedures to empty so we try to load only one - p%DLL_Trgt%ProcName(1) = 'sc_init' - p%DLL_Trgt%ProcName(2) = 'sc_getInitData' - p%DLL_Trgt%ProcName(3) = 'sc_updateStates' - p%DLL_Trgt%ProcName(4) = 'sc_calcOutputs' - p%DLL_Trgt%ProcName(5) = 'sc_end' - - call LoadDynamicLib ( p%DLL_Trgt, errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, routineName ) - if (errStat > AbortErrLev ) return -#endif - - ! Now that the library is loaded, call SC_Init() to obtain the user-specified inputs/output/states - - p%nInpGlobal = 0 - p%NumParamGlobal = 0 - p%NumParamTurbine = 0 - p%NumSC2CtrlGlob = 0 - p%NumSC2Ctrl = 0 - p%NumCtrl2SC = 0 - p%NumStatesGlobal = 0 - p%NumStatesTurbine = 0 - -#ifdef STATIC_DLL_LOAD - - ! if we're statically loading the library (i.e., OpenFOAM), we can just call SC_INIT(); - call SC_DLL_INIT( p%nTurbines, p%nInpGlobal, p%NumCtrl2SC, p%NumParamGlobal, p%NumParamTurbine, p%NumStatesGlobal, p%NumStatesTurbine, p%NumSC2CtrlGlob, p%NumSC2Ctrl, errStat, errMsg ) - ! TODO: Check errors -#else - - ! Call the DLL (first associate the address from the procedure in the DLL with the subroutine): - call C_F_PROCPOINTER( p%DLL_Trgt%ProcAddr(1), DLL_SC_Init_Subroutine) - !call DLL_SC_Subroutine ( p%nTurbines, p%nInpGlobal, p%NumCtrl2SC, p%NumParamGlobal, ParamGlobal, p%NumParamTurbine, ParamTurbine, p%NumStatesGlobal, p%NumStatesTurbine, p%NumSC2CtrlGlob, p%NumSC2Ctrl, errStat, errMsg ) - call DLL_SC_Init_Subroutine ( p%nTurbines, p%nInpGlobal, p%NumCtrl2SC, p%NumParamGlobal, p%NumParamTurbine, p%NumStatesGlobal, p%NumStatesTurbine, p%NumSC2CtrlGlob, p%NumSC2Ctrl, errStat, errMsg ) - ! TODO: Check errors - -#endif - - ! NOTE: For now we have not implemented the global super controller inputs in any of the openfast glue codes, - ! so the number must be set to zero - if (p%nInpGlobal /= 0) call SetErrStat( ErrID_Fatal, "nInpGlobal must to be equal to zero." , errStat, errMsg, RoutineName ) - if (p%NumSC2CtrlGlob < 0) call SetErrStat( ErrID_Fatal, "NumSC2CtrlGlob must to be greater than or equal to zero." , errStat, errMsg, RoutineName ) - if (p%NumSC2Ctrl < 0) call SetErrStat( ErrID_Fatal, "NumSC2Ctrl must to be greater than or equal to zero." , errStat, errMsg, RoutineName ) - if (p%NumCtrl2SC < 0) call SetErrStat( ErrID_Fatal, "NumCtrl2SC must to be greater than or equal to zero." , errStat, errMsg, RoutineName ) - if (p%NumStatesGlobal < 0) call SetErrStat( ErrID_Fatal, "NumStatesGlobal must to be greater than or equal to zero." , errStat, errMsg, RoutineName ) - if (p%NumStatesTurbine < 0) call SetErrStat( ErrID_Fatal, "NumStatesTurbine must to be greater than or equal to zero." , errStat, errMsg, RoutineName ) - - if (errStat > AbortErrLev ) return - - ! allocate state arrays - ! TODO Fix allocations for error handling - allocate(xd%Global(p%NumStatesGlobal)) - !CALL AllocAry( xd%Global, p%nStatesGlobal, 'xd%Global', errStat2, errMsg2 ) - ! call SetErrStat( errStat2, errMsg2, errStat, errMsg, routineName ) - allocate(xd%Turbine(p%NumStatesTurbine*p%nTurbines) ) - ! CALL AllocAry( xd%Turbine, p%nStatesTurbine, 'xd%Turbine', errStat2, errMsg2 ) - ! call SetErrStat( errStat2, errMsg2, errStat, errMsg, routineName ) - - ! allocate output arrays - allocate(y%fromSCglob(p%NumSC2CtrlGlob)) - allocate(y%fromSC (p%NumSC2Ctrl*p%nTurbines )) - - ! allocate input arrays - allocate(u%toSCglob(p%nInpGlobal)) - allocate(u%toSC (p%NumCtrl2SC*p%nTurbines)) - - ! Copy the Parameter and Output data created by the SuperController library into the FAST-framework parameters data structure - if ( (p%NumParamGlobal > 0) .or. (p%NumParamTurbine > 0) .or. (p%NumSC2CtrlGlob > 0) .or. (p%NumSC2Ctrl > 0) ) then - allocate(p%ParamGlobal(p%NumParamGlobal)) - nParams = p%NumParamTurbine*p%nTurbines - allocate(p%ParamTurbine(nParams)) - -#ifdef STATIC_DLL_LOAD - - ! if we're statically loading the library (i.e., OpenFOAM), we can just call SC_INIT(); - call SC_DLL_GetInitData( p%nTurbines, p%NumParamGlobal, p%NumParamTurbine, p%ParamGlobal, p%ParamTurbine, p%NumSC2CtrlGlob, y%fromSCglob, p%NumSC2Ctrl, y%fromSC, & - p%NumStatesGlobal, xd%Global, p%NumStatesTurbine, xd%Turbine, errStat, errMsg ) - ! TODO: Check errors -#else - - ! Call the DLL (first associate the address from the procedure in the DLL with the subroutine): - call C_F_PROCPOINTER( p%DLL_Trgt%ProcAddr(2), DLL_SC_GetInitData_Subroutine) - !call DLL_SC_Subroutine ( p%nTurbines, p%nInpGlobal, p%NumCtrl2SC, p%NumParamGlobal, ParamGlobal, p%NumParamTurbine, ParamTurbine, p%NumStatesGlobal, p%NumStatesTurbine, p%NumSC2CtrlGlob, p%NumSC2Ctrl, errStat, errMsg ) - call DLL_SC_GetInitData_Subroutine ( p%nTurbines, p%NumParamGlobal, p%NumParamTurbine, p%ParamGlobal, p%ParamTurbine, p%NumSC2CtrlGlob, y%fromSCglob, p%NumSC2Ctrl, y%fromSC, & - p%NumStatesGlobal, xd%Global, p%NumStatesTurbine, xd%Turbine, errStat, errMsg ) - ! TODO: Check errors - -#endif - - end if !IDEALLY THROW AN ERROR AND QUIT HERE IF THIS CRITERIA IS NOT MET - - p%DT = interval - - - ! Set the initialization output data for the glue code so that it knows - ! how many inputs/outputs there are - InitOut%nInpGlobal = p%nInpGlobal - InitOut%NumSC2CtrlGlob = p%NumSC2CtrlGlob - InitOut%NumSC2Ctrl = p%NumSC2Ctrl - InitOut%NumCtrl2SC = p%NumCtrl2SC - ! - - end subroutine SC_Init - - subroutine SC_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, errStat, errMsg ) - real(DbKi), intent(in ) :: t !< Current simulation time in seconds - type(SC_InputType), intent(in ) :: u !< Inputs at Time t - type(SC_ParameterType), intent(in ) :: p !< Parameters - type(SC_ContinuousStateType), intent(in ) :: x !< Continuous states at t - type(SC_DiscreteStateType), intent(in ) :: xd !< Discrete states at t - type(SC_ConstraintStateType), intent(in ) :: z !< Constraint states at t - type(SC_OtherStateType), intent(in ) :: OtherState !< Other states - type(SC_OutputType), intent(inout) :: y !< Outputs computed at t (Input only so that mesh con- - !! nectivity information does not have to be recalculated) - type(SC_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - - - character(*), parameter :: routineName = 'SC_CalcOutput' - integer(IntKi) :: errStat2 ! The error status code - character(ErrMsgLen) :: errMsg2 ! The error message, if an error occurred - procedure(SC_DLL_CalcOutput_PROC),pointer :: DLL_SC_Subroutine ! The address of the supercontroller sc_calcoutputs procedure in the DLL - - - errStat2 = ErrID_None - errMsg2 = '' - - -#ifdef STATIC_DLL_LOAD - - ! if we're statically loading the library (i.e., OpenFOAM), we can just call DISCON(); - ! I'll leave some options for whether the supercontroller is being used - - call SC_DLL_CalcOutput ( REAL(t,C_DOUBLE), p%nTurbines, p%NumParamGlobal, p%ParamGlobal, p%NumParamTurbine, p%ParamTurbine, p%nInpGlobal, u%toSCglob, p%NumCtrl2SC, u%toSC, & - p%nStatesGlobal, xd%Global, p%nStatesTurbine, xd%Turbine, p%NumSC2CtrlGlob, y%fromSCglob, & - p%NumSC2Ctrl, y%fromSC, errStat, errMsg ) - -#else - - ! Call the DLL (first associate the address from the procedure in the DLL with the subroutine): - call C_F_PROCPOINTER( p%DLL_Trgt%ProcAddr(4), DLL_SC_Subroutine) - call DLL_SC_Subroutine ( REAL(t,C_DOUBLE), p%nTurbines, p%NumParamGlobal, p%ParamGlobal, p%NumParamTurbine, p%ParamTurbine, p%nInpGlobal, u%toSCglob, p%NumCtrl2SC, u%toSC, & - p%NumStatesGlobal, xd%Global, p%NumStatesTurbine, xd%Turbine, p%NumSC2CtrlGlob, y%fromSCglob, & - p%NumSC2Ctrl, y%fromSC, errStat, errMsg ) - -#endif - - end subroutine SC_CalcOutput - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This is a loose coupling routine for solving constraint states, integrating continuous states, and updating discrete and other -!! states. Continuous, constraint, discrete, and other states are updated to values at t + Interval. - subroutine SC_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, 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(SC_InputType), intent(inout) :: u !< Inputs at utimes (out only for mesh record-keeping in ExtrapInterp routine) - real(DbKi), intent(in ) :: utimes(:) !< Times associated with u(:), in seconds - type(SC_ParameterType), intent(in ) :: p !< Parameters - type(SC_ContinuousStateType), intent(inout) :: x !< Input: Continuous states at t; - !! Output: Continuous states at t + Interval - type(SC_DiscreteStateType), intent(inout) :: xd !< Input: Discrete states at t; - !! Output: Discrete states at t + Interval - type(SC_ConstraintStateType), intent(inout) :: z !< Input: Constraint states at t; - !! Output: Constraint states at t + Interval - type(SC_OtherStateType), intent(inout) :: OtherState !< Other states: Other states at t; - !! Output: Other states at t + Interval - type(SC_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) - 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 = 'SC_UpdateStates' - integer(IntKi) :: errStat2 ! The error status code - character(ErrMsgLen) :: errMsg2 ! The error message, if an error occurred - - procedure(SC_DLL_UpdateStates_PROC),pointer :: DLL_SC_Subroutine ! The address of the supercontroller sc_updatestates procedure in the DLL - - errStat2 = ErrID_None - errMsg2 = '' - -#ifdef STATIC_DLL_LOAD - - ! if we're statically loading the library (i.e., OpenFOAM), we can just call DISCON(); - ! I'll leave some options for whether the supercontroller is being used - - !CALL DISCON( dll_data%avrSWAP, filt_fromSCglob, filt_fromSC, dll_data%toSC, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) - call SC_DLL_UpdateStates ( REAL(t,C_DOUBLE), p%nTurbines, p%NumParamGlobal, p%ParamGlobal, p%NumParamTurbine, p%ParamTurbine, p%nInpGlobal, u%toSCglob, p%NumCtrl2SC, u%toSC, & - p%NumStatesGlobal, xd%Global, p%NumStatesTurbine, xd%Turbine, errStat, errMsg ) - -#else - - ! Call the DLL (first associate the address from the procedure in the DLL with the subroutine): - call C_F_PROCPOINTER( p%DLL_Trgt%ProcAddr(3), DLL_SC_Subroutine) - call DLL_SC_Subroutine ( REAL(t,C_DOUBLE), p%nTurbines, p%NumParamGlobal, p%ParamGlobal, p%NumParamTurbine, p%ParamTurbine, p%nInpGlobal, u%toSCglob, p%NumCtrl2SC, u%toSC, & - p%NumStatesGlobal, xd%Global, p%NumStatesTurbine, xd%Turbine, errStat, errMsg ) - -#endif - - end subroutine SC_UpdateStates - - -end module SuperController diff --git a/OpenFAST/modules/supercontroller/src/SuperController_Registry.txt b/OpenFAST/modules/supercontroller/src/SuperController_Registry.txt deleted file mode 100644 index b2ef55a8a..000000000 --- a/OpenFAST/modules/supercontroller/src/SuperController_Registry.txt +++ /dev/null @@ -1,54 +0,0 @@ -################################################################################################################################### -# Registry for SuperController in the FAST Modularization Framework -# This Registry file is used to create MODULE FARM_SC_Types, which contains all of the user-defined types needed in SuperController. -# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. -# -# Entries are of the form -# keyword -# -# Use ^ as a shortcut for the value from the previous line. -# See NWTC Programmer's Handbook at https://nwtc.nrel.gov/FAST-Developers for further information on the format/contents of this file. -################################################################################################################################### -# -# ...... Include files (definitions from NWTC Library) ............................................................................ -include Registry_NWTC_Library.txt -# ..... InitInput ................................................................................................................ -typedef SuperController/SC InitInputType IntKi nTurbines - - - "Number of turbines in the simulation" - -typedef ^ InitInputType CHARACTER(1024) DLL_FileName - - - "Name of the shared library which the super controller logic" - -# ..... InitOutput ................................................................................................................ -typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - -typedef ^ InitOutputType IntKi NumCtrl2SC - - - "Number of turbine controller outputs [to supercontroller]" - -typedef ^ InitOutputType IntKi nInpGlobal - - - "Number of global inputs to SC" - -typedef ^ InitOutputType IntKi NumSC2Ctrl - - - "Number of turbine specific controller inputs [from supercontroller]" -typedef ^ InitOutputType IntKi NumSC2CtrlGlob - - - "Number of global controller inputs [from supercontroller]" - -# ..... Parameters ................................................................................................................ -typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" secondstypedef ^ ParameterType IntKi NumTurbines - - - "Number of turbines in the simulation" - -typedef ^ ParameterType IntKi nTurbines - - - "Number of turbines in the simulation" - -typedef ^ ParameterType IntKi NumCtrl2SC - - - "Number of turbine controller outputs [to supercontroller]" - -typedef ^ ParameterType IntKi nInpGlobal - - - "Number of global inputs" - -typedef ^ ParameterType IntKi NumSC2Ctrl - - - "Number of turbine specific controller inputs [from supercontroller]" - -typedef ^ ParameterType IntKi NumSC2CtrlGlob - - - "Number of global controller inputs [from supercontroller]" - -typedef ^ ParameterType IntKi NumStatesGlobal - - - "Number of global states" - -typedef ^ ParameterType IntKi NumStatesTurbine - - - "Number of states per turbine" - -typedef ^ ParameterType IntKi NumParamGlobal - - - "Number of global parameters" - -typedef ^ ParameterType IntKi NumParamTurbine - - - "Number of parameters per turbine" - -typedef ^ ParameterType SiKi ParamGlobal {:} - - "Global parameters" - -typedef ^ ParameterType SiKi ParamTurbine {:} - - "Parameters per turbine" - -typedef ^ ParameterType DLL_Type DLL_Trgt - - - "The addresses and names of the super controller shared library and its procedures" - -# ..... Discrete (nondifferentiable) States ......................................................................................................... -typedef ^ DiscreteStateType SiKi Global {:} - - "Global states at time increment, n (total of nStatesGlobal of these states)" - -typedef ^ DiscreteStateType SiKi Turbine {:} - - "Turbine-dependent states at time increment, n (total of nTurbines*nStatesTurbine of these states)" - -# ..... Continuous States ...................................................................................... -typedef ^ ContinuousStateType SiKi Dummy - - - "Remove this variable if you have continuous states" - -# ..... constraint states here: -typedef ^ ConstraintStateType SiKi Dummy - - - "Remove this variable if you have constraint states" - -# ..... misc vars here: -typedef ^ MiscVarType SiKi Dummy - - - "Remove this variable if you have misc vars" - -# ..... Other States .............................................................................................................. -typedef ^ OtherStateType IntKi Dummy - - - "Dummy Other State" - -# ..... Inputs .................................................................................................................... -typedef ^ InputType SiKi toSCglob {:} - - "Global inputs" - -typedef ^ InputType SiKi toSC {:} - - "inputs to the super controller (from the turbine controller)" - -# ..... Outputs ................................................................................................................... -typedef ^ OutputType SiKi fromSCglob {:} - - "Global outputs of the super controller (to the turbine controller)" - -typedef ^ OutputType SiKi fromSC {:} - - "Turbine specific outputs of the super controller (to the turbine controller)" - \ No newline at end of file diff --git a/OpenFAST/modules/supercontroller/src/SuperController_Types.f90 b/OpenFAST/modules/supercontroller/src/SuperController_Types.f90 deleted file mode 100644 index 06db9d3cd..000000000 --- a/OpenFAST/modules/supercontroller/src/SuperController_Types.f90 +++ /dev/null @@ -1,3151 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'SuperController_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 -!********************************************************************************************************************************* -! SuperController_Types -!................................................................................................................................. -! This file is part of SuperController. -! -! 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 SuperController. 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 SuperController_Types -!--------------------------------------------------------------------------------------------------------------------------------- -!USE, INTRINSIC :: ISO_C_Binding -USE NWTC_Library -IMPLICIT NONE -! ========= SC_InitInputType_C ======= - TYPE, BIND(C) :: SC_InitInputType_C - TYPE(C_PTR) :: object = C_NULL_PTR - INTEGER(KIND=C_INT) :: nTurbines - CHARACTER(KIND=C_CHAR), DIMENSION(1024) :: DLL_FileName - END TYPE SC_InitInputType_C - TYPE, PUBLIC :: SC_InitInputType - TYPE( SC_InitInputType_C ) :: C_obj - INTEGER(IntKi) :: nTurbines !< Number of turbines in the simulation [-] - CHARACTER(1024) :: DLL_FileName !< Name of the shared library which the super controller logic [-] - END TYPE SC_InitInputType -! ======================= -! ========= SC_InitOutputType_C ======= - TYPE, BIND(C) :: SC_InitOutputType_C - TYPE(C_PTR) :: object = C_NULL_PTR - INTEGER(KIND=C_INT) :: NumCtrl2SC - INTEGER(KIND=C_INT) :: nInpGlobal - INTEGER(KIND=C_INT) :: NumSC2Ctrl - INTEGER(KIND=C_INT) :: NumSC2CtrlGlob - END TYPE SC_InitOutputType_C - TYPE, PUBLIC :: SC_InitOutputType - TYPE( SC_InitOutputType_C ) :: C_obj - TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - INTEGER(IntKi) :: NumCtrl2SC !< Number of turbine controller outputs [to supercontroller] [-] - INTEGER(IntKi) :: nInpGlobal !< Number of global inputs to SC [-] - INTEGER(IntKi) :: NumSC2Ctrl !< Number of turbine specific controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumSC2CtrlGlob !< Number of global controller inputs [from supercontroller] [-] - END TYPE SC_InitOutputType -! ======================= -! ========= SC_ParameterType_C ======= - TYPE, BIND(C) :: SC_ParameterType_C - TYPE(C_PTR) :: object = C_NULL_PTR - REAL(KIND=C_DOUBLE) :: DT - INTEGER(KIND=C_INT) :: nTurbines - INTEGER(KIND=C_INT) :: NumCtrl2SC - INTEGER(KIND=C_INT) :: nInpGlobal - INTEGER(KIND=C_INT) :: NumSC2Ctrl - INTEGER(KIND=C_INT) :: NumSC2CtrlGlob - INTEGER(KIND=C_INT) :: NumStatesGlobal - INTEGER(KIND=C_INT) :: NumStatesTurbine - INTEGER(KIND=C_INT) :: NumParamGlobal - INTEGER(KIND=C_INT) :: NumParamTurbine - TYPE(C_ptr) :: ParamGlobal = C_NULL_PTR - INTEGER(C_int) :: ParamGlobal_Len = 0 - TYPE(C_ptr) :: ParamTurbine = C_NULL_PTR - INTEGER(C_int) :: ParamTurbine_Len = 0 - END TYPE SC_ParameterType_C - TYPE, PUBLIC :: SC_ParameterType - TYPE( SC_ParameterType_C ) :: C_obj - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [secondstypedef] - INTEGER(IntKi) :: nTurbines !< Number of turbines in the simulation [-] - INTEGER(IntKi) :: NumCtrl2SC !< Number of turbine controller outputs [to supercontroller] [-] - INTEGER(IntKi) :: nInpGlobal !< Number of global inputs [-] - INTEGER(IntKi) :: NumSC2Ctrl !< Number of turbine specific controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumSC2CtrlGlob !< Number of global controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumStatesGlobal !< Number of global states [-] - INTEGER(IntKi) :: NumStatesTurbine !< Number of states per turbine [-] - INTEGER(IntKi) :: NumParamGlobal !< Number of global parameters [-] - INTEGER(IntKi) :: NumParamTurbine !< Number of parameters per turbine [-] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: ParamGlobal => NULL() !< Global parameters [-] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: ParamTurbine => NULL() !< Parameters per turbine [-] - TYPE(DLL_Type) :: DLL_Trgt !< The addresses and names of the super controller shared library and its procedures [-] - END TYPE SC_ParameterType -! ======================= -! ========= SC_DiscreteStateType_C ======= - TYPE, BIND(C) :: SC_DiscreteStateType_C - TYPE(C_PTR) :: object = C_NULL_PTR - TYPE(C_ptr) :: Global = C_NULL_PTR - INTEGER(C_int) :: Global_Len = 0 - TYPE(C_ptr) :: Turbine = C_NULL_PTR - INTEGER(C_int) :: Turbine_Len = 0 - END TYPE SC_DiscreteStateType_C - TYPE, PUBLIC :: SC_DiscreteStateType - TYPE( SC_DiscreteStateType_C ) :: C_obj - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: Global => NULL() !< Global states at time increment, n (total of nStatesGlobal of these states) [-] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: Turbine => NULL() !< Turbine-dependent states at time increment, n (total of nTurbines*nStatesTurbine of these states) [-] - END TYPE SC_DiscreteStateType -! ======================= -! ========= SC_ContinuousStateType_C ======= - TYPE, BIND(C) :: SC_ContinuousStateType_C - TYPE(C_PTR) :: object = C_NULL_PTR - REAL(KIND=C_FLOAT) :: Dummy - END TYPE SC_ContinuousStateType_C - TYPE, PUBLIC :: SC_ContinuousStateType - TYPE( SC_ContinuousStateType_C ) :: C_obj - REAL(SiKi) :: Dummy !< Remove this variable if you have continuous states [-] - END TYPE SC_ContinuousStateType -! ======================= -! ========= SC_ConstraintStateType_C ======= - TYPE, BIND(C) :: SC_ConstraintStateType_C - TYPE(C_PTR) :: object = C_NULL_PTR - REAL(KIND=C_FLOAT) :: Dummy - END TYPE SC_ConstraintStateType_C - TYPE, PUBLIC :: SC_ConstraintStateType - TYPE( SC_ConstraintStateType_C ) :: C_obj - REAL(SiKi) :: Dummy !< Remove this variable if you have constraint states [-] - END TYPE SC_ConstraintStateType -! ======================= -! ========= SC_MiscVarType_C ======= - TYPE, BIND(C) :: SC_MiscVarType_C - TYPE(C_PTR) :: object = C_NULL_PTR - REAL(KIND=C_FLOAT) :: Dummy - END TYPE SC_MiscVarType_C - TYPE, PUBLIC :: SC_MiscVarType - TYPE( SC_MiscVarType_C ) :: C_obj - REAL(SiKi) :: Dummy !< Remove this variable if you have misc vars [-] - END TYPE SC_MiscVarType -! ======================= -! ========= SC_OtherStateType_C ======= - TYPE, BIND(C) :: SC_OtherStateType_C - TYPE(C_PTR) :: object = C_NULL_PTR - INTEGER(KIND=C_INT) :: Dummy - END TYPE SC_OtherStateType_C - TYPE, PUBLIC :: SC_OtherStateType - TYPE( SC_OtherStateType_C ) :: C_obj - INTEGER(IntKi) :: Dummy !< Dummy Other State [-] - END TYPE SC_OtherStateType -! ======================= -! ========= SC_InputType_C ======= - TYPE, BIND(C) :: SC_InputType_C - TYPE(C_PTR) :: object = C_NULL_PTR - TYPE(C_ptr) :: toSCglob = C_NULL_PTR - INTEGER(C_int) :: toSCglob_Len = 0 - TYPE(C_ptr) :: toSC = C_NULL_PTR - INTEGER(C_int) :: toSC_Len = 0 - END TYPE SC_InputType_C - TYPE, PUBLIC :: SC_InputType - TYPE( SC_InputType_C ) :: C_obj - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: toSCglob => NULL() !< Global inputs [-] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: toSC => NULL() !< inputs to the super controller (from the turbine controller) [-] - END TYPE SC_InputType -! ======================= -! ========= SC_OutputType_C ======= - TYPE, BIND(C) :: SC_OutputType_C - TYPE(C_PTR) :: object = C_NULL_PTR - TYPE(C_ptr) :: fromSCglob = C_NULL_PTR - INTEGER(C_int) :: fromSCglob_Len = 0 - TYPE(C_ptr) :: fromSC = C_NULL_PTR - INTEGER(C_int) :: fromSC_Len = 0 - END TYPE SC_OutputType_C - TYPE, PUBLIC :: SC_OutputType - TYPE( SC_OutputType_C ) :: C_obj - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: fromSCglob => NULL() !< Global outputs of the super controller (to the turbine controller) [-] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: fromSC => NULL() !< Turbine specific outputs of the super controller (to the turbine controller) [-] - END TYPE SC_OutputType -! ======================= -CONTAINS - SUBROUTINE SC_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(SC_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%nTurbines = SrcInitInputData%nTurbines - DstInitInputData%C_obj%nTurbines = SrcInitInputData%C_obj%nTurbines - DstInitInputData%DLL_FileName = SrcInitInputData%DLL_FileName - DstInitInputData%C_obj%DLL_FileName = SrcInitInputData%C_obj%DLL_FileName - END SUBROUTINE SC_CopyInitInput - - SUBROUTINE SC_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyInitInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE SC_DestroyInitInput - - SUBROUTINE SC_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! nTurbines - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_FileName) ! DLL_FileName - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%nTurbines - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%DLL_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE SC_PackInitInput - - SUBROUTINE SC_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%nTurbines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%nTurbines = OutData%nTurbines - DO I = 1, LEN(OutData%DLL_FileName) - OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%DLL_FileName = TRANSFER(OutData%DLL_FileName, OutData%C_obj%DLL_FileName ) - END SUBROUTINE SC_UnPackInitInput - - SUBROUTINE SC_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%nTurbines = InitInputData%C_obj%nTurbines - InitInputData%DLL_FileName = TRANSFER(InitInputData%C_obj%DLL_FileName, InitInputData%DLL_FileName ) - END SUBROUTINE SC_C2Fary_CopyInitInput - - SUBROUTINE SC_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%C_obj%nTurbines = InitInputData%nTurbines - InitInputData%C_obj%DLL_FileName = TRANSFER(InitInputData%DLL_FileName, InitInputData%C_obj%DLL_FileName ) - END SUBROUTINE SC_F2C_CopyInitInput - - SUBROUTINE SC_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SC_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitOutputData%NumCtrl2SC = SrcInitOutputData%NumCtrl2SC - DstInitOutputData%C_obj%NumCtrl2SC = SrcInitOutputData%C_obj%NumCtrl2SC - DstInitOutputData%nInpGlobal = SrcInitOutputData%nInpGlobal - DstInitOutputData%C_obj%nInpGlobal = SrcInitOutputData%C_obj%nInpGlobal - DstInitOutputData%NumSC2Ctrl = SrcInitOutputData%NumSC2Ctrl - DstInitOutputData%C_obj%NumSC2Ctrl = SrcInitOutputData%C_obj%NumSC2Ctrl - DstInitOutputData%NumSC2CtrlGlob = SrcInitOutputData%NumSC2CtrlGlob - DstInitOutputData%C_obj%NumSC2CtrlGlob = SrcInitOutputData%C_obj%NumSC2CtrlGlob - END SUBROUTINE SC_CopyInitOutput - - SUBROUTINE SC_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyInitOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, ErrMsg ) - END SUBROUTINE SC_DestroyInitOutput - - SUBROUTINE SC_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC - Int_BufSz = Int_BufSz + 1 ! nInpGlobal - Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl - Int_BufSz = Int_BufSz + 1 ! NumSC2CtrlGlob - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nInpGlobal - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2CtrlGlob - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SC_PackInitOutput - - SUBROUTINE SC_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC - OutData%nInpGlobal = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%nInpGlobal = OutData%nInpGlobal - OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl - OutData%NumSC2CtrlGlob = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob - END SUBROUTINE SC_UnPackInitOutput - - SUBROUTINE SC_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitOutputData%NumCtrl2SC = InitOutputData%C_obj%NumCtrl2SC - InitOutputData%nInpGlobal = InitOutputData%C_obj%nInpGlobal - InitOutputData%NumSC2Ctrl = InitOutputData%C_obj%NumSC2Ctrl - InitOutputData%NumSC2CtrlGlob = InitOutputData%C_obj%NumSC2CtrlGlob - END SUBROUTINE SC_C2Fary_CopyInitOutput - - SUBROUTINE SC_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitOutputData%C_obj%NumCtrl2SC = InitOutputData%NumCtrl2SC - InitOutputData%C_obj%nInpGlobal = InitOutputData%nInpGlobal - InitOutputData%C_obj%NumSC2Ctrl = InitOutputData%NumSC2Ctrl - InitOutputData%C_obj%NumSC2CtrlGlob = InitOutputData%NumSC2CtrlGlob - END SUBROUTINE SC_F2C_CopyInitOutput - - SUBROUTINE SC_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SC_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%C_obj%DT = SrcParamData%C_obj%DT - DstParamData%nTurbines = SrcParamData%nTurbines - DstParamData%C_obj%nTurbines = SrcParamData%C_obj%nTurbines - DstParamData%NumCtrl2SC = SrcParamData%NumCtrl2SC - DstParamData%C_obj%NumCtrl2SC = SrcParamData%C_obj%NumCtrl2SC - DstParamData%nInpGlobal = SrcParamData%nInpGlobal - DstParamData%C_obj%nInpGlobal = SrcParamData%C_obj%nInpGlobal - DstParamData%NumSC2Ctrl = SrcParamData%NumSC2Ctrl - DstParamData%C_obj%NumSC2Ctrl = SrcParamData%C_obj%NumSC2Ctrl - DstParamData%NumSC2CtrlGlob = SrcParamData%NumSC2CtrlGlob - DstParamData%C_obj%NumSC2CtrlGlob = SrcParamData%C_obj%NumSC2CtrlGlob - DstParamData%NumStatesGlobal = SrcParamData%NumStatesGlobal - DstParamData%C_obj%NumStatesGlobal = SrcParamData%C_obj%NumStatesGlobal - DstParamData%NumStatesTurbine = SrcParamData%NumStatesTurbine - DstParamData%C_obj%NumStatesTurbine = SrcParamData%C_obj%NumStatesTurbine - DstParamData%NumParamGlobal = SrcParamData%NumParamGlobal - DstParamData%C_obj%NumParamGlobal = SrcParamData%C_obj%NumParamGlobal - DstParamData%NumParamTurbine = SrcParamData%NumParamTurbine - DstParamData%C_obj%NumParamTurbine = SrcParamData%C_obj%NumParamTurbine -IF (ASSOCIATED(SrcParamData%ParamGlobal)) THEN - i1_l = LBOUND(SrcParamData%ParamGlobal,1) - i1_u = UBOUND(SrcParamData%ParamGlobal,1) - IF (.NOT. ASSOCIATED(DstParamData%ParamGlobal)) THEN - ALLOCATE(DstParamData%ParamGlobal(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ParamGlobal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstParamData%c_obj%ParamGlobal_Len = SIZE(DstParamData%ParamGlobal) - IF (DstParamData%c_obj%ParamGlobal_Len > 0) & - DstParamData%c_obj%ParamGlobal = C_LOC( DstParamData%ParamGlobal(i1_l) ) - END IF - DstParamData%ParamGlobal = SrcParamData%ParamGlobal -ENDIF -IF (ASSOCIATED(SrcParamData%ParamTurbine)) THEN - i1_l = LBOUND(SrcParamData%ParamTurbine,1) - i1_u = UBOUND(SrcParamData%ParamTurbine,1) - IF (.NOT. ASSOCIATED(DstParamData%ParamTurbine)) THEN - ALLOCATE(DstParamData%ParamTurbine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ParamTurbine.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstParamData%c_obj%ParamTurbine_Len = SIZE(DstParamData%ParamTurbine) - IF (DstParamData%c_obj%ParamTurbine_Len > 0) & - DstParamData%c_obj%ParamTurbine = C_LOC( DstParamData%ParamTurbine(i1_l) ) - END IF - DstParamData%ParamTurbine = SrcParamData%ParamTurbine -ENDIF - DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt - END SUBROUTINE SC_CopyParam - - SUBROUTINE SC_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyParam' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(ParamData%ParamGlobal)) THEN - DEALLOCATE(ParamData%ParamGlobal) - ParamData%ParamGlobal => NULL() - ParamData%C_obj%ParamGlobal = C_NULL_PTR - ParamData%C_obj%ParamGlobal_Len = 0 -ENDIF -IF (ASSOCIATED(ParamData%ParamTurbine)) THEN - DEALLOCATE(ParamData%ParamTurbine) - ParamData%ParamTurbine => NULL() - ParamData%C_obj%ParamTurbine = C_NULL_PTR - ParamData%C_obj%ParamTurbine_Len = 0 -ENDIF - CALL FreeDynamicLib( ParamData%DLL_Trgt, ErrStat, ErrMsg ) - END SUBROUTINE SC_DestroyParam - - SUBROUTINE SC_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! nTurbines - Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC - Int_BufSz = Int_BufSz + 1 ! nInpGlobal - Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl - Int_BufSz = Int_BufSz + 1 ! NumSC2CtrlGlob - Int_BufSz = Int_BufSz + 1 ! NumStatesGlobal - Int_BufSz = Int_BufSz + 1 ! NumStatesTurbine - Int_BufSz = Int_BufSz + 1 ! NumParamGlobal - Int_BufSz = Int_BufSz + 1 ! NumParamTurbine - Int_BufSz = Int_BufSz + 1 ! ParamGlobal allocated yes/no - IF ( ASSOCIATED(InData%ParamGlobal) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ParamGlobal upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ParamGlobal) ! ParamGlobal - END IF - Int_BufSz = Int_BufSz + 1 ! ParamTurbine allocated yes/no - IF ( ASSOCIATED(InData%ParamTurbine) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ParamTurbine upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ParamTurbine) ! ParamTurbine - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DLL_Trgt: size of buffers for each call to pack subtype - CALL DLLTypePack( InData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! DLL_Trgt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DLL_Trgt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DLL_Trgt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DLL_Trgt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nTurbines - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nInpGlobal - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2CtrlGlob - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumStatesGlobal - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumStatesTurbine - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumParamGlobal - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumParamTurbine - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ASSOCIATED(InData%ParamGlobal) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ParamGlobal,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ParamGlobal,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ParamGlobal,1), UBOUND(InData%ParamGlobal,1) - ReKiBuf(Re_Xferred) = InData%ParamGlobal(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%ParamTurbine) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ParamTurbine,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ParamTurbine,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ParamTurbine,1), UBOUND(InData%ParamTurbine,1) - ReKiBuf(Re_Xferred) = InData%ParamTurbine(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - CALL DLLTypePack( InData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! DLL_Trgt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE SC_PackParam - - SUBROUTINE SC_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%DT = OutData%DT - OutData%nTurbines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%nTurbines = OutData%nTurbines - OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC - OutData%nInpGlobal = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%nInpGlobal = OutData%nInpGlobal - OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl - OutData%NumSC2CtrlGlob = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob - OutData%NumStatesGlobal = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumStatesGlobal = OutData%NumStatesGlobal - OutData%NumStatesTurbine = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumStatesTurbine = OutData%NumStatesTurbine - OutData%NumParamGlobal = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumParamGlobal = OutData%NumParamGlobal - OutData%NumParamTurbine = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumParamTurbine = OutData%NumParamTurbine - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ParamGlobal not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%ParamGlobal)) DEALLOCATE(OutData%ParamGlobal) - ALLOCATE(OutData%ParamGlobal(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ParamGlobal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%ParamGlobal_Len = SIZE(OutData%ParamGlobal) - IF (OutData%c_obj%ParamGlobal_Len > 0) & - OutData%c_obj%ParamGlobal = C_LOC( OutData%ParamGlobal(i1_l) ) - DO i1 = LBOUND(OutData%ParamGlobal,1), UBOUND(OutData%ParamGlobal,1) - OutData%ParamGlobal(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ParamTurbine not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%ParamTurbine)) DEALLOCATE(OutData%ParamTurbine) - ALLOCATE(OutData%ParamTurbine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ParamTurbine.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%ParamTurbine_Len = SIZE(OutData%ParamTurbine) - IF (OutData%c_obj%ParamTurbine_Len > 0) & - OutData%c_obj%ParamTurbine = C_LOC( OutData%ParamTurbine(i1_l) ) - DO i1 = LBOUND(OutData%ParamTurbine,1), UBOUND(OutData%ParamTurbine,1) - OutData%ParamTurbine(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DLLTypeUnpack( OutData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! DLL_Trgt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE SC_UnPackParam - - SUBROUTINE SC_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%DT = ParamData%C_obj%DT - ParamData%nTurbines = ParamData%C_obj%nTurbines - ParamData%NumCtrl2SC = ParamData%C_obj%NumCtrl2SC - ParamData%nInpGlobal = ParamData%C_obj%nInpGlobal - ParamData%NumSC2Ctrl = ParamData%C_obj%NumSC2Ctrl - ParamData%NumSC2CtrlGlob = ParamData%C_obj%NumSC2CtrlGlob - ParamData%NumStatesGlobal = ParamData%C_obj%NumStatesGlobal - ParamData%NumStatesTurbine = ParamData%C_obj%NumStatesTurbine - ParamData%NumParamGlobal = ParamData%C_obj%NumParamGlobal - ParamData%NumParamTurbine = ParamData%C_obj%NumParamTurbine - - ! -- ParamGlobal Param Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%ParamGlobal ) ) THEN - NULLIFY( ParamData%ParamGlobal ) - ELSE - CALL C_F_POINTER(ParamData%C_obj%ParamGlobal, ParamData%ParamGlobal, (/ParamData%C_obj%ParamGlobal_Len/)) - END IF - END IF - - ! -- ParamTurbine Param Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%ParamTurbine ) ) THEN - NULLIFY( ParamData%ParamTurbine ) - ELSE - CALL C_F_POINTER(ParamData%C_obj%ParamTurbine, ParamData%ParamTurbine, (/ParamData%C_obj%ParamTurbine_Len/)) - END IF - END IF - END SUBROUTINE SC_C2Fary_CopyParam - - SUBROUTINE SC_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%C_obj%DT = ParamData%DT - ParamData%C_obj%nTurbines = ParamData%nTurbines - ParamData%C_obj%NumCtrl2SC = ParamData%NumCtrl2SC - ParamData%C_obj%nInpGlobal = ParamData%nInpGlobal - ParamData%C_obj%NumSC2Ctrl = ParamData%NumSC2Ctrl - ParamData%C_obj%NumSC2CtrlGlob = ParamData%NumSC2CtrlGlob - ParamData%C_obj%NumStatesGlobal = ParamData%NumStatesGlobal - ParamData%C_obj%NumStatesTurbine = ParamData%NumStatesTurbine - ParamData%C_obj%NumParamGlobal = ParamData%NumParamGlobal - ParamData%C_obj%NumParamTurbine = ParamData%NumParamTurbine - - ! -- ParamGlobal Param Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(ParamData%ParamGlobal)) THEN - ParamData%c_obj%ParamGlobal_Len = 0 - ParamData%c_obj%ParamGlobal = C_NULL_PTR - ELSE - ParamData%c_obj%ParamGlobal_Len = SIZE(ParamData%ParamGlobal) - IF (ParamData%c_obj%ParamGlobal_Len > 0) & - ParamData%c_obj%ParamGlobal = C_LOC( ParamData%ParamGlobal( LBOUND(ParamData%ParamGlobal,1) ) ) - END IF - END IF - - ! -- ParamTurbine Param Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(ParamData%ParamTurbine)) THEN - ParamData%c_obj%ParamTurbine_Len = 0 - ParamData%c_obj%ParamTurbine = C_NULL_PTR - ELSE - ParamData%c_obj%ParamTurbine_Len = SIZE(ParamData%ParamTurbine) - IF (ParamData%c_obj%ParamTurbine_Len > 0) & - ParamData%c_obj%ParamTurbine = C_LOC( ParamData%ParamTurbine( LBOUND(ParamData%ParamTurbine,1) ) ) - END IF - END IF - END SUBROUTINE SC_F2C_CopyParam - - SUBROUTINE SC_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(SC_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcDiscStateData%Global)) THEN - i1_l = LBOUND(SrcDiscStateData%Global,1) - i1_u = UBOUND(SrcDiscStateData%Global,1) - IF (.NOT. ASSOCIATED(DstDiscStateData%Global)) THEN - ALLOCATE(DstDiscStateData%Global(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Global.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstDiscStateData%c_obj%Global_Len = SIZE(DstDiscStateData%Global) - IF (DstDiscStateData%c_obj%Global_Len > 0) & - DstDiscStateData%c_obj%Global = C_LOC( DstDiscStateData%Global(i1_l) ) - END IF - DstDiscStateData%Global = SrcDiscStateData%Global -ENDIF -IF (ASSOCIATED(SrcDiscStateData%Turbine)) THEN - i1_l = LBOUND(SrcDiscStateData%Turbine,1) - i1_u = UBOUND(SrcDiscStateData%Turbine,1) - IF (.NOT. ASSOCIATED(DstDiscStateData%Turbine)) THEN - ALLOCATE(DstDiscStateData%Turbine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Turbine.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstDiscStateData%c_obj%Turbine_Len = SIZE(DstDiscStateData%Turbine) - IF (DstDiscStateData%c_obj%Turbine_Len > 0) & - DstDiscStateData%c_obj%Turbine = C_LOC( DstDiscStateData%Turbine(i1_l) ) - END IF - DstDiscStateData%Turbine = SrcDiscStateData%Turbine -ENDIF - END SUBROUTINE SC_CopyDiscState - - SUBROUTINE SC_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(SC_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyDiscState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(DiscStateData%Global)) THEN - DEALLOCATE(DiscStateData%Global) - DiscStateData%Global => NULL() - DiscStateData%C_obj%Global = C_NULL_PTR - DiscStateData%C_obj%Global_Len = 0 -ENDIF -IF (ASSOCIATED(DiscStateData%Turbine)) THEN - DEALLOCATE(DiscStateData%Turbine) - DiscStateData%Turbine => NULL() - DiscStateData%C_obj%Turbine = C_NULL_PTR - DiscStateData%C_obj%Turbine_Len = 0 -ENDIF - END SUBROUTINE SC_DestroyDiscState - - SUBROUTINE SC_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Global allocated yes/no - IF ( ASSOCIATED(InData%Global) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Global upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Global) ! Global - END IF - Int_BufSz = Int_BufSz + 1 ! Turbine allocated yes/no - IF ( ASSOCIATED(InData%Turbine) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Turbine upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Turbine) ! Turbine - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%Global) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Global,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Global,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Global,1), UBOUND(InData%Global,1) - ReKiBuf(Re_Xferred) = InData%Global(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Turbine) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Turbine,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Turbine,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Turbine,1), UBOUND(InData%Turbine,1) - ReKiBuf(Re_Xferred) = InData%Turbine(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_PackDiscState - - SUBROUTINE SC_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Global not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%Global)) DEALLOCATE(OutData%Global) - ALLOCATE(OutData%Global(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Global.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%Global_Len = SIZE(OutData%Global) - IF (OutData%c_obj%Global_Len > 0) & - OutData%c_obj%Global = C_LOC( OutData%Global(i1_l) ) - DO i1 = LBOUND(OutData%Global,1), UBOUND(OutData%Global,1) - OutData%Global(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Turbine not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%Turbine)) DEALLOCATE(OutData%Turbine) - ALLOCATE(OutData%Turbine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turbine.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%Turbine_Len = SIZE(OutData%Turbine) - IF (OutData%c_obj%Turbine_Len > 0) & - OutData%c_obj%Turbine = C_LOC( OutData%Turbine(i1_l) ) - DO i1 = LBOUND(OutData%Turbine,1), UBOUND(OutData%Turbine,1) - OutData%Turbine(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_UnPackDiscState - - SUBROUTINE SC_C2Fary_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- Global DiscState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( DiscStateData%C_obj%Global ) ) THEN - NULLIFY( DiscStateData%Global ) - ELSE - CALL C_F_POINTER(DiscStateData%C_obj%Global, DiscStateData%Global, (/DiscStateData%C_obj%Global_Len/)) - END IF - END IF - - ! -- Turbine DiscState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( DiscStateData%C_obj%Turbine ) ) THEN - NULLIFY( DiscStateData%Turbine ) - ELSE - CALL C_F_POINTER(DiscStateData%C_obj%Turbine, DiscStateData%Turbine, (/DiscStateData%C_obj%Turbine_Len/)) - END IF - END IF - END SUBROUTINE SC_C2Fary_CopyDiscState - - SUBROUTINE SC_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- Global DiscState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(DiscStateData%Global)) THEN - DiscStateData%c_obj%Global_Len = 0 - DiscStateData%c_obj%Global = C_NULL_PTR - ELSE - DiscStateData%c_obj%Global_Len = SIZE(DiscStateData%Global) - IF (DiscStateData%c_obj%Global_Len > 0) & - DiscStateData%c_obj%Global = C_LOC( DiscStateData%Global( LBOUND(DiscStateData%Global,1) ) ) - END IF - END IF - - ! -- Turbine DiscState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(DiscStateData%Turbine)) THEN - DiscStateData%c_obj%Turbine_Len = 0 - DiscStateData%c_obj%Turbine = C_NULL_PTR - ELSE - DiscStateData%c_obj%Turbine_Len = SIZE(DiscStateData%Turbine) - IF (DiscStateData%c_obj%Turbine_Len > 0) & - DiscStateData%c_obj%Turbine = C_LOC( DiscStateData%Turbine( LBOUND(DiscStateData%Turbine,1) ) ) - END IF - END IF - END SUBROUTINE SC_F2C_CopyDiscState - - SUBROUTINE SC_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(SC_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%Dummy = SrcContStateData%Dummy - DstContStateData%C_obj%Dummy = SrcContStateData%C_obj%Dummy - END SUBROUTINE SC_CopyContState - - SUBROUTINE SC_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(SC_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyContState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE SC_DestroyContState - - SUBROUTINE SC_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! Dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SC_PackContState - - SUBROUTINE SC_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Dummy = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%Dummy = OutData%Dummy - END SUBROUTINE SC_UnPackContState - - SUBROUTINE SC_C2Fary_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ContStateData%Dummy = ContStateData%C_obj%Dummy - END SUBROUTINE SC_C2Fary_CopyContState - - SUBROUTINE SC_F2C_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ContStateData%C_obj%Dummy = ContStateData%Dummy - END SUBROUTINE SC_F2C_CopyContState - - SUBROUTINE SC_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(SC_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%Dummy = SrcConstrStateData%Dummy - DstConstrStateData%C_obj%Dummy = SrcConstrStateData%C_obj%Dummy - END SUBROUTINE SC_CopyConstrState - - SUBROUTINE SC_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(SC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyConstrState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE SC_DestroyConstrState - - SUBROUTINE SC_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! Dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SC_PackConstrState - - SUBROUTINE SC_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Dummy = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%Dummy = OutData%Dummy - END SUBROUTINE SC_UnPackConstrState - - SUBROUTINE SC_C2Fary_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ConstrStateData%Dummy = ConstrStateData%C_obj%Dummy - END SUBROUTINE SC_C2Fary_CopyConstrState - - SUBROUTINE SC_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ConstrStateData%C_obj%Dummy = ConstrStateData%Dummy - END SUBROUTINE SC_F2C_CopyConstrState - - SUBROUTINE SC_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(SC_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%Dummy = SrcMiscData%Dummy - DstMiscData%C_obj%Dummy = SrcMiscData%C_obj%Dummy - END SUBROUTINE SC_CopyMisc - - SUBROUTINE SC_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(SC_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyMisc' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE SC_DestroyMisc - - SUBROUTINE SC_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! Dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SC_PackMisc - - SUBROUTINE SC_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Dummy = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%Dummy = OutData%Dummy - END SUBROUTINE SC_UnPackMisc - - SUBROUTINE SC_C2Fary_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - MiscData%Dummy = MiscData%C_obj%Dummy - END SUBROUTINE SC_C2Fary_CopyMisc - - SUBROUTINE SC_F2C_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - MiscData%C_obj%Dummy = MiscData%Dummy - END SUBROUTINE SC_F2C_CopyMisc - - SUBROUTINE SC_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(SC_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%Dummy = SrcOtherStateData%Dummy - DstOtherStateData%C_obj%Dummy = SrcOtherStateData%C_obj%Dummy - END SUBROUTINE SC_CopyOtherState - - SUBROUTINE SC_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(SC_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyOtherState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE SC_DestroyOtherState - - SUBROUTINE SC_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%Dummy - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SC_PackOtherState - - SUBROUTINE SC_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Dummy = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%Dummy = OutData%Dummy - END SUBROUTINE SC_UnPackOtherState - - SUBROUTINE SC_C2Fary_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - OtherStateData%Dummy = OtherStateData%C_obj%Dummy - END SUBROUTINE SC_C2Fary_CopyOtherState - - SUBROUTINE SC_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - OtherStateData%C_obj%Dummy = OtherStateData%Dummy - END SUBROUTINE SC_F2C_CopyOtherState - - SUBROUTINE SC_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_InputType), INTENT(IN) :: SrcInputData - TYPE(SC_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcInputData%toSCglob)) THEN - i1_l = LBOUND(SrcInputData%toSCglob,1) - i1_u = UBOUND(SrcInputData%toSCglob,1) - IF (.NOT. ASSOCIATED(DstInputData%toSCglob)) THEN - ALLOCATE(DstInputData%toSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%toSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%toSCglob_Len = SIZE(DstInputData%toSCglob) - IF (DstInputData%c_obj%toSCglob_Len > 0) & - DstInputData%c_obj%toSCglob = C_LOC( DstInputData%toSCglob(i1_l) ) - END IF - DstInputData%toSCglob = SrcInputData%toSCglob -ENDIF -IF (ASSOCIATED(SrcInputData%toSC)) THEN - i1_l = LBOUND(SrcInputData%toSC,1) - i1_u = UBOUND(SrcInputData%toSC,1) - IF (.NOT. ASSOCIATED(DstInputData%toSC)) THEN - ALLOCATE(DstInputData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%toSC_Len = SIZE(DstInputData%toSC) - IF (DstInputData%c_obj%toSC_Len > 0) & - DstInputData%c_obj%toSC = C_LOC( DstInputData%toSC(i1_l) ) - END IF - DstInputData%toSC = SrcInputData%toSC -ENDIF - END SUBROUTINE SC_CopyInput - - SUBROUTINE SC_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(SC_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(InputData%toSCglob)) THEN - DEALLOCATE(InputData%toSCglob) - InputData%toSCglob => NULL() - InputData%C_obj%toSCglob = C_NULL_PTR - InputData%C_obj%toSCglob_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%toSC)) THEN - DEALLOCATE(InputData%toSC) - InputData%toSC => NULL() - InputData%C_obj%toSC = C_NULL_PTR - InputData%C_obj%toSC_Len = 0 -ENDIF - END SUBROUTINE SC_DestroyInput - - SUBROUTINE SC_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! toSCglob allocated yes/no - IF ( ASSOCIATED(InData%toSCglob) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! toSCglob upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%toSCglob) ! toSCglob - END IF - Int_BufSz = Int_BufSz + 1 ! toSC allocated yes/no - IF ( ASSOCIATED(InData%toSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! toSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%toSC) ! toSC - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%toSCglob) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%toSCglob,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toSCglob,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%toSCglob,1), UBOUND(InData%toSCglob,1) - ReKiBuf(Re_Xferred) = InData%toSCglob(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%toSC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%toSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%toSC,1), UBOUND(InData%toSC,1) - ReKiBuf(Re_Xferred) = InData%toSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_PackInput - - SUBROUTINE SC_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! toSCglob not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%toSCglob)) DEALLOCATE(OutData%toSCglob) - ALLOCATE(OutData%toSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%toSCglob_Len = SIZE(OutData%toSCglob) - IF (OutData%c_obj%toSCglob_Len > 0) & - OutData%c_obj%toSCglob = C_LOC( OutData%toSCglob(i1_l) ) - DO i1 = LBOUND(OutData%toSCglob,1), UBOUND(OutData%toSCglob,1) - OutData%toSCglob(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! toSC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%toSC)) DEALLOCATE(OutData%toSC) - ALLOCATE(OutData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%toSC_Len = SIZE(OutData%toSC) - IF (OutData%c_obj%toSC_Len > 0) & - OutData%c_obj%toSC = C_LOC( OutData%toSC(i1_l) ) - DO i1 = LBOUND(OutData%toSC,1), UBOUND(OutData%toSC,1) - OutData%toSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_UnPackInput - - SUBROUTINE SC_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- toSCglob Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%toSCglob ) ) THEN - NULLIFY( InputData%toSCglob ) - ELSE - CALL C_F_POINTER(InputData%C_obj%toSCglob, InputData%toSCglob, (/InputData%C_obj%toSCglob_Len/)) - END IF - END IF - - ! -- toSC Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%toSC ) ) THEN - NULLIFY( InputData%toSC ) - ELSE - CALL C_F_POINTER(InputData%C_obj%toSC, InputData%toSC, (/InputData%C_obj%toSC_Len/)) - END IF - END IF - END SUBROUTINE SC_C2Fary_CopyInput - - SUBROUTINE SC_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- toSCglob Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%toSCglob)) THEN - InputData%c_obj%toSCglob_Len = 0 - InputData%c_obj%toSCglob = C_NULL_PTR - ELSE - InputData%c_obj%toSCglob_Len = SIZE(InputData%toSCglob) - IF (InputData%c_obj%toSCglob_Len > 0) & - InputData%c_obj%toSCglob = C_LOC( InputData%toSCglob( LBOUND(InputData%toSCglob,1) ) ) - END IF - END IF - - ! -- toSC Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%toSC)) THEN - InputData%c_obj%toSC_Len = 0 - InputData%c_obj%toSC = C_NULL_PTR - ELSE - InputData%c_obj%toSC_Len = SIZE(InputData%toSC) - IF (InputData%c_obj%toSC_Len > 0) & - InputData%c_obj%toSC = C_LOC( InputData%toSC( LBOUND(InputData%toSC,1) ) ) - END IF - END IF - END SUBROUTINE SC_F2C_CopyInput - - SUBROUTINE SC_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_OutputType), INTENT(IN) :: SrcOutputData - TYPE(SC_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcOutputData%fromSCglob)) THEN - i1_l = LBOUND(SrcOutputData%fromSCglob,1) - i1_u = UBOUND(SrcOutputData%fromSCglob,1) - IF (.NOT. ASSOCIATED(DstOutputData%fromSCglob)) THEN - ALLOCATE(DstOutputData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%fromSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%c_obj%fromSCglob_Len = SIZE(DstOutputData%fromSCglob) - IF (DstOutputData%c_obj%fromSCglob_Len > 0) & - DstOutputData%c_obj%fromSCglob = C_LOC( DstOutputData%fromSCglob(i1_l) ) - END IF - DstOutputData%fromSCglob = SrcOutputData%fromSCglob -ENDIF -IF (ASSOCIATED(SrcOutputData%fromSC)) THEN - i1_l = LBOUND(SrcOutputData%fromSC,1) - i1_u = UBOUND(SrcOutputData%fromSC,1) - IF (.NOT. ASSOCIATED(DstOutputData%fromSC)) THEN - ALLOCATE(DstOutputData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%c_obj%fromSC_Len = SIZE(DstOutputData%fromSC) - IF (DstOutputData%c_obj%fromSC_Len > 0) & - DstOutputData%c_obj%fromSC = C_LOC( DstOutputData%fromSC(i1_l) ) - END IF - DstOutputData%fromSC = SrcOutputData%fromSC -ENDIF - END SUBROUTINE SC_CopyOutput - - SUBROUTINE SC_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(SC_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(OutputData%fromSCglob)) THEN - DEALLOCATE(OutputData%fromSCglob) - OutputData%fromSCglob => NULL() - OutputData%C_obj%fromSCglob = C_NULL_PTR - OutputData%C_obj%fromSCglob_Len = 0 -ENDIF -IF (ASSOCIATED(OutputData%fromSC)) THEN - DEALLOCATE(OutputData%fromSC) - OutputData%fromSC => NULL() - OutputData%C_obj%fromSC = C_NULL_PTR - OutputData%C_obj%fromSC_Len = 0 -ENDIF - END SUBROUTINE SC_DestroyOutput - - SUBROUTINE SC_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! fromSCglob allocated yes/no - IF ( ASSOCIATED(InData%fromSCglob) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSCglob upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSCglob) ! fromSCglob - END IF - Int_BufSz = Int_BufSz + 1 ! fromSC allocated yes/no - IF ( ASSOCIATED(InData%fromSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSC) ! fromSC - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%fromSCglob) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSCglob,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSCglob,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSCglob,1), UBOUND(InData%fromSCglob,1) - ReKiBuf(Re_Xferred) = InData%fromSCglob(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%fromSC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSC,1), UBOUND(InData%fromSC,1) - ReKiBuf(Re_Xferred) = InData%fromSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_PackOutput - - SUBROUTINE SC_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSCglob not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%fromSCglob)) DEALLOCATE(OutData%fromSCglob) - ALLOCATE(OutData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%fromSCglob_Len = SIZE(OutData%fromSCglob) - IF (OutData%c_obj%fromSCglob_Len > 0) & - OutData%c_obj%fromSCglob = C_LOC( OutData%fromSCglob(i1_l) ) - DO i1 = LBOUND(OutData%fromSCglob,1), UBOUND(OutData%fromSCglob,1) - OutData%fromSCglob(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%fromSC)) DEALLOCATE(OutData%fromSC) - ALLOCATE(OutData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%fromSC_Len = SIZE(OutData%fromSC) - IF (OutData%c_obj%fromSC_Len > 0) & - OutData%c_obj%fromSC = C_LOC( OutData%fromSC(i1_l) ) - DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) - OutData%fromSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_UnPackOutput - - SUBROUTINE SC_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- fromSCglob Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSCglob ) ) THEN - NULLIFY( OutputData%fromSCglob ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%fromSCglob, OutputData%fromSCglob, (/OutputData%C_obj%fromSCglob_Len/)) - END IF - END IF - - ! -- fromSC Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSC ) ) THEN - NULLIFY( OutputData%fromSC ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%fromSC, OutputData%fromSC, (/OutputData%C_obj%fromSC_Len/)) - END IF - END IF - END SUBROUTINE SC_C2Fary_CopyOutput - - SUBROUTINE SC_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- fromSCglob Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%fromSCglob)) THEN - OutputData%c_obj%fromSCglob_Len = 0 - OutputData%c_obj%fromSCglob = C_NULL_PTR - ELSE - OutputData%c_obj%fromSCglob_Len = SIZE(OutputData%fromSCglob) - IF (OutputData%c_obj%fromSCglob_Len > 0) & - OutputData%c_obj%fromSCglob = C_LOC( OutputData%fromSCglob( LBOUND(OutputData%fromSCglob,1) ) ) - END IF - END IF - - ! -- fromSC Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%fromSC)) THEN - OutputData%c_obj%fromSC_Len = 0 - OutputData%c_obj%fromSC = C_NULL_PTR - ELSE - OutputData%c_obj%fromSC_Len = SIZE(OutputData%fromSC) - IF (OutputData%c_obj%fromSC_Len > 0) & - OutputData%c_obj%fromSC = C_LOC( OutputData%fromSC( LBOUND(OutputData%fromSC,1) ) ) - END IF - END IF - END SUBROUTINE SC_F2C_CopyOutput - - - SUBROUTINE SC_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(SC_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(SC_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SC_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL SC_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SC_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL SC_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE SC_Input_ExtrapInterp - - - SUBROUTINE SC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = u1, f(t2) = u2 -! -!.................................................................................................................................. - - TYPE(SC_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(SC_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(SC_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'SC_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) -IF (ASSOCIATED(u_out%toSCglob) .AND. ASSOCIATED(u1%toSCglob)) THEN - DO i1 = LBOUND(u_out%toSCglob,1),UBOUND(u_out%toSCglob,1) - b = -(u1%toSCglob(i1) - u2%toSCglob(i1)) - u_out%toSCglob(i1) = u1%toSCglob(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%toSC) .AND. ASSOCIATED(u1%toSC)) THEN - DO i1 = LBOUND(u_out%toSC,1),UBOUND(u_out%toSC,1) - b = -(u1%toSC(i1) - u2%toSC(i1)) - u_out%toSC(i1) = u1%toSC(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SC_Input_ExtrapInterp1 - - - SUBROUTINE SC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 -! -!.................................................................................................................................. - - TYPE(SC_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(SC_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(SC_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(SC_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SC_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ASSOCIATED(u_out%toSCglob) .AND. ASSOCIATED(u1%toSCglob)) THEN - DO i1 = LBOUND(u_out%toSCglob,1),UBOUND(u_out%toSCglob,1) - b = (t(3)**2*(u1%toSCglob(i1) - u2%toSCglob(i1)) + t(2)**2*(-u1%toSCglob(i1) + u3%toSCglob(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%toSCglob(i1) + t(3)*u2%toSCglob(i1) - t(2)*u3%toSCglob(i1) ) * scaleFactor - u_out%toSCglob(i1) = u1%toSCglob(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%toSC) .AND. ASSOCIATED(u1%toSC)) THEN - DO i1 = LBOUND(u_out%toSC,1),UBOUND(u_out%toSC,1) - b = (t(3)**2*(u1%toSC(i1) - u2%toSC(i1)) + t(2)**2*(-u1%toSC(i1) + u3%toSC(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%toSC(i1) + t(3)*u2%toSC(i1) - t(2)*u3%toSC(i1) ) * scaleFactor - u_out%toSC(i1) = u1%toSC(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SC_Input_ExtrapInterp2 - - - SUBROUTINE SC_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(SC_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(SC_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SC_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL SC_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SC_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL SC_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE SC_Output_ExtrapInterp - - - SUBROUTINE SC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = y1, f(t2) = y2 -! -!.................................................................................................................................. - - TYPE(SC_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(SC_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(SC_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'SC_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) -IF (ASSOCIATED(y_out%fromSCglob) .AND. ASSOCIATED(y1%fromSCglob)) THEN - DO i1 = LBOUND(y_out%fromSCglob,1),UBOUND(y_out%fromSCglob,1) - b = -(y1%fromSCglob(i1) - y2%fromSCglob(i1)) - y_out%fromSCglob(i1) = y1%fromSCglob(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%fromSC) .AND. ASSOCIATED(y1%fromSC)) THEN - DO i1 = LBOUND(y_out%fromSC,1),UBOUND(y_out%fromSC,1) - b = -(y1%fromSC(i1) - y2%fromSC(i1)) - y_out%fromSC(i1) = y1%fromSC(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SC_Output_ExtrapInterp1 - - - SUBROUTINE SC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 -! -!.................................................................................................................................. - - TYPE(SC_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(SC_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(SC_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(SC_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SC_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ASSOCIATED(y_out%fromSCglob) .AND. ASSOCIATED(y1%fromSCglob)) THEN - DO i1 = LBOUND(y_out%fromSCglob,1),UBOUND(y_out%fromSCglob,1) - b = (t(3)**2*(y1%fromSCglob(i1) - y2%fromSCglob(i1)) + t(2)**2*(-y1%fromSCglob(i1) + y3%fromSCglob(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%fromSCglob(i1) + t(3)*y2%fromSCglob(i1) - t(2)*y3%fromSCglob(i1) ) * scaleFactor - y_out%fromSCglob(i1) = y1%fromSCglob(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%fromSC) .AND. ASSOCIATED(y1%fromSC)) THEN - DO i1 = LBOUND(y_out%fromSC,1),UBOUND(y_out%fromSC,1) - b = (t(3)**2*(y1%fromSC(i1) - y2%fromSC(i1)) + t(2)**2*(-y1%fromSC(i1) + y3%fromSC(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%fromSC(i1) + t(3)*y2%fromSC(i1) - t(2)*y3%fromSC(i1) ) * scaleFactor - y_out%fromSC(i1) = y1%fromSC(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SC_Output_ExtrapInterp2 - -END MODULE SuperController_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/OpenFAST/modules/supercontroller/src/SuperController_Types.h b/OpenFAST/modules/supercontroller/src/SuperController_Types.h deleted file mode 100644 index 365cc9d1a..000000000 --- a/OpenFAST/modules/supercontroller/src/SuperController_Types.h +++ /dev/null @@ -1,99 +0,0 @@ -//!STARTOFREGISTRYGENERATEDFILE 'SuperController_Types.h' -//! -//! WARNING This file is generated automatically by the FAST registry. -//! Do not edit. Your changes to this file will be lost. -//! - -#ifndef _SuperController_TYPES_H -#define _SuperController_TYPES_H - - -#ifdef _WIN32 //define something for Windows (32-bit) -# include "stdbool.h" -# define CALL __declspec( dllexport ) -#elif _WIN64 //define something for Windows (64-bit) -# include "stdbool.h" -# define CALL __declspec( dllexport ) -#else -# include -# define CALL -#endif - - - typedef struct SC_InitInputType { - void * object ; - int nTurbines ; - char DLL_FileName[1024] ; - } SC_InitInputType_t ; - typedef struct SC_InitOutputType { - void * object ; - - int NumCtrl2SC ; - int nInpGlobal ; - int NumSC2Ctrl ; - int NumSC2CtrlGlob ; - } SC_InitOutputType_t ; - typedef struct SC_ParameterType { - void * object ; - double DT ; - int nTurbines ; - int NumCtrl2SC ; - int nInpGlobal ; - int NumSC2Ctrl ; - int NumSC2CtrlGlob ; - int NumStatesGlobal ; - int NumStatesTurbine ; - int NumParamGlobal ; - int NumParamTurbine ; - float * ParamGlobal ; int ParamGlobal_Len ; - float * ParamTurbine ; int ParamTurbine_Len ; - - } SC_ParameterType_t ; - typedef struct SC_DiscreteStateType { - void * object ; - float * Global ; int Global_Len ; - float * Turbine ; int Turbine_Len ; - } SC_DiscreteStateType_t ; - typedef struct SC_ContinuousStateType { - void * object ; - float Dummy ; - } SC_ContinuousStateType_t ; - typedef struct SC_ConstraintStateType { - void * object ; - float Dummy ; - } SC_ConstraintStateType_t ; - typedef struct SC_MiscVarType { - void * object ; - float Dummy ; - } SC_MiscVarType_t ; - typedef struct SC_OtherStateType { - void * object ; - int Dummy ; - } SC_OtherStateType_t ; - typedef struct SC_InputType { - void * object ; - float * toSCglob ; int toSCglob_Len ; - float * toSC ; int toSC_Len ; - } SC_InputType_t ; - typedef struct SC_OutputType { - void * object ; - float * fromSCglob ; int fromSCglob_Len ; - float * fromSC ; int fromSC_Len ; - } SC_OutputType_t ; - typedef struct SC_UserData { - SC_InitInputType_t SC_InitInput ; - SC_InitOutputType_t SC_InitOutput ; - SC_ParameterType_t SC_Param ; - SC_DiscreteStateType_t SC_DiscState ; - SC_ContinuousStateType_t SC_ContState ; - SC_ConstraintStateType_t SC_ConstrState ; - SC_MiscVarType_t SC_Misc ; - SC_OtherStateType_t SC_OtherState ; - SC_InputType_t SC_Input ; - SC_OutputType_t SC_Output ; - } SC_t ; - -#endif // _SuperController_TYPES_H - - -//!ENDOFREGISTRYGENERATEDFILE diff --git a/OpenFAST/modules/turbsim/CMakeLists.txt b/OpenFAST/modules/turbsim/CMakeLists.txt deleted file mode 100644 index 38a1cdb0b..000000000 --- a/OpenFAST/modules/turbsim/CMakeLists.txt +++ /dev/null @@ -1,33 +0,0 @@ -# -# Copyright 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. -# - -set(MODULE_SOURCES - src/BlankModVKM.f90 - src/CohStructures.f90 - src/Profiles.f90 - src/RandNum.f90 - src/Root_Searching.f90 - src/TS_FileIO.f90 - src/TSsubs.f90 - src/TurbSim.f90 - src/TurbSim_Types.f90 - src/VelocitySpectra.f90 - ) - -add_executable(turbsim ${MODULE_SOURCES}) -target_link_libraries(turbsim nwtclibs versioninfolib) - -install(TARGETS turbsim RUNTIME DESTINATION bin) diff --git a/OpenFAST/modules/turbsim/README.md b/OpenFAST/modules/turbsim/README.md deleted file mode 100644 index 0c79c2c5c..000000000 --- a/OpenFAST/modules/turbsim/README.md +++ /dev/null @@ -1,16 +0,0 @@ -# TurbSim Module -The legacy version of this module and additional documentation are available -at the [NWTC Software Portal](https://nwtc.nrel.gov/TurbSim/). - -## Overview -TurbSim is a stochastic, full-field, turbulent-wind simulator primarialy for -use with [InflowWind](https://nwtc.nrel.gov/InflowWind "InflowWind")-based -simulation tools. It uses a statistical model (as opposed to a physics-based -model) to numerically simulate time series of three-component wind-speed -vectors at points in a two-dimensional vertical rectangular grid that is fixed -in space. - -Spectra of velocity components and spatial coherence are defined in the -frequency domain, and an inverse Fourier transform produces time series. The -underlying theory behind this method of simulating time series assumes a -stationary process. diff --git a/OpenFAST/modules/turbsim/src/BlankModVKM.f90 b/OpenFAST/modules/turbsim/src/BlankModVKM.f90 deleted file mode 100644 index 67639b856..000000000 --- a/OpenFAST/modules/turbsim/src/BlankModVKM.f90 +++ /dev/null @@ -1,76 +0,0 @@ -MODULE ModifiedvKrm_mod - - USE NWTC_Library - - IMPLICIT NONE - -CONTAINS -!======================================================================= -SUBROUTINE Mod_vKrm ( Ht, Ucmp, Spec ) - - ! This subroutine defines the "Improved" von Karman PSD model. - ! The use of this subroutine requires that all variables have the units of meters and seconds. - IMPLICIT NONE - - !Passed variables - - REAL(ReKi), INTENT(IN) :: Ht ! height - REAL(ReKi), INTENT(IN) :: UCmp ! wind speed - REAL(ReKi), INTENT( OUT) :: Spec (:,:) - - Spec = 0.0_ReKi - -RETURN -END SUBROUTINE Mod_vKrm -!======================================================================= -SUBROUTINE ScaleMODVKM(Ht,UCmp, LambdaU, LambdaV, LambdaW) - -! THIS SUBROUTINE DEFINES HUB SCALE PARMS FOR Modified von KARMAN PSD MODEL - IMPLICIT NONE - - REAL(ReKi), INTENT(IN) :: Ht ! height - REAL(ReKi), INTENT(IN) :: UCmp ! wind speed - - REAL(ReKi) :: LambdaU - REAL(ReKi) :: LambdaV - REAL(ReKi) :: LambdaW - -RETURN -END SUBROUTINE ScaleMODVKM -!======================================================================= -FUNCTION FindZ0(z, sigma, U, f) - - ! This function is used in the Modified von Karman model to - ! determine the necessary surface roughness length for a given sigma. - IMPLICIT NONE - - REAL(ReKi) :: FindZ0 ! Estimated surface roughness length - REAL(ReKi),INTENT(IN) :: z ! Hub height - REAL(ReKi),INTENT(IN) :: sigma ! Target std deviation - REAL(ReKi),INTENT(IN) :: U ! Hub height wind speed - REAL(ReKi),INTENT(IN) :: f ! Coriolis parameter - - FindZ0 = 1.0 ! a default value - -RETURN -END FUNCTION FindZ0 -!======================================================================= -FUNCTION CalcDiff(z0Guess, z, sigma, U, f) - - ! This function calculates the difference between the specified - ! sigma and the calculated one. - IMPLICIT NONE - - REAL(ReKi) :: CalcDiff ! Output - will be nearly zero if surface roughness is correct - REAL(ReKi), INTENT(IN) :: z0Guess ! estimated surface roughness - REAL(ReKi), INTENT(IN) :: z ! Hub height (m) - REAL(ReKi), INTENT(IN) :: sigma ! Target standard deviation (m/s) - REAL(ReKi), INTENT(IN) :: U ! Mean hub-height wind speed (m/s) - REAL(ReKi), INTENT(IN) :: f ! Coriolis parameter - - CalcDiff = 0.0 - -RETURN -END FUNCTION CalcDiff -!======================================================================= -END MODULE ModifiedvKrm_mod diff --git a/OpenFAST/modules/turbsim/src/CohStructures.f90 b/OpenFAST/modules/turbsim/src/CohStructures.f90 deleted file mode 100644 index 9c1ad5214..000000000 --- a/OpenFAST/modules/turbsim/src/CohStructures.f90 +++ /dev/null @@ -1,901 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2014, 2016 National Renewable Energy Laboratory -! -! This file is part of TurbSim. -! -! 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. -! -!********************************************************************************************************************************** -MODULE TS_CohStructures - - USE TurbSim_Types - - use TS_Profiles - use TS_RandNum - - IMPLICIT NONE - - - REAL(ReKi), PARAMETER :: KHT_LES_dT = 0.036335 ! The average time step in the LES test file, used here for the KH test - REAL(ReKi), PARAMETER :: KHT_LES_Zm = 6.35475 ! The non-dimensional z dimension defined in LES test file, used here for the KH test - - TYPE :: Event ! Coherent turbulent event to add to the background wind - INTEGER :: EventNum ! The event number (index into EventID() array) - REAL(ReKi) :: TStart ! The time at which to add this event - REAL(ReKi) :: delt ! The delta time before the event begins (for interpolation in AeroDyn) - LOGICAL :: Connect2Prev = .FALSE. ! Whether this event is connected to the next, otherwise there is space between them - TYPE(Event), POINTER :: Next => NULL() ! The next event to add - END TYPE - - TYPE :: CohStr_OutputType - REAL(ReKi) :: CTKE ! Maximum predicted Coherent Turbulent Kenetic Energy at the center of the billow - REAL(ReKi) :: lambda ! The expected value of interarrival times for the Poisson process - INTEGER(IntKi) :: NumCTEvents ! Number of events to be inserted into the .cts file - INTEGER(IntKi) :: NumCTEvents_separate ! Number of separate events inserted into the .cts file (# events with .Connect2Prev = .false.) - REAL(ReKi) :: ExpectedTime ! Amount of time the coherent structures should take - REAL(ReKi) :: EventTimeSum ! Amount of time the coherent structure takes - REAL(ReKi) :: EventTimeStep ! The average length of timesteps in output events - - REAL(ReKi) :: Zbottom ! The height of the lowest point on the grid (before tower points are added), equal to Z(1) - REAL(ReKi) :: ScaleWid ! Scaling width for LE coherent turbulence (RotDiam in AeroDyn FD_Wind) - REAL(ReKi) :: ScaleVel ! Scaling velocity for LE coherent turbulence, U0. 2*U0 is the difference in wind speed between the top and bottom of the wave. - - REAL(ReKi) :: Uwave ! Wind speed at center of the k-h billow (wave) - REAL(ReKi) :: Wsig ! Standard deviation of the w-component wind speed - - - INTEGER(IntKi) :: NumCTt ! Number of data points to be printed in the output coherent event timestep file - - TYPE (Event), POINTER :: PtrHead => NULL() ! Pointer to the first event - TYPE (Event), POINTER :: PtrTail => NULL() ! Pointer to the last event - - END TYPE CohStr_OutputType - - - ! local type, used only in two subroutines here - TYPE :: CohStr_EventType - - REAL(ReKi) :: Ym_max ! The nondimensional lateral width of the coherent turbulence dataset - REAL(ReKi) :: Zm_max ! The nondimensional vertical height of the coherent turbulence dataset - - REAL(ReKi), ALLOCATABLE :: pkCTKE (:) ! Array containing the peak CTKE of each coherent event - REAL(ReKi), ALLOCATABLE :: EventLen (:) ! The length of each event stored in EventStart() (non-dimensional time) - INTEGER(IntKi), ALLOCATABLE :: EventID (:) ! The timestep where the event starts, which determines the name of the event file - INTEGER(IntKi), ALLOCATABLE :: EventTS (:) ! The length of each event stored in EventStart() (number of timesteps) - INTEGER(IntKi) :: NumEvents ! Number of events in the event data file (length of the Event* arrays) - - END TYPE CohStr_EventType - - - -CONTAINS - -!======================================================================= -SUBROUTINE CohStr_ReadEventFile( p_CohStr, y_CohStr, e_CohStr, TSclFact, ErrStat, ErrMsg ) - - ! This subroutine reads the events definitions from the event data file - - - IMPLICIT NONE - - - ! Passed Variables - -TYPE(CohStr_ParameterType), INTENT(IN ) :: p_CohStr -TYPE(CohStr_OutputType), INTENT(INOUT) :: y_CohStr -TYPE(CohStr_EventType), INTENT( OUT) :: e_CohStr - -!REAL(ReKi), INTENT(IN) :: CTKE ! Predicted maximum CTKE -!REAL(ReKi), INTENT(INOUT) :: ScaleVel ! The shear we're scaling for -!REAL(ReKi), INTENT(IN) :: ScaleWid ! The height of the wave we're scaling with -REAL(ReKi), INTENT( OUT) :: TsclFact ! Scale factor for time (h/U0) in coherent turbulence events -INTEGER(IntKi), intent( out) :: ErrStat ! Error level -CHARACTER(*), intent( out) :: ErrMsg ! Message describing error - - ! Local variables -REAL(ReKi) :: MaxEvtCTKE ! The maximum CTKE in the dataset of events - -INTEGER :: I ! DO loop counter -INTEGER :: IOS ! I/O Status -INTEGER :: Un ! I/O Unit - -INTEGER(IntKi) :: ErrStat2 ! Error level (local) -CHARACTER(MaxMsgLen) :: ErrMsg2 ! Message describing error (local) - - - ErrStat = ErrID_None - ErrMsg = "" - - MaxEvtCTKE = 0.0 ! initialize the MAX variable - - CALL GetNewUnit( Un, ErrStat2, ErrMsg2 ) - - CALL OpenFInpFile ( Un, p_CohStr%CTEventFile, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CohStr_ReadEventFile') - IF (ErrStat >= AbortErrLev) RETURN - - - ! Read the nondimensional lateral width of the dataset, Ym_max - - CALL ReadVar( Un, p_CohStr%CTEventFile, e_CohStr%Ym_max, "Ym_max", "Nondimensional lateral dataset width", ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CohStr_ReadEventFile') - - ! Read the nondimensional vertical height of the dataset, Zm_max - - CALL ReadVar( Un, p_CohStr%CTEventFile, e_CohStr%Zm_max, "Zm_max", "Nondimensional vertical dataset height", ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CohStr_ReadEventFile') - - - ! Read the rest of the header - - CALL ReadVar( Un, p_CohStr%CTEventFile, e_CohStr%NumEvents, "NumEvents", "the number of coherent structures.", ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CohStr_ReadEventFile') - - - IF (ErrStat >= AbortErrLev) THEN - CLOSE(Un) - RETURN - END IF - - - IF ( e_CohStr%NumEvents > 0 ) THEN - - - CALL AllocAry( e_CohStr%EventID, e_CohStr%NumEvents , 'EventID', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'CohStr_ReadEventFile') - CALL AllocAry( e_CohStr%EventTS, e_CohStr%NumEvents , 'EventTS', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'CohStr_ReadEventFile') - CALL AllocAry( e_CohStr%EventLen, e_CohStr%NumEvents , 'EventLen', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'CohStr_ReadEventFile') - CALL AllocAry( e_CohStr%pkCTKE, e_CohStr%NumEvents , 'pkCTKE', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'CohStr_ReadEventFile') - - IF (ErrStat >= AbortErrLev) THEN - CLOSE(Un) - RETURN - END IF - - ! Read the last header lines - - CALL ReadCom( Un, p_CohStr%CTEventFile, 'the fourth header line', ErrStat2, ErrMsg2) ! A blank line - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CohStr_ReadEventFile') - CALL ReadCom( Un, p_CohStr%CTEventFile, 'the fifth header line', ErrStat2, ErrMsg2) ! The column heading lines - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CohStr_ReadEventFile') - - - ! Read the event definitions and scale times by TScale - - DO I=1,e_CohStr%NumEvents - - READ ( Un, *, IOSTAT=IOS ) e_CohStr%EventID(I), e_CohStr%EventTS(I), e_CohStr%EventLen(I), e_CohStr%pkCTKE(I) - - IF ( IOS /= 0 ) THEN - CALL SetErrStat(ErrID_Fatal, 'Error reading event '//TRIM( Int2LStr( I ) )//' from the coherent event data file.', ErrStat, ErrMsg, 'CohStr_ReadEventFile') - CLOSE(UN) - RETURN - ENDIF - MaxEvtCTKE = MAX( MaxEvtCTKE, e_CohStr%pkCTKE(I) ) - - ENDDO - - IF ( MaxEvtCTKE > 0.0 ) THEN - y_CohStr%ScaleVel = MAX( y_CohStr%ScaleVel, SQRT( y_CohStr%CTKE / MaxEvtCTKE ) ) - ! Calculate the Velocity Scale Factor, based on the requested maximum CTKE - ENDIF - - ! Calculate the TimeScaleFactor, based on the Zm_max in the Events file. - - TSclFact = y_CohStr%ScaleWid / (y_CohStr%ScaleVel * e_CohStr%Zm_max) - - ! Scale the time based on TSclFact - - DO I=1,e_CohStr%NumEvents - e_CohStr%EventLen(I) = e_CohStr%EventLen(I)*TSclFact - ENDDO - - ELSE - - TSclFact = y_CohStr%ScaleWid / (y_CohStr%ScaleVel * e_CohStr%Zm_max) - - ENDIF ! FileNum > 0 - - CLOSE ( Un ) - -END SUBROUTINE CohStr_ReadEventFile -!======================================================================= -SUBROUTINE CohStr_CalcEvents( p, e_CohStr, Height, OtherSt_RandNum, y_cohStr, ErrStat, ErrMsg ) - - ! This subroutine calculates what events to use and when to use them. - ! It computes the number of timesteps in the file, NumCTt. - - IMPLICIT NONE - - ! passed variables - TYPE(TurbSim_ParameterType), INTENT(IN) :: P - TYPE(CohStr_EventType) , INTENT(IN) :: e_CohStr ! event parameters for coherent structures - REAL(ReKi), INTENT(IN) :: Height ! Height for expected length PDF equation - TYPE(RandNum_OtherStateType), INTENT(INOUT) :: OtherSt_RandNum ! other states for random numbers (next seed, etc) - TYPE(CohStr_OutputType), INTENT(INOUT) :: y_CohStr - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error level - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Message describing error - - ! local variables -REAL(ReKi) :: iA ! Variable used to calculate IAT -REAL(ReKi) :: iB ! Variable used to calculate IAT -REAL(ReKi) :: iC ! Variable used to calculate IAT -REAL(ReKi) :: rn ! random number -REAL(ReKi) :: TEnd ! End time for the current event -REAL(ReKi) :: TStartNext = 0.0 ! temporary start time for next event -REAL(ReKi) :: MaxCTKE ! Maximum CTKE of events we've picked - -INTEGER :: ErrStat2 ! temp error status -INTEGER :: NewEvent ! event number of the new event -INTEGER :: NumCompared ! Number of events we've compared - -LOGICAL(1) :: Inserted ! Whether an event was inserted here - -TYPE(Event), POINTER :: PtrCurr => NULL() ! Pointer to the current event in the list -TYPE(Event), POINTER :: PtrNew => NULL() ! A new event to be inserted into the list - - - ErrStat = ErrID_None - ErrMsg = "" - - ! Compute the mean interarrival time and the expected length of events - - SELECT CASE ( p%met%TurbModel_ID ) - - CASE ( SpecModel_NWTCUP, SpecModel_NONE, SpecModel_USRVKM ) - y_CohStr%lambda = -0.000904*p%met%Rich_No + 0.000562*y_CohStr%Uwave + 0.001389 - y_CohStr%lambda = 1.0 / y_CohStr%lambda - - IF ( p%met%TurbModel_ID == SpecModel_NONE ) THEN - y_CohStr%ExpectedTime = 600.0 - ELSE - CALL RndModLogNorm( p%RNG, OtherSt_RandNum, y_CohStr%ExpectedTime, Height ) - ENDIF - - CASE ( SpecModel_GP_LLJ, SpecModel_SMOOTH, SpecModel_TIDAL, SpecModel_RIVER) ! HYDRO: added 'TIDAL' and 'RIVER' to the spectral models that get handled this way. - iA = 0.001797800 + (7.17399E-10)*Height**3.021144723 - iB = EXP(-10.590340100 - (4.92440E-05)*Height**2.5) - iC = SQRT( 3.655013599 + (8.91203E-06)*Height**3 ) - y_CohStr%lambda = iA + iB*MIN( (y_CohStr%Uwave**iC), HUGE(iC) ) ! lambda = iA + iB*(WindSpeed**iC) - y_CohStr%lambda = 1.0 / y_CohStr%lambda - - CALL RndTcohLLJ( p%RNG, OtherSt_RandNum, y_CohStr%ExpectedTime, Height ) - - CASE ( SpecModel_WF_UPW ) - y_CohStr%lambda = 0.000529*y_CohStr%Uwave + 0.000365*p%met%Rich_No - 0.000596 - y_CohStr%lambda = 1.0 / y_CohStr%lambda - - CALL RndTcoh_WF( p%RNG, OtherSt_RandNum, y_CohStr%ExpectedTime, SpecModel_WF_UPW ) - - CASE ( SpecModel_WF_07D ) - y_CohStr%lambda = 0.000813*y_CohStr%Uwave - 0.002642*p%met%Rich_No + 0.002676 - y_CohStr%lambda = 1.0 / y_CohStr%lambda - - CALL RndTcoh_WF( p%RNG, OtherSt_RandNum, y_CohStr%ExpectedTime, SpecModel_WF_07D ) - - CASE ( SpecModel_WF_14D ) - y_CohStr%lambda = 0.001003*y_CohStr%Uwave - 0.00254*p%met%Rich_No - 0.000984 - y_CohStr%lambda = 1.0 / y_CohStr%lambda - - CALL RndTcoh_WF( p%RNG, OtherSt_RandNum, y_CohStr%ExpectedTime, SpecModel_WF_14D ) - - CASE DEFAULT - !This should not happen - - END SELECT - - y_CohStr%ExpectedTime = y_CohStr%ExpectedTime * ( p%grid%UsableTime - p%CohStr%CTStartTime ) / 600.0_ReKi ! Scale for use with the amount of time we've been given - - -!BONNIE: PERHAPS WE SHOULD JUST PUT IN A CHECK THAT TURNS OFF THE COHERENT TIME STEP FILE IF THE -! CTSTARTTIME IS LESS THAN THE USABLETIME... MAYBE WHEN WE'RE READING THE INPUT FILE... -y_CohStr%ExpectedTime = MAX( y_CohStr%ExpectedTime, 0.0_ReKi ) ! This occurs if CTStartTime = 0 - - ! We start by adding events at random times - - y_CohStr%NumCTEvents = 0 ! Number of events = length of our linked list - y_CohStr%NumCTt = 0 ! Total number of time steps in the events we've picked - MaxCTKE = 0.0 ! Find the maximum CTKE for the events that we've selected - - y_CohStr%EventTimeSum = 0.0 - - CALL RndExp(p%RNG, OtherSt_RandNum, rn, y_CohStr%lambda) ! Assume the last event ended at time zero - - TStartNext = rn / 2.0 - - IF ( p%met%KHtest ) THEN - y_CohStr%ExpectedTime = p%grid%UsableTime / 2 ! When testing, add coherent events for half of the record - TStartNext = y_CohStr%ExpectedTime / 2 ! When testing, start about a quarter of the way into the record - ENDIF - - IF ( TStartNext < p%CohStr%CTStartTime ) THEN - TStartNext = TStartNext + p%CohStr%CTStartTime ! Make sure the events start after time specified by CTStartTime - ENDIF - - IF ( TStartNext > 0 ) y_CohStr%NumCTt = y_CohStr%NumCTt + 1 ! Add a point before the first event - - DO WHILE ( TStartNext < p%grid%UsableTime .AND. y_CohStr%EventTimeSum < y_CohStr%ExpectedTime ) - - CALL RndUnif( p%RNG, OtherSt_RandNum, rn ) - - NewEvent = INT( rn*( e_CohStr%NumEvents - 1 ) ) + 1 - NewEvent = MAX( 1, MIN( NewEvent, e_CohStr%NumEvents ) ) ! take care of possible rounding issues.... - - - IF ( .NOT. ASSOCIATED ( y_CohStr%PtrHead ) ) THEN - - ALLOCATE ( y_CohStr%PtrHead, STAT=ErrStat2 ) ! The pointer %Next is nullified in allocation - - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for new event.' , ErrStat, ErrMsg, 'CohStr_CalcEvents') - RETURN - ENDIF - - y_CohStr%PtrTail => y_CohStr%PtrHead - - ELSE - - ALLOCATE ( y_CohStr%PtrTail%Next, STAT=ErrStat2 ) ! The pointer PtrTail%Next%Next is nullified in allocation - - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for new event.' , ErrStat, ErrMsg, 'CohStr_CalcEvents') - RETURN - ENDIF - - y_CohStr%PtrTail => y_CohStr%PtrTail%Next ! Move the pointer to point to the last record in the list - - ENDIF - - y_CohStr%PtrTail%EventNum = NewEvent - y_CohStr%PtrTail%TStart = TStartNext - y_CohStr%PtrTail%delt = e_CohStr%EventLen( NewEvent ) / e_CohStr%EventTS( NewEvent ) ! the average delta time in the event - y_CohStr%PtrTail%Connect2Prev = .FALSE. - - MaxCTKE = MAX( MaxCTKE, e_CohStr%pkCTKE( NewEvent ) ) - y_CohStr%NumCTEvents = y_CohStr%NumCTEvents + 1 - - TEnd = TStartNext + e_CohStr%EventLen( NewEvent ) - - - IF ( p%met%KHtest ) THEN - TStartNext = p%grid%UsableTime + TStartNext !TEnd + PtrTail%delt ! Add the events right after each other - ELSE - - DO WHILE ( TStartNext <= TEnd ) - - CALL RndExp(p%RNG, OtherSt_RandNum, rn, y_CohStr%lambda) ! compute the interarrival time - TStartNext = TStartNext + rn !+ EventLen( NewEvent ) - - ENDDO - - ENDIF - - - IF ( (TStartNext - TEnd) > y_CohStr%PtrTail%delt ) THEN - y_CohStr%NumCTt = y_CohStr%NumCTt + e_CohStr%EventTS( NewEvent ) + 2 ! add a zero-line (essentially a break between events) - ELSE - y_CohStr%NumCTt = y_CohStr%NumCTt + e_CohStr%EventTS( NewEvent ) + 1 - ENDIF - - y_CohStr%EventTimeSum = y_CohStr%EventTimeSum + e_CohStr%EventLen( NewEvent ) - - ENDDO - - y_CohStr%NumCTEvents_separate = y_CohStr%NumCTEvents - - ! Next, we start concatenating events until there is no space or we exceed the expected time - - IF ( p%met%TurbModel_ID /= SpecModel_NONE ) THEN - - NumCompared = 0 - - DO WHILE ( y_CohStr%EventTimeSum < y_CohStr%ExpectedTime .AND. NumCompared < y_CohStr%NumCTEvents ) - - CALL RndUnif( p%RNG, OtherSt_RandNum, rn ) - - NewEvent = INT( rn*( e_CohStr%NumEvents - 1.0 ) ) + 1 - NewEvent = MAX( 1, MIN( NewEvent, e_CohStr%NumEvents ) ) ! take care of possible rounding issues.... - - NumCompared = 0 - Inserted = .FALSE. - - DO WHILE ( NumCompared < y_CohStr%NumCTEvents .AND. .NOT. Inserted ) - - IF ( .NOT. ASSOCIATED ( PtrCurr ) ) THEN ! Wrap around to the beginning of the list - PtrCurr => y_CohStr%PtrHead - ENDIF - - - ! See if the NewEvent fits between the end of event pointed to by PtrCurr and the - ! beginning of the event pointed to by PtrCurr%Next - - IF ( ASSOCIATED( PtrCurr%Next ) ) THEN - TStartNext = PtrCurr%Next%TStart - ELSE !We're starting after the last event in the record - TStartNext = p%grid%UsableTime + 0.5 * e_CohStr%EventLen( NewEvent ) ! We can go a little beyond the end... - ENDIF - - IF ( TStartNext - (PtrCurr%TStart + e_CohStr%EventLen( PtrCurr%EventNum ) + PtrCurr%delt) > e_CohStr%EventLen( NewEvent ) ) THEN - - Inserted = .TRUE. - - ALLOCATE ( PtrNew, STAT=ErrStat2 ) ! The pointer %Next is nullified in allocation - - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for new event.' , ErrStat, ErrMsg, 'CohStr_CalcEvents') - ENDIF - - PtrNew%EventNum = NewEvent - PtrNew%TStart = PtrCurr%TStart + e_CohStr%EventLen( PtrCurr%EventNum ) - PtrNew%delt = e_CohStr%EventLen( NewEvent ) / e_CohStr%EventTS( NewEvent ) ! the average delta time in the event - PtrNew%Connect2Prev = .TRUE. - - PtrNew%Next => PtrCurr%Next - PtrCurr%Next => PtrNew - PtrCurr => PtrCurr%Next ! Let's try to add the next event after the other events - - MaxCTKE = MAX( MaxCTKE, e_CohStr%pkCTKE( NewEvent ) ) - y_CohStr%NumCTEvents = y_CohStr%NumCTEvents + 1 - y_CohStr%NumCTt = y_CohStr%NumCTt + e_CohStr%EventTS( NewEvent ) ! there is no break between events - !(we may have one too many NumCTt here, so we'll deal with it when we write the file later) - y_CohStr%EventTimeSum = y_CohStr%EventTimeSum + e_CohStr%EventLen( NewEvent ) - - - ELSE - - NumCompared = NumCompared + 1 - - ENDIF - - PtrCurr => PtrCurr%Next - - ENDDO ! WHILE (NumCompared < NumCTEvents .AND. .NOT. Inserted) - - ENDDO ! WHILE (EventTimeSum < ExpectedTime .AND. NumCompared < NumCTEvents) - - ENDIF ! SpecModel /= SpecModel_NONE - - IF ( y_CohStr%NumCTt > 0 ) THEN - y_CohStr%EventTimeStep = y_CohStr%EventTimeSum / y_CohStr%NumCTt ! Average timestep of coherent event data - ELSE - y_CohStr%EventTimeStep = 0.0 - ENDIF - - -END SUBROUTINE CohStr_CalcEvents -!======================================================================= -!> This subroutine writes the coherent events CTS file -SUBROUTINE CohStr_WriteCTS(p, WSig, OtherSt_RandNum, ErrStat, ErrMsg) - - TYPE(TurbSim_ParameterType), INTENT(IN ) :: p ! parameters for TurbSim (out only b/c it doesn't generate file for certain cases...) - TYPE(RandNum_OtherStateType), INTENT(INOUT) :: OtherSt_RandNum ! other states for random numbers (next seed, etc) - REAL(ReKi), intent(in ) :: WSig ! Standard deviation of the vertical component - - INTEGER(IntKi), intent( out) :: ErrStat ! Error level - CHARACTER(*), intent( out) :: ErrMsg ! Message describing error - - - ! local variables - TYPE(CohStr_OutputType) :: y_CohStr - type(CohStr_EventType) :: e_CohStr ! coherent structure events - REAL(ReKi) :: TmpVel ! A temporary variable holding a velocity - REAL(ReKi) :: TmpRndNum ! A temporary variable holding a random variate - REAL(ReKi) :: TsclFact ! Scale factor for time (h/U0) in coherent turbulence events - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(MaxMsgLen) :: ErrMsg2 - - - - ErrStat = ErrID_None - ErrMsg = "" - - y_CohStr%WSig=WSig - - - CALL WrScr ( ' Generating coherent turbulent time step file "'//TRIM( p%RootName )//'.cts"' ) - - - y_CohStr%ScaleWid = p%grid%RotorDiameter * p%CohStr%DistScl ! This is the scaled height of the coherent event data set - y_CohStr%Zbottom = p%grid%HubHt - p%CohStr%CTLz*y_CohStr%ScaleWid ! This is the height of the bottom of the wave in the scaled/shifted coherent event data set - - CALL getVelocity(p, p%UHub,p%grid%HubHt,y_CohStr%Zbottom + 0.5_ReKi*y_CohStr%ScaleWid, y_CohStr%Uwave, ErrStat2, ErrMsg2) ! y_CohStr%Uwave =WindSpeed at center of wave - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CohStr_WriteCTS') - - !------------------------- - ! compute ScaleVel: - !------------------------- - - IF ( p%met%KHtest ) THEN - ! for LES test case.... - y_CohStr%ScaleVel = y_CohStr%ScaleWid * KHT_LES_dT / KHT_LES_Zm - y_CohStr%ScaleVel = 50 * y_CohStr%ScaleVel ! We want 25 hz bandwidth so multiply by 50 - ELSE - - CALL getVelocity(p, p%UHub,p%grid%HubHt,y_CohStr%Zbottom, TmpVel, ErrStat2, ErrMsg2) ! Velocity at bottom of billow - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CohStr_WriteCTS') - CALL getVelocity(p, p%UHub,p%grid%HubHt,y_CohStr%Zbottom+y_CohStr%ScaleWid, y_CohStr%ScaleVel, ErrStat2, ErrMsg2) ! Velocity at the top of the billow - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CohStr_WriteCTS') - - y_CohStr%ScaleVel = y_CohStr%ScaleVel - TmpVel ! Shear across the wave - y_CohStr%ScaleVel = 0.5 * y_CohStr%ScaleVel ! U0 is half the difference between the top and bottom of the billow - - - ! If the coherent structures do not cover the whole disk, increase the shear - - IF ( p%CohStr%DistScl < 1.0 ) THEN ! Increase the shear by up to two when the wave is half the size of the disk... - CALL RndUnif( p%RNG, OtherSt_RandNum, TmpRndNum ) !returns TmpRndNum, a random variate - y_CohStr%ScaleVel = y_CohStr%ScaleVel * ( 1.0 + TmpRndNum * (1 - p%CohStr%DistScl) / p%CohStr%DistScl ) - ENDIF - - !Apply a scaling factor to account for short inter-arrival times getting wiped out due to long events - - y_CohStr%ScaleVel = y_CohStr%ScaleVel*( 1.0 + 323.1429 * EXP( -MAX(y_CohStr%Uwave,10.0_ReKi) / 2.16617 ) ) - - ENDIF - - IF (y_CohStr%ScaleVel < 0. ) THEN - CALL SetErrStat( ErrID_Warn, 'A coherent turbulence time step file cannot be generated with negative shear.', ErrStat, ErrMsg, 'CohStr_WriteCTS') - !p%WrFile(FileExt_CTS) = .FALSE. - RETURN - ENDIF - - - !------------------------- - ! compute maximum predicted CTKE: - !------------------------- - - SELECT CASE ( p%met%TurbModel_ID ) - - CASE ( SpecModel_NWTCUP, SpecModel_NONE, SpecModel_USRVKM ) - - IF (p%met%KHtest) THEN - y_CohStr%CTKE = 30.0 !Scale for large coherence - CALL RndNWTCpkCTKE( p%RNG, OtherSt_RandNum, y_CohStr%CTKE ) - ELSE - - ! Increase the Scaling Velocity for computing U,V,W in AeroDyn - ! These numbers are based on LIST/ART data (58m-level sonic anemometer) - - y_CohStr%CTKE = 0.616055*p%met%Rich_No - 0.242143*y_CohStr%Uwave + 23.921801*y_CohStr%WSig - 11.082978 - - ! Add up to +/- 10% or +/- 6 m^2/s^2 (uniform distribution) - CALL RndUnif( p%RNG, OtherSt_RandNum, TmpRndNum ) - y_CohStr%CTKE = MAX( y_CohStr%CTKE + (2.0_ReKi * TmpRndNum - 1.0_ReKi) * 6.0_ReKi, 0.0_ReKi ) - - IF ( y_CohStr%CTKE > 0.0 ) THEN - IF ( y_CohStr%CTKE > 20.0) THEN ! Correct with residual - y_CohStr%CTKE = y_CohStr%CTKE + ( 0.11749127 * (y_CohStr%CTKE**1.369025) - 7.5976449 ) - ENDIF - - IF ( y_CohStr%CTKE >= 30.0 .AND. p%met%Rich_No >= 0.0 .AND. p%met%Rich_No <= 0.05 ) THEN - CALL RndNWTCpkCTKE( p%RNG, OtherSt_RandNum, y_CohStr%CTKE ) - ENDIF - ENDIF - - ENDIF !p%met%KHtest - - CASE ( SpecModel_GP_LLJ, SpecModel_SMOOTH, SpecModel_TIDAL, SpecModel_RIVER ) - - y_CohStr%CTKE = pkCTKE_LLJ( p, OtherSt_RandNum, y_CohStr%Zbottom+0.5_ReKi*y_CohStr%ScaleWid, p%met%ZL, p%met%UStar ) - - CASE ( SpecModel_WF_UPW ) - y_CohStr%CTKE = -2.964523*p%met%Rich_No - 0.207382*y_CohStr%Uwave + 25.640037*y_CohStr%WSig - 10.832925 - - CASE ( SpecModel_WF_07D ) - y_CohStr%CTKE = 9.276618*p%met%Rich_No + 6.557176*p%met%Ustar + 3.779539*y_CohStr%WSig - 0.106633 - - IF ( (p%met%Rich_No > -0.025) .AND. (p%met%Rich_No < 0.05) .AND. (p%met%Ustar > 1.0) .AND. (p%met%Ustar < 1.56) ) THEN - CALL RndpkCTKE_WFTA( p%RNG, OtherSt_RandNum, TmpRndNum ) ! Add a random residual - y_CohStr%CTKE = y_CohStr%CTKE + TmpRndNum - ENDIF - - - CASE ( SpecModel_WF_14D ) - y_CohStr%CTKE = 1.667367*p%met%Rich_No - 0.003063*y_CohStr%Uwave + 19.653682*y_CohStr%WSig - 11.808237 - - CASE DEFAULT ! This case should not happen - CALL SetErrStat( ErrID_Fatal, 'Invalid turbulence model in coherent structure analysis.', ErrStat, ErrMsg, 'CohStr_WriteCTS') - CALL Cleanup() - RETURN - END SELECT - - y_CohStr%CTKE = MAX( y_CohStr%CTKE, 1.0_ReKi ) ! make sure CTKE is not negative and, so that we don't divide by zero in ReadEventFile, set it to some arbitrary low number - - !------------------------- - ! Read and allocate coherent event start times and lengths, calculate TSclFact: - !------------------------- - CALL CohStr_ReadEventFile( p%CohStr, y_CohStr, e_CohStr, TSclFact, ErrStat2, ErrMsg2 ) !y_CohStr%%ScaleWid, y_CohStr%ScaleVel - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CohStr_WriteCTS') - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - CALL CohStr_CalcEvents( p, e_CohStr, y_CohStr%Zbottom+0.5_ReKi*y_CohStr%ScaleWid, OtherSt_RandNum, y_cohStr, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CohStr_WriteCTS') - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - !------------------------- - ! Write the file: - !------------------------- - - CALL CohStr_WriteEvents ( p%RootName, p%CohStr, e_CohStr, y_CohStr, TSclFact, p%UHub, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CohStr_WriteCTS') - - - !------------------------- - ! Write some summary information: - !------------------------- - IF (p%met%KHtest) THEN - WRITE ( p%US,'(/)' ) - ELSE - WRITE ( p%US,'(//A,F8.3," seconds")' ) 'Average expected time between events = ',y_CohStr%lambda - ENDIF - - WRITE ( p%US, '(A,I8)' ) 'Number of coherent events = ', y_CohStr%NumCTEvents_separate - WRITE ( p%US, '(A,F8.3," seconds")') 'Predicted length of coherent events = ', y_CohStr%ExpectedTime - WRITE ( p%US, '(A,F8.3," seconds")') 'Length of coherent events = ', y_CohStr%EventTimeSum - WRITE ( p%US, '(A,F8.3," (m/s)^2")') 'Maximum predicted event CTKE = ', y_CohStr%CTKE -IF ( y_CohStr%EventTimeStep > 0.0_ReKi ) THEN - WRITE ( p%US, '(A,F8.3," Hz")' ) 'Nyquist frequency of coherent events = ', 0.5_ReKi / y_CohStr%EventTimeStep -ENDIF - - - !------------------------- - ! Deallocate the coherent event arrays. - !------------------------- - CALL Cleanup() - RETURN - -CONTAINS - SUBROUTINE Cleanup() - IF ( ALLOCATED( e_CohStr%EventID ) ) DEALLOCATE( e_CohStr%EventID ) - IF ( ALLOCATED( e_CohStr%EventTS ) ) DEALLOCATE( e_CohStr%EventTS ) - IF ( ALLOCATED( e_CohStr%EventLen ) ) DEALLOCATE( e_CohStr%EventLen ) - IF ( ALLOCATED( e_CohStr%pkCTKE ) ) DEALLOCATE( e_CohStr%pkCTKE ) - END SUBROUTINE Cleanup - -END SUBROUTINE CohStr_WriteCTS -!======================================================================= -FUNCTION pkCTKE_LLJ(p, OtherSt_RandNum, Ht, ZL, UStar) - - IMPLICIT NONE - - TYPE(TurbSim_ParameterType), INTENT(IN ):: p ! parameters - TYPE(RandNum_OtherStateType), INTENT(INOUT):: OtherSt_RandNum ! other states for random numbers (next seed, etc) - REAL(ReKi), INTENT(IN) :: Ht ! The height at the billow center - REAL(ReKi), INTENT(IN) :: ZL ! The height at the billow center - REAL(ReKi), INTENT(IN) :: Ustar ! The height at the billow center - - ! local variables - - REAL(ReKi) :: A ! A constant/offset term in the pkCTKE calculation - REAL(ReKi) :: A_uSt ! The scaling term for Ustar - REAL(ReKi) :: A_zL ! The scaling term for z/L - REAL(ReKi) :: pkCTKE_LLJ ! The max CTKE expected for LLJ coh structures - REAL(ReKi) :: rndCTKE ! The random residual - - REAL(ReKi), PARAMETER :: RndParms(5) = (/0.252510525, -0.67391279, 2.374794977, 1.920555797, -0.93417558/) ! parameters for the Pearson IV random residual - REAL(ReKi), PARAMETER :: z_Ary(4) = (/54., 67., 85., 116./) ! Aneomoeter heights - - INTEGER :: Zindx_mn (1) - - - - Zindx_mn = MINLOC( ABS(z_Ary-Ht) ) - - SELECT CASE ( Zindx_mn(1) ) - CASE ( 1 ) ! 54 m - A = -0.051 - A_zL = -0.0384 - A_uSt = 9.9710 - - CASE ( 2 ) ! 67 m - A = -0.054 - A_zL = -0.1330 - A_uSt = 10.2460 - - CASE ( 3 ) ! 85 m - A = -0.062 - A_zL = -0.1320 - A_uSt = 10.1660 - - CASE ( 4 ) !116 m - A = -0.092 - A_zL = -0.3330 - A_uSt = 10.7640 - - !CASE DEFAULT !This should not occur - ! ErrStat = ErrID_Fatal - ! ErrMsg = 'Error in pkCTKE_LLJ():: Height index is invalid.' - END SELECT - - CALL RndPearsonIV( p%RNG, OtherSt_RandNum, rndCTKE, RndParms, (/ -10.0_ReKi, 17.5_ReKi /) ) - - pkCTKE_LLJ = MAX(0.0_ReKi, A + A_uSt*UStar + A_zL*ZL + rndCTKE) - -END FUNCTION pkCTKE_LLJ -!======================================================================= -SUBROUTINE CohStr_WriteEvents( RootName, p_CohStr, e_CohStr, y_CohStr, TScale, UHub, ErrStat, ErrMsg ) - - ! This subroutine writes the events as calculated in CalcEvents. - - IMPLICIT NONE - - ! Passed Variables - TYPE(CohStr_ParameterType) , INTENT(IN ) :: p_CohStr ! parameters for coherent structures - TYPE(CohStr_EventType) , INTENT(IN ) :: e_CohStr ! parameters for coherent structure events - TYPE(CohStr_OutputType), INTENT(INOUT) :: y_CohStr - - REAL(ReKi), INTENT(IN) :: TScale ! Time scaling factor - REAL(ReKi), INTENT(IN) :: UHub ! Mean wind speed at hub height (advection speed) - CHARACTER(*), INTENT(IN) :: RootName - - INTEGER(IntKi), intent( out) :: ErrStat ! Error level - CHARACTER(*), intent( out) :: ErrMsg ! Message describing error - - - ! Local Variables - - REAL(ReKi) :: CurrentTime = 0.0 ! the current time (in seconds) - REAL(ReKi) :: CTTime ! Time from beginning of event file - REAL(ReKi) :: deltaTime = 0.0 ! difference between two time steps in the event files - - INTEGER :: FileNum ! File Number in the event file - INTEGER :: IE ! Loop counter for event number - INTEGER :: IT ! Loop counter for time step - - INTEGER(IntKi) :: UnIn ! I/O Unit for input file - INTEGER(IntKi) :: UnOut ! I/O Unit for output file - - INTEGER(IntKi) :: ErrStat2 ! Error level (local) - CHARACTER(MaxMsgLen) :: ErrMsg2 ! Message describing error (local) - - - CHARACTER(200) :: InpFile ! Name of the input file - TYPE (Event), POINTER :: PtrCurr => NULL() ! Pointer to the current event - TYPE (Event), POINTER :: PtrPrev => NULL() ! Pointer to the previous event (for deallocation purposes) - - - ErrStat = ErrID_None - ErrMsg = "" - - UnOut = -1 - CALL GetNewUnit( UnOut, ErrStat2, ErrMsg2 ) - CALL OpenFOutFile ( UnOut, TRIM( RootName )//'.cts', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CohStr_WriteEvents' ) - - UnIn = -1 - CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) - - - ! Write event data to the time step output file (opened at the beginnig) - - WRITE (UnOut, "( A14, ' = FileType')") p_CohStr%CTExt - WRITE (UnOut, "( G14.7, ' = ScaleVel')") y_CohStr%ScaleVel - WRITE (UnOut, "( G14.7, ' = MHHWindSpeed')") UHub - WRITE (UnOut, "( G14.7, ' = Ymax')") y_CohStr%ScaleWid*e_CohStr%Ym_max/e_CohStr%Zm_max - WRITE (UnOut, "( G14.7, ' = Zmax')") y_CohStr%ScaleWid - WRITE (UnOut, "( G14.7, ' = DistScl')") p_CohStr%DistScl - WRITE (UnOut, "( G14.7, ' = CTLy')") p_CohStr%CTLy - WRITE (UnOut, "( G14.7, ' = CTLz')") p_CohStr%CTLz - WRITE (UnOut, "( G14.7, ' = NumCTt')") y_CohStr%NumCTt - - - PtrCurr => y_CohStr%PtrHead - - - DO IE = 1,y_CohStr%NumCTEvents - - IF ( .NOT. ASSOCIATED ( PtrCurr ) ) EXIT ! This shouldn't be necessary, given the way we created the list - - - IF ( .NOT. PtrCurr%Connect2Prev ) THEN - - IF ( CurrentTime < PtrCurr%TStart ) THEN - - WRITE ( UnOut, '(G14.7,1x,I5.5)') CurrentTime, 0 ! Print end of previous event - - y_CohStr%NumCTt = y_CohStr%NumCTt - 1 ! Let's make sure the right number of points have been written to the file. - - IF ( CurrentTime < PtrCurr%TStart - PtrCurr%delt ) THEN !This assumes a ramp of 1 delta t for each structure.... - - WRITE ( UnOut, '(G14.7,1x,I5.5)') MAX(PtrCurr%TStart - PtrCurr%delt, REAL(0.0, ReKi) ), 0 - y_CohStr%NumCTt = y_CohStr%NumCTt - 1 - - ENDIF - - ENDIF - - ENDIF ! NOT Connect2Prev - - - WRITE ( InpFile, '(I5.5)' ) e_CohStr%EventID( PtrCurr%EventNum ) - InpFile = TRIM( p_CohStr%CTEventPath )//PathSep//'Event'//TRIM( InpFile)//'.dat' - - CALL OpenFInpFile( UnIn, InpFile, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CohStr_WriteEvents' ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - - DO IT = 1,e_CohStr%EventTS( PtrCurr%EventNum ) - - READ ( UnIn, *, IOSTAT=ErrStat2 ) FileNum, CTTime, deltaTime - - IF (ErrStat2 /= 0) THEN - CALL SetErrStat( ErrID_Fatal, 'Error reading event file'//TRIM( InpFile ), ErrStat, ErrMsg, 'CohStr_WriteEvents') - CALL Cleanup() - RETURN - ENDIF - - CurrentTime = PtrCurr%TStart + CTTime*TScale - - WRITE ( UnOut, '(G14.7,1x,I5.5)') CurrentTime, FileNum - y_CohStr%NumCTt = y_CohStr%NumCTt - 1 - - ENDDO ! IT: Event timestep - - - CLOSE ( UnIn ) - - - ! Add one (delta time) space between events - - CurrentTime = CurrentTime + deltaTime*TScale - - PtrPrev => PtrCurr - PtrCurr => PtrCurr%Next - - DEALLOCATE ( PtrPrev, STAT=ErrStat2 ) - - ENDDO !IE: number of events - - WRITE ( UnOut, '(G14.7,1x,I5.5)') CurrentTime, 0 !Add the last line - y_CohStr%NumCTt = y_CohStr%NumCTt - 1 - - ! Let's append zero lines at the end of the file if we haven't output NumCTt lines, yet. - ! We've subtracted from NumCTt every time we wrote a line so now the number in NumCTt is - ! how many lines short we are. - - IF ( deltaTime > 0 ) THEN - deltaTime = deltaTime*TScale - ELSE - deltaTime = 0.5 - ENDIF - - DO IE = 1, y_CohStr%NumCTt ! Write zeros at the end if we happened to insert an event that overwrote one of our zero lines - CurrentTime = CurrentTime + deltaTime - WRITE ( UnOut, '(G14.7,1x,I5.5)') CurrentTime, 0 - ENDDO - - CLOSE ( UnOut ) - -CONTAINS -!............................ -SUBROUTINE Cleanup() - - IF (UnIn > 0) CLOSE( UnIn ) - IF (UnOut > 0) CLOSE( UnOut ) - -END SUBROUTINE Cleanup -!............................ -END SUBROUTINE CohStr_WriteEvents -!======================================================================= -END MODULE TS_CohStructures diff --git a/OpenFAST/modules/turbsim/src/Profiles.f90 b/OpenFAST/modules/turbsim/src/Profiles.f90 deleted file mode 100644 index 7135b9285..000000000 --- a/OpenFAST/modules/turbsim/src/Profiles.f90 +++ /dev/null @@ -1,1411 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2014, 2016 National Renewable Energy Laboratory -! -! This file is part of TurbSim. -! -! 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. -! -!********************************************************************************************************************************** -MODULE TS_Profiles - - USE NWTC_Library - USE TurbSim_Types - - IMPLICIT NONE - - -CONTAINS - -!======================================================================= -SUBROUTINE ChebyshevVals(coeffs,x,y,MinX,MaxX, ErrStat, ErrMsg) - - IMPLICIT NONE - - ! Passed variables - - REAL(ReKi), DIMENSION(:), INTENT(IN ) :: coeffs ! Coefficients defined on [-1,1] - REAL(ReKi), DIMENSION(:), INTENT(IN ) :: x ! The x values where f(x)=y is desired - REAL(ReKi), DIMENSION(:), INTENT( OUT) :: y ! The desired function values - REAL(SiKi), INTENT(IN ) :: MinX ! Min X of the interval the coeffs were originally calculated for - REAL(SiKi), INTENT(IN ) :: MaxX ! Max X of the interval the coeffs were originally calculated for - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error level - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Message describing error - - - - INTEGER :: i,j - INTEGER :: SC - INTEGER :: SX - INTEGER :: SY - - REAL(DbKi), DIMENSION(size(x)) :: x_hat - REAL(DbKi), DIMENSION(size(coeffs)) :: BasisFn ! The Chebyshev basis functions evaluated at x_hat - - SC = size(coeffs) - SX = size(x) - SY = size(y) - - IF (SX /= SY) THEN - ErrStat = ErrID_Warn - ErrMsg = 'ChebyshevVals:The x and y vectors must be the same size.' - SX = MIN(SX,SY) - SY = SX - ELSE - ErrStat = ErrID_None - ErrMsg = "" - ENDIF - - x_hat = (2.0*REAL(x(:),DbKi) - MaxX - MinX)/(MaxX - MinX) ! Transform from [MinX,MaxX] to [-1,1] - - - DO i=1,SX - CALL ChebyshevFuncs( x_hat(i), BasisFn ) - - y(i) = 0. - DO j=1,SC - y(i) = y(i) + coeffs(j)*REAL(BasisFn(j),ReKi) - ENDDO - - ENDDO - - RETURN - CONTAINS - !----------------------------------------------------------------------- - SUBROUTINE ChebyshevFuncs( x, Px ) - - REAL(DbKi), INTENT(IN) :: x - REAL(DbKi), INTENT(OUT), DIMENSION(:) :: Px ! The basis functions evaluated at x - - INTEGER :: I - INTEGER :: S_Px ! Size of Px, determines how many basis functions to use (i.e. order of the polynomial - 1) - - - S_Px = SIZE(Px) - - !---------------------------- - ! Define the basis functions: - !---------------------------- - Px(1) = 1 - - IF (S_Px > 1) THEN - - Px(2) = x - - ! Define Chebyshev polynomials recursively - - DO I=3,S_Px - Px(I) = 2.*x*Px(I-1) - Px(I-2) - ENDDO - - ENDIF !S_Px > 1 - - END SUBROUTINE ChebyshevFuncs -END SUBROUTINE ChebyshevVals -!======================================================================= -!> This subroutine determines what Chebyshev Coefficients will be used -!! for the jet wind speed and wind direction profiles -SUBROUTINE GetChebCoefs(p, UJetMax_IsKnown, ErrStat, ErrMsg) - - ! sets p%met%ChebyCoef_WS, p%met%ChebyCoef_WD, and - ! if .NOT. UJetMax_IsKnown, also sets p%met%UJetMax - - ! valid only for jet WindProfileType - -IMPLICIT NONE - - TYPE(TurbSim_ParameterType),INTENT(INOUT) :: p ! TurbSim parameters - LOGICAL, INTENT(IN) :: UJetMax_IsKnown - INTEGER(IntKi), intent( out) :: ErrStat !< Error level - CHARACTER(*), intent( out) :: ErrMsg !< Message describing error - - - - REAL(ReKi) :: UH_coef(4,11) ! The coefficients that Neil developed for calculating the Chebyshev coefficients - REAL(ReKi) :: WD_coef(4,11) ! The coefficients that Neil developed for calculating the Chebyshev coefficients - REAL(ReKi) :: ChebyCoef_tmp(11) - REAL(ReKi) :: UTmp1 ! - REAL(ReKi) :: UTmp2 ! - - INTEGER :: I ! A loop counter - - - ErrStat = ErrID_None - ErrMsg = "" - - ! Let's calculate the wind speed at the jet height - - CALL get_coefs(p%met%ZJetMax, UH_coef, WD_coef) - - - IF ( UJetMax_IsKnown ) THEN - - DO I=1,11 - p%met%ChebyCoef_WS(I) = p%met%UJetMax*UH_coef(1,I) + p%met%Rich_No*UH_coef(2,I) & - + p%met%Ustar *UH_coef(3,I) + UH_coef(4,I) - ENDDO - - ELSE - - ! Calculate the coefficients without UJetMax - - DO I=1,11 - p%met%ChebyCoef_WS(I) = p%met%Rich_No*UH_coef(2,I) + p%met%Ustar*UH_coef(3,I) + UH_coef(4,I) ! +UJetMax*UH_coef(1,I) - ENDDO - - CALL getVelocity(p, p%met%URef, p%met%RefHt, p%met%RefHt, Utmp1, ErrStat, ErrMsg) ! reference p%met%URef, p%met%RefHt are unused; return velocity at RefHt with the WS coeffs missing the UJetMax term - IF (ErrStat >= AbortErrLev) RETURN - - ! Now calculate the coefficients with just UJetMax term - - ChebyCoef_tmp(:) = p%met%ChebyCoef_WS(:) - p%met%ChebyCoef_WS(:) = UH_coef(1,:) - - CALL getVelocity(p, p%met%URef, p%met%RefHt, p%met%RefHt, Utmp2, ErrStat, ErrMsg) ! reference p%met%URef, p%met%RefHt are unused - IF (ErrStat >= AbortErrLev) RETURN - - ! this gives us UJetMax: - p%met%UJetMax = (p%met%URef - Utmp1)/Utmp2 - - ! Get the final coefficients, using the computed UJetMax - p%met%ChebyCoef_WS(:) = p%met%UJetMax*p%met%ChebyCoef_WS(:) + ChebyCoef_tmp(:) - - ENDIF - - DO I=1,11 - p%met%ChebyCoef_WD(I) = p%met%UJetMax*WD_coef(1,I) + p%met%Rich_No*WD_coef(2,I) & - + p%met%Ustar*WD_coef(3,I) + WD_coef(4,I) - ENDDO - - -RETURN -END SUBROUTINE GetChebCoefs -!======================================================================= -!> This subroutine sets the array VelocityProfile, which contains the velocies -!! at each height specified by the input array Ht. -SUBROUTINE getVelocityProfile(p, U_Ref, z_Ref, Ht, VelocityProfile, ErrStat, ErrMsg ) - - - ! Determine the wind speed at a given height, with reference wind speed. - - IMPLICIT NONE - - TYPE(TurbSim_ParameterType),INTENT(IN) :: p !< TurbSim parameters - REAL(ReKi), INTENT(IN) :: U_Ref !< Velocity at reference height - REAL(ReKi), INTENT(IN) :: z_Ref !< Reference height - REAL(ReKi), INTENT(IN) :: Ht(:) !< Heights (array) in meters where wind/water velocity should be calculated - REAL(ReKi), INTENT( OUT) :: VelocityProfile(:) !< Calculated velocity (wind/water speed) at Ht - INTEGER(IntKi), intent( out) :: ErrStat !< Error level - CHARACTER(*), intent( out) :: ErrMsg !< Message describing error - - - - REAL(SiKi), PARAMETER :: MinZ = 3. ! lower bound (height) for Cheby polynomial - REAL(SiKi), PARAMETER :: MaxZ = 500. ! upper bound (height) for Cheby polynomial - - - INTEGER :: I - INTEGER :: Indx - INTEGER :: J - -! REAL :: C_factor -! REAL(ReKi) :: ZRef - - ErrStat = ErrID_None - ErrMsg = "" - - IF ( p%IEC%IEC_WindType == IEC_EWM50 ) THEN - VelocityProfile(:) = p%IEC%VRef*( Ht(:)/p%grid%HubHt )**p%met%PLExp ! [IEC 61400-1 6.3.2.1 (14)] - RETURN - ELSEIF ( p%IEC%IEC_WindType == IEC_EWM1 ) THEN - VelocityProfile(:) = 0.8*p%IEC%VRef*( Ht(:)/p%grid%HubHt )**p%met%PLExp ! [IEC 61400-1 6.3.2.1 (14), (15)] - RETURN - ELSEIF ( p%IEC%IEC_WindType == IEC_EWM100 ) THEN - VelocityProfile(:) = p%IEC%VRef*( Ht(:)/p%grid%HubHt )**p%met%PLExp ! [API-IEC RECCOMENDATAION] ADDED BY YGUO !bjj: this is the same as IEC_EWM50, but we should check that IEC_EWM100 is used in ALL the same places IEC_EWM50 is - RETURN - ENDIF - - - SELECT CASE ( TRIM(p%met%WindProfileType) ) - - CASE ( 'JET' ) - - CALL ChebyshevVals( p%met%ChebyCoef_WS, Ht, VelocityProfile, MinZ, MaxZ, ErrStat, ErrMsg ) ! We originally calculated the coeffs for 3-500 m in height - - CASE ( 'LOG' ) - - DO J = 1,SIZE(Ht) - VelocityProfile(J) = getLogWindSpeed( Ht(J), z_Ref, U_Ref, p%met%ZL, p%met%Z0) - END DO - - - - CASE ( 'H2L' ) - - ! Calculate the windspeed. - ! z_Ref and U_Ref both get modified consistently, therefore z_Ref is used instead of RefHt. - VelocityProfile(:) = LOG( Ht(:)/z_Ref) * p%met%Ustar / 0.41_ReKi + U_Ref - - CASE ( 'PL' ) - -! IF ( z_Ref > 0.0 .AND. Ht > 0.0 ) THEN - VelocityProfile(:) = U_Ref*( Ht(:)/z_Ref )**p%met%PLExp - -! ENDIF - - CASE ( 'TS' ) - - DO J = 1,SIZE(Ht) - VelocityProfile(J) = getTimeSeriesWindSpeed(p, Ht(J) ) - END DO - - - CASE ( 'API' ) - - ! sample to write to screen.CALL WrScr ( ' A default value will be used for '//TRIM(VarName)//'.' ) -! CALL WrScr ('calling to API wind profile and write array') - ! TO ADD THE FSOLVE PROGRAM TO CALCULATE C_factor -! VelocityProfile(:) = ZRef*(1+LOG( Ht(:) / 10) )*( 1-0.41*(0.06*(1+0.043*ZRef)*(Ht/10)**(-0.22)))*LOG(600.0/3600.0) -! VelocityProfile(:) = z_Ref*(1+LOG( Ht(:) / 10) )*( 1-0.41*(0.06*(1+0.043*z_Ref)*(Ht/10)**(-0.22)))*LOG(600.0/3600.0) -! VelocityProfile(:) = U_Ref*(1+LOG( Ht(:) / z_Ref) )*( 1-0.41*(0.06*(1+0.043*U_Ref)*(Ht/z_Ref)**(-0.22)))*LOG(600.0/3600.0) -! VelocityProfile(:) = U_Ref*(1+LOG( Ht(:) / z_Ref) ) -! VelocityProfile(:) = U_Ref*( 1.0 + 0.0573*SQRT( 1.0 + 0.15*p%met%URef )*LOG( Ht(:)/z_Ref) ) - VelocityProfile(:) = p%met%URef*( 1.0 + 0.0573*SQRT( 1.0 + 0.15*p%met%URef )*LOG( Ht(:)/p%met%RefHt) ) - CASE ( 'USR' ) - - DO J = 1,SIZE(Ht) - IF ( Ht(J) <= p%met%USR_Z(1) ) THEN - VelocityProfile(J) = p%met%USR_U(1) - ELSEIF ( Ht(J) >= p%met%USR_Z(p%met%NumUSRz) ) THEN - VelocityProfile(J) = p%met%USR_U(p%met%NumUSRz) - ELSE - ! Find the two points between which the height lies - - DO I=2,p%met%NumUSRz - IF ( Ht(J) <= p%met%USR_Z(I) ) THEN - Indx = I-1 - - ! Let's just do a linear interpolation for now - VelocityProfile(J) = (Ht(J) - p%met%USR_Z(Indx)) * ( p%met%USR_U(Indx) - p%met%USR_U(I) ) / ( p%met%USR_Z(Indx) - p%met%USR_Z(I) ) & - + p%met%USR_U(Indx) - EXIT - ENDIF - ENDDO - - ENDIF - - ENDDO - - CASE DEFAULT ! This is how it worked before - - DO I=1,SIZE(VelocityProfile) - IF ( Ht(I) == z_Ref ) THEN - VelocityProfile(I) = U_Ref - ELSEIF ( ABS( Ht(I)-z_Ref ) <= 0.5*p%grid%RotorDiameter ) THEN - VelocityProfile(I) = U_Ref*( Ht(I)/z_Ref )**p%met%PLExp - ELSEIF ( Ht(I) > 0.0 .AND. z_Ref > 0.0 .AND. .NOT. EqualRealNos(z_Ref, p%met%Z0) ) THEN !Check that we don't have an invalid domain - VelocityProfile(I) = U_Ref*LOG( Ht(I)/p%met%Z0 )/LOG( z_Ref/p%met%Z0 ) - ELSE - VelocityProfile(I) = 0.0 - ENDIF - ENDDO - - END SELECT - -RETURN -END SUBROUTINE getVelocityProfile -!======================================================================= -!> This subroutine sets the direction in degrees at each height in meters -!! specified by the input array Ht. -SUBROUTINE getDirectionProfile( p, Ht, DirectionProfile, VAngleProfile, ErrStat, ErrMsg ) - - IMPLICIT NONE - - TYPE(TurbSim_ParameterType),INTENT(IN) :: P !< TurbSim parameters - REAL(ReKi), INTENT(IN) :: Ht(:) !< Array of heights (meters) where wind speed should be calculated - REAL(ReKi) , intent( out) :: DirectionProfile(:) !< Wind direction at Ht - REAL(ReKi) , intent( out) :: VAngleProfile(:) !< Vertical Wind angle at Ht - INTEGER(IntKi), intent( out) :: ErrStat !< Error level - CHARACTER(*), intent( out) :: ErrMsg !< Message describing error - - - REAL(SiKi), PARAMETER :: MinZ = 3. ! lower bound (height) for Cheby polynomial - REAL(SiKi), PARAMETER :: MaxZ = 500. ! upper bound (height) for Cheby polynomial - - - REAL(ReKi) :: tmpHt(2) - REAL(ReKi) :: tmpWD(2) - REAL(ReKi) :: diff - - INTEGER :: IZ, IZm1 - INTEGER :: J - - - ErrStat = ErrID_None - ErrMsg = "" - - SELECT CASE ( TRIM(p%met%WindProfileType) ) - - CASE ( 'JET' ) - - ! Calculate the wind direction at this height - CALL ChebyshevVals( p%met%ChebyCoef_WD, Ht(:), DirectionProfile(:), MinZ, MaxZ, ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN - - ! Compute the wind direction at hub height & the jet height - tmpHt(1) = p%grid%HubHt - tmpHt(2) = p%met%ZJetMax - CALL ChebyshevVals( p%met%ChebyCoef_WD, tmpHt, tmpWD(1:2), MinZ, MaxZ, ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN - - ! Make sure none of the directions are more than 45 degrees from the direction at the jet height - IF ( ABS(tmpWD(1) - tmpWD(2) ) > 45. ) THEN ! The direction at the hub height - tmpWD(1) = tmpWD(2) + SIGN(REAL(45.,ReKi), tmpWD(1) - tmpWD(2)) - ENDIF - - DO J = 1,SIZE(DirectionProfile) ! The directions at all the heights - IF ( ABS(DirectionProfile(J) - tmpWD(2) ) > 45. ) THEN - DirectionProfile(J) = tmpWD(2) + SIGN(REAL(45.,ReKi), DirectionProfile(J) - tmpWD(2)) - ENDIF - - ! Remove the hub height direction so that we have a relative direction, then - ! add the mean flow angle. (Note that the Chebyshev profile is cw looking upwind, - ! but the horizontal angle is ccw looking upwind) - - DirectionProfile(J) = p%met%HFlowAng - (DirectionProfile(J) - tmpWD(1)) ! This is the counter-clockwise angle of the wind - ENDDO - VAngleProfile = p%met%VFlowAng - - CASE ( 'USR' ) - - DO J = 1,SIZE(Ht) - - ! Calculate the wind direction at this height - - IF ( Ht(J) <= p%met%USR_Z(1) ) THEN - DirectionProfile(J) = p%met%USR_WindDir(1) - ELSEIF ( Ht(J) >= p%met%USR_Z(p%met%NumUSRz) ) THEN - DirectionProfile(J) = p%met%USR_WindDir(p%met%NumUSRz) - ELSE - - - ! Find the two points between which the height lies - - DO IZ=2,p%met%NumUSRz - IF ( Ht(J) <= p%met%USR_Z(IZ) ) THEN - IZm1 = IZ-1 - - ! Let's just do a linear interpolation for now - !we need to check if the angle goes through 360, before we do the interpolation - diff = p%met%USR_WindDir(IZm1) - p%met%USR_WindDir(IZ) - IF ( diff > 180. ) THEN - tmpWD(1) = p%met%USR_WindDir(IZm1) - tmpWD(2) = p%met%USR_WindDir(IZ ) + 360. - ELSEIF ( diff < -180. ) THEN - tmpWD(1) = p%met%USR_WindDir(IZm1) + 360. - tmpWD(2) = p%met%USR_WindDir(IZ ) - ELSE - tmpWD(1) = p%met%USR_WindDir(IZm1) - tmpWD(2) = p%met%USR_WindDir(IZ ) - ENDIF - - DirectionProfile(J) = (Ht(J) - p%met%USR_Z(IZm1)) * ( tmpWD(1) - tmpWD(2) ) / ( p%met%USR_Z(IZm1) - p%met%USR_Z(IZ) ) + tmpWD(1) - - EXIT - ENDIF - ENDDO - - - ENDIF - - ENDDO - -!bjj: TODO: See if we can get this to have direction of HFlowAng at hub height. - DirectionProfile = p%met%HFlowAng + DirectionProfile ! This is the counter-clockwise angle of the wind - VAngleProfile = p%met%VFlowAng - - CASE ('TS') - - DO J = 1,SIZE(Ht) - - ! Calculate the wind direction at this height - - IF ( Ht(J) <= p%usr%pointzi(1) ) THEN - DirectionProfile(J) = p%usr%meanDir(1) - VAngleProfile(J) = p%usr%meanVAng(1) - ELSEIF ( Ht(J) >= p%usr%pointzi(p%usr%NPoints) ) THEN - DirectionProfile(J) = p%usr%meanDir(p%usr%NPoints) - VAngleProfile(J) = p%usr%meanVAng(p%usr%NPoints) - ELSE - ! Find the two points between which the height lies - - DO IZ=2,p%usr%NPoints - IF ( Ht(J) <= p%usr%pointzi(IZ) ) THEN - IZm1 = IZ-1 - - ! Let's just do a linear interpolation for now - !we need to check if the angle goes through 360, before we do the interpolation - diff = p%usr%meanDir(IZm1) - p%usr%meanDir(IZ) - IF ( diff > 180. ) THEN - tmpWD(1) = p%usr%meanDir(IZm1) - tmpWD(2) = p%usr%meanDir(IZ ) + 360. - ELSEIF ( diff < -180. ) THEN - tmpWD(1) = p%usr%meanDir(IZm1) + 360. - tmpWD(2) = p%usr%meanDir(IZ ) - ELSE - tmpWD(1) = p%usr%meanDir(IZm1) - tmpWD(2) = p%usr%meanDir(IZ ) - ENDIF - - DirectionProfile(J) = (Ht(J) - p%usr%pointzi(IZm1)) * ( tmpWD(1) - tmpWD(2) ) / ( p%usr%pointzi(IZm1) - p%usr%pointzi(IZ) ) + tmpWD(1) - - - ! Let's just do a linear interpolation for now - !we need to check if the angle goes through 360, before we do the interpolation - diff = p%usr%meanVAng(IZm1) - p%usr%meanVAng(IZ) - IF ( diff > 180. ) THEN - tmpWD(1) = p%usr%meanVAng(IZm1) - tmpWD(2) = p%usr%meanVAng(IZ ) + 360. - ELSEIF ( diff < -180. ) THEN - tmpWD(1) = p%usr%meanVAng(IZm1) + 360. - tmpWD(2) = p%usr%meanVAng(IZ ) - ELSE - tmpWD(1) = p%usr%meanVAng(IZm1) - tmpWD(2) = p%usr%meanVAng(IZ ) - ENDIF - - VAngleProfile(J) = (Ht(J) - p%usr%pointzi(IZm1)) * ( tmpWD(1) - tmpWD(2) ) / ( p%usr%pointzi(IZm1) - p%usr%pointzi(IZ) ) + tmpWD(1) - - EXIT - ENDIF - ENDDO - - ENDIF - - END DO - - DirectionProfile = p%met%HFlowAng + DirectionProfile ! This is the counter-clockwise angle of the wind - VAngleProfile = p%met%VFlowAng + VAngleProfile - - CASE DEFAULT - - DirectionProfile = p%met%HFlowAng - VAngleProfile = p%met%VFlowAng - - END SELECT - -RETURN -END SUBROUTINE getDirectionProfile -!======================================================================= -!> This subroutine sets the scalar Velocity, which contains the velocity in m/s -!! at the height in mebers specified by the input value Ht. -SUBROUTINE getVelocity(p, U_Ref, z_Ref, Ht, Velocity, ErrStat, ErrMsg ) - - IMPLICIT NONE - - TYPE(TurbSim_ParameterType), INTENT(IN) :: P - REAL(ReKi), INTENT(IN) :: U_Ref ! Wind speed at reference height - REAL(ReKi), INTENT(IN) :: z_Ref ! Reference height - REAL(ReKi), INTENT(IN) :: Ht ! Height where wind speed should be calculated - REAL(ReKi) , intent( out) :: Velocity ! This function, approximate wind/water speed at Ht - INTEGER(IntKi), intent( out) :: ErrStat !< Error level - CHARACTER(*), intent( out) :: ErrMsg !< Message describing error - - - REAL(SiKi), PARAMETER :: MinZ = 3. ! lower bound (height) for Cheby polynomial - REAL(SiKi), PARAMETER :: MaxZ = 500. ! upper bound (height) for Cheby polynomial - - -! REAL(ReKi) :: psiM ! The diabatic term for the log wind profile - REAL(ReKi) :: tmpHt(2) - REAL(ReKi) :: tmpWS(2) - - INTEGER :: I - INTEGER :: Indx - - !REAL(ReKi) :: U0_1HR ! Wind speed at reference height in 1hr time duration, added by Y.G. ON April 16 2013 -! REAL :: C_factor ! Factor to convert wind speed from 10-min to 1 hr, added by Y.G. ON April 16 2013 - REAL :: X0 ! Added by Y. Guo for calculating C_factor - !REAL :: X, TEMP_1, TEMP_2 ! Added by Y. Guo for calculating C_factor - !======================================= - - ErrStat = ErrID_None - ErrMsg = "" - - X0=U_Ref - !======================== - ! IF p%met%Z0 <= 0.0 CALL ProgAbort('The surface roughness must be a positive number') - - IF ( p%IEC%IEC_WindType == IEC_EWM50 ) THEN - Velocity = p%IEC%VRef*( Ht/p%grid%HubHt )**p%met%PLExp ! [IEC 61400-1 6.3.2.1 (14)] - RETURN - ELSEIF ( p%IEC%IEC_WindType == IEC_EWM1 ) THEN - Velocity = 0.8*p%IEC%VRef*( Ht/p%grid%HubHt )**p%met%PLExp ! [IEC 61400-1 6.3.2.1 (14), (15)] - RETURN - ELSEIF ( p%IEC%IEC_WindType == IEC_EWM100 ) THEN - Velocity = p%IEC%VRef*( Ht/p%grid%HubHt )**p%met%PLExp ! [API-IEC RECCOMENDATAION] ADDED BY YGUO !bjj: this is the same as IEC_EWM50, but we should check that IEC_EWM100 is used in ALL the same places IEC_EWM50 is - RETURN - ENDIF - - - SELECT CASE ( TRIM(p%met%WindProfileType) ) - - CASE ( 'JET' ) - - tmpHt(1) = Ht - CALL ChebyshevVals( p%met%ChebyCoef_WS, tmpHt(1:1), tmpWS(1:1), MinZ, MaxZ, ErrStat, ErrMsg ) ! We originally calculated the coeffs for 3-500 m in height - Velocity = tmpWS(1) - - CASE ( 'LOG' ) !Panofsky, H.A.; Dutton, J.A. (1984). Atmospheric Turbulence: Models and Methods for Engineering Applications. New York: Wiley-Interscience; 397 pp. - - Velocity = getLogWindSpeed(Ht, z_Ref, U_Ref, p%met%ZL, p%met%Z0) - - CASE ( 'H2L' ) - ! Calculate the windspeed. - ! z_Ref and U_Ref both get modified consistently, therefore z_Ref is used instead of RefHt. - Velocity = LOG( Ht/z_Ref ) * p%met%Ustar / 0.41_ReKi + U_Ref - - - CASE ( 'PL' ) ! POWER LAW, commented by Y. Guo on April 16 2013 - - IF ( z_Ref > 0.0 .AND. Ht > 0.0 ) THEN - Velocity = U_Ref*( Ht/z_Ref )**p%met%PLExp ! [IEC 61400-1 6.3.1.2 (10)] - ELSE - Velocity = 0.0 - ENDIF - - CASE ( 'USR' ) - - IF ( Ht <= p%met%USR_Z(1) ) THEN - Velocity = p%met%USR_U(1) - ELSEIF ( Ht >= p%met%USR_Z(p%met%NumUSRz) ) THEN - Velocity = p%met%USR_U(p%met%NumUSRz) - ELSE - ! Find the two points between which the height lies - - DO I=2,p%met%NumUSRz - IF ( Ht <= p%met%USR_Z(I) ) THEN - Indx = I-1 - - ! Let's just do a linear interpolation for now - Velocity = (Ht - p%met%USR_Z(Indx)) * ( p%met%USR_U(Indx) - p%met%USR_U(I) ) / ( p%met%USR_Z(Indx) - p%met%USR_Z(I) ) + p%met%USR_U(Indx) - EXIT - ENDIF - ENDDO - - ENDIF - - CASE ( 'TS' ) - - Velocity = getTimeSeriesWindSpeed(p, Ht) - - - CASE ( 'API' ) - -!MLB: We can exclude this logic by forcing the user to enter the 1-hour mean wind speed. -! If we add the API stuff to the main version of TurbSim, we may want to eliminate that requirement, but we will have to -! add a new input parameter saying how long a period was used to calculate the reference wind speed. - -! CALL ROOT_SEARCHING(X0,X,U_Ref,z_Ref,p%grid%HubHt) !URef - !CALL Root_Searching(X0,X,42.5,10.0,10.0) !U_Ref, USED TO DEBUG THE CODE -! U0_1HR=X ! This is the wind speed at 10 m height within 1-hr window - -! CALL WrScr ('Calling to API wind profile') -! TEMP_1=0.0573*(1.0+0.15*U0_1HR)**0.5 -! TEMP_2=0.06*(1+0.043*U0_1HR)*(Ht/10.0)**(-0.22) -! Velocity = U0_1HR*(1.0+TEMP_1*LOG( Ht / 10.0) )*( 1.0-0.41*TEMP_2*LOG(600.0/3600.0)) -! Velocity = U0_1HR*( 1.0 + 0.0573*SQRT( 1.0 + 0.15*U0_1HR )*LOG( Ht/z_Ref) ) -!MLB: This assumes that the reference wind speed entered by the user is the 1-hour average wind speed at the input reference height. - Velocity = p%met%URef*( 1.0 + 0.0573*SQRT( 1.0 + 0.15*p%met%URef )*LOG( Ht/p%met%RefHt) ) - -! CALL WrScr ('API wind profile generated') - - CASE DEFAULT ! This is how it worked before - - IF ( Ht == z_Ref ) THEN - Velocity = U_Ref - ELSEIF ( ABS( Ht-z_Ref ) <= 0.5*p%grid%RotorDiameter ) THEN - Velocity = U_Ref*( Ht/z_Ref )**p%met%PLExp ! [IEC 61400-1 6.3.1.2 (10)] - ELSEIF ( Ht > 0.0 .AND. z_Ref > 0.0 .AND. .NOT. EqualRealNos(z_Ref, p%met%Z0) ) THEN !Check that we don't have an invalid domain - Velocity = U_Ref*LOG( Ht/p%met%Z0 )/LOG( z_Ref/p%met%Z0 ) - ELSE - Velocity = 0.0 - ENDIF - - END SELECT - - -RETURN -END SUBROUTINE getVelocity - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine calculates the wind speed at Ht by linearly interpolating the mean wind speed at the points from the user-input -!! time series. -function getTimeSeriesWindSpeed(p, Ht) - - TYPE(TurbSim_ParameterType),INTENT(IN) :: p !< parameters - REAL(ReKi), INTENT(IN) :: Ht !< height at which wind speed is requested [m] - REAL(ReKi) :: getTimeSeriesWindSpeed !< the calculated wind speed at Ht - - INTEGER(IntKi) :: IZ, IZm1 - - - - IF ( Ht <= p%usr%pointzi(1) ) THEN - getTimeSeriesWindSpeed = p%usr%meanU(1,1) - ELSEIF ( Ht >= p%usr%pointzi(p%usr%NPoints) ) THEN - getTimeSeriesWindSpeed = p%usr%meanU(p%usr%NPoints,1) - ELSE - ! Find the two points between which the height lies - - DO IZ=2,p%usr%NPoints - IF ( Ht <= p%usr%pointzi(IZ) ) THEN - IZm1 = IZ-1 - - ! Let's just do a linear interpolation for now - getTimeSeriesWindSpeed = (Ht - p%usr%pointzi(IZm1)) * ( p%usr%meanU(IZm1,1) - p%usr%meanU(IZ,1) ) / ( p%usr%pointzi(IZm1) - p%usr%pointzi(IZ) ) + p%usr%meanU(IZm1,1) - EXIT - ENDIF - ENDDO - - ENDIF - -end function getTimeSeriesWindSpeed - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine calculates the wind speed at Ht assuming a logarithmic wind profile and inputs z_Ref, U_Ref, Z/L and Z0 -!! -!! U_{ref}*( LOG( Ht / Z0 ) - psiM )/( LOG( z_Ref / Z0 ) - psiM ) -!! where -!! psiM is a function of Z/L -!! In neutral conditions, psiM is 0 and we get the IEC log wind profile. -function getLogWindSpeed(Ht, z_Ref, U_Ref, ZL, Z0) - - REAL(ReKi), INTENT(IN) :: Ht !< height at which wind speed is requested [m] - REAL(ReKi), INTENT(IN) :: z_Ref !< height of the reference wind speed [m] - REAL(ReKi), INTENT(IN) :: U_Ref !< reference wind speed [m/s] - REAL(ReKi), INTENT(IN) :: ZL !< a measure of stability [-] - REAL(ReKi), INTENT(IN) :: Z0 !< surface roughness length [m] - - REAL(ReKi) :: getLogWindSpeed !< the calculated wind speed at Ht - - - ! local variables - REAL(ReKi) :: psiM ! The diabatic term for the log wind profile - REAL(ReKi) :: tmp ! A temporary variable for calculating psiM - - - - IF ( Ht > 0.0 .AND. z_Ref > 0.0 .AND. .NOT. EqualRealNos( z_Ref, Z0 ) ) THEN - - IF ( ZL >= 0 ) THEN !& ZL < 1 - psiM = -5.0*ZL - ELSE - tmp = (1.0 - 15.0*ZL)**0.25 - - !psiM = -2.0*LOG( (1.0 + tmp)/2.0 ) - LOG( (1.0 + tmp*tmp)/2.0 ) + 2.0*ATAN( tmp ) - 0.5 * PI - psiM = -LOG( 0.125 * ( (1.0 + tmp)**2 * (1.0 + tmp*tmp) ) ) + 2.0*ATAN( tmp ) - 0.5 * PI - - !bjj 11-may-2016: because of the negative sign in the equation below, I believe psiM needs to switch signs. - ! if true, this has been implemented incorrectly for at least 15 years. - psiM = -psiM - - ENDIF - -! IF ( p%met%Ustar > 0. ) THEN -! getLogWindSpeed = ( p%met%UstarDiab / 0.4 ) * ( LOG( Ht / Z0 ) - psiM ) -! ELSE - !In neutral conditions, psiM is 0 and we get the IEC log wind profile: - getLogWindSpeed = U_Ref*( LOG( Ht / Z0 ) - psiM )/( LOG( z_Ref / Z0 ) - psiM ) -! ENDIF - - ELSE - getLogWindSpeed = 0.0_ReKi - ENDIF - - -end function getLogWindSpeed -!======================================================================= -SUBROUTINE get_coefs(JetHt,UH_coef,WD_coef) - - ! This subroutine just returns the coefficients that Neil calculated - ! for getting the Chebyshev coefficients for jet wind profiles. - - ! The coefficients are - ! Row 1 = Jet maximum wind speed coefficient - ! Row 2 = Turbine layer Richardson number coefficient - ! Row 3 = uStar over the rotor diameter coefficient - ! Row 4 = constant coefficient - ! Columns 1:11 = coefficients for 0-10th Chebyshev Basis Functions - - - REAL(ReKi),INTENT(IN) :: JetHt ! The height of the jet - REAL(ReKi),INTENT(OUT) :: UH_coef(4,11) ! The coefficients for horizontal wind speed - REAL(ReKi),INTENT(OUT) :: WD_coef(4,11) ! The coefficients for (horizontal) wind direction - - INTEGER :: HtIndx - - HtIndx = INT(JetHt - 50) / INT(20) - HtIndx = MIN( MAX( HtIndx, 1 ), 21 ) - - ! The Horizontal Wind Speed coefficients - SELECT CASE ( HtIndx ) - CASE ( 1 ) ! 70-90 m - UH_coef(:, 1) = (/ 0.856851, 7.51E-02, 1.39276, 0.894127 /) - UH_coef(:, 2) = (/ -4.88E-02, 0.576344, 1.23582, 1.72687 /) - UH_coef(:, 3) = (/ 1.39E-02, 9.67E-02, 1.36737, -0.723851 /) - UH_coef(:, 4) = (/ 0.100585, 0.234968, -1.06287, -0.372353 /) - UH_coef(:, 5) = (/ -7.69E-02, -0.154071, -0.301483, 0.150179 /) - UH_coef(:, 6) = (/ 8.53E-03, 0.104602, -0.382453, 0.520224 /) - UH_coef(:, 7) = (/ -4.44E-03, -4.80E-02, 0.219135, -0.266775 /) - UH_coef(:, 8) = (/ 2.63E-02, -3.08E-02, -6.94E-02, -0.210521 /) - UH_coef(:, 9) = (/ -2.01E-02, -5.61E-02, 0.220825, 0.179622 /) - UH_coef(:,10) = (/ 8.11E-03, 3.96E-02, 0.109793, -3.81E-02 /) - UH_coef(:,11) = (/ 4.99E-03, 5.00E-02, -0.124887, -0.11035 /) - CASE ( 2 ) ! 90-110 m - UH_coef(:, 1) = (/ 0.741241, -0.122521, 0.875062, 1.43294 /) - UH_coef(:, 2) = (/ -0.264131, 0.28827, 0.717571, 3.30541 /) - UH_coef(:, 3) = (/ -5.92E-02, 3.86E-02, 1.09453, -0.377399 /) - UH_coef(:, 4) = (/ 0.13792, 0.175628, -0.57163, -0.539205 /) - UH_coef(:, 5) = (/ -2.59E-02, -0.211126, -4.25E-02, -0.338308 /) - UH_coef(:, 6) = (/ -1.02E-02, 0.153597, -0.197867, 0.570708 /) - UH_coef(:, 7) = (/ -3.22E-02, -8.17E-02, -9.63E-02, 0.19095 /) - UH_coef(:, 8) = (/ 2.72E-02, 3.09E-02, -0.249399, -0.273684 /) - UH_coef(:, 9) = (/ -1.60E-02, 8.88E-03, 0.132523, 9.58E-02 /) - UH_coef(:,10) = (/ -5.29E-03, 2.98E-02, 0.205812, 9.27E-02 /) - UH_coef(:,11) = (/ 7.00E-03, -1.47E-02, -2.11E-02, -0.123083 /) - CASE ( 3 ) ! 110-130 m - UH_coef(:, 1) = (/ 0.809492, -1.41752, -0.817619, 1.64159 /) - UH_coef(:, 2) = (/ -0.121866, -1.09012, -2.60044, 3.63875 /) - UH_coef(:, 3) = (/ -0.105142, -0.263657, -5.60E-02, 0.374811 /) - UH_coef(:, 4) = (/ 8.33E-02, 0.625103, 0.422112, -0.199598 /) - UH_coef(:, 5) = (/ -1.69E-02, -7.09E-02, 1.76933, -0.847721 /) - UH_coef(:, 6) = (/ 1.88E-02, 7.70E-02, -0.121062, 0.10533 /) - UH_coef(:, 7) = (/ -3.15E-02, 2.50E-02, -7.39E-02, 0.299197 /) - UH_coef(:, 8) = (/ 3.48E-03, 4.25E-02, -6.52E-02, -4.29E-03 /) - UH_coef(:, 9) = (/ -1.18E-02, -0.100754, 0.170602, 3.42E-02 /) - UH_coef(:,10) = (/ 2.09E-02, 3.36E-02, -0.104123, -8.49E-02 /) - UH_coef(:,11) = (/ -2.91E-03, -3.52E-02, -0.258115, 4.81E-02 /) - CASE ( 4 ) ! 130-150 m - UH_coef(:, 1) = (/ 0.694325, -0.463252, 2.11406, 1.28643 /) - UH_coef(:, 2) = (/ -0.269118, -1.31381, 2.13374, 3.46187 /) - UH_coef(:, 3) = (/ -8.40E-02, -5.97E-02, 2.09803, -0.592335 /) - UH_coef(:, 4) = (/ 0.135657, -0.117732, -0.11134, -0.28161 /) - UH_coef(:, 5) = (/ -1.29E-02, -0.239685, 0.151264, -0.412806 /) - UH_coef(:, 6) = (/ 3.54E-02, 0.513824, 0.673662, -0.519536 /) - UH_coef(:, 7) = (/ -1.55E-02, 7.49E-03, 0.393002, 2.07E-02 /) - UH_coef(:, 8) = (/ 2.37E-02, 0.225841, 3.84E-02, -0.202507 /) - UH_coef(:, 9) = (/ -3.26E-02, -0.239615, -0.133893, 0.29135 /) - UH_coef(:,10) = (/ 1.52E-02, 7.15E-02, 0.25228, -0.113016 /) - UH_coef(:,11) = (/ 7.19E-03, 9.79E-02, 0.252125, -0.173201 /) - CASE ( 5 ) ! 150-170 m - UH_coef(:, 1) = (/ 0.909534, 0.581254, -2.90539, -0.581377 /) - UH_coef(:, 2) = (/ 0.155834, -0.836954, -6.77075, 0.627044 /) - UH_coef(:, 3) = (/ -8.99E-02, -5.28E-02, -2.0719, 2.44E-02 /) - UH_coef(:, 4) = (/ 7.01E-02, -0.152904, -0.348237, 0.460754 /) - UH_coef(:, 5) = (/ -1.78E-02, -0.263166, 0.375798, -0.215738 /) - UH_coef(:, 6) = (/ 9.70E-03, 0.254932, 0.449286, -0.234 /) - UH_coef(:, 7) = (/ 7.46E-03, -0.304057, -0.122661, -7.14E-03 /) - UH_coef(:, 8) = (/ -6.26E-03, -0.142341, -1.95E-02, 0.299841 /) - UH_coef(:, 9) = (/ -2.59E-02, 0.174282, 0.193868, -5.81E-03 /) - UH_coef(:,10) = (/ 2.54E-03, -8.22E-02, 1.84E-02, 6.77E-02 /) - UH_coef(:,11) = (/ 5.77E-04, -5.43E-02, -7.69E-02, 2.96E-02 /) - CASE ( 6 ) ! 170-190 m - UH_coef(:, 1) = (/ 0.885753, -1.15015, 0.155218, -0.707043 /) - UH_coef(:, 2) = (/ -2.53E-02, -2.65126, 0.850151, 1.85279 /) - UH_coef(:, 3) = (/ -7.23E-02, -0.399161, 0.142486, -0.917176 /) - UH_coef(:, 4) = (/ 3.78E-02, 0.178924, 0.227745, 0.528861 /) - UH_coef(:, 5) = (/ -6.43E-03, 5.42E-02, 0.359052, -0.26111 /) - UH_coef(:, 6) = (/ 5.33E-02, 0.1546, -0.335116, -0.602604 /) - UH_coef(:, 7) = (/ -6.50E-03, -0.205907, -8.59E-02, 8.16E-02 /) - UH_coef(:, 8) = (/ 3.16E-02, 0.151199, -0.126411, -0.148609 /) - UH_coef(:, 9) = (/ -3.95E-02, 0.127418, 0.158511, 0.20932 /) - UH_coef(:,10) = (/ -2.53E-02, -5.32E-02, 0.36536, 0.214466 /) - UH_coef(:,11) = (/ 4.03E-03, 1.02E-02, -7.01E-03, -4.32E-02 /) - CASE ( 7 ) ! 190-210 m - UH_coef(:, 1) = (/ 0.735269, -1.48574, 0.983734, 0.887351 /) - UH_coef(:, 2) = (/ 0.233065, -0.850536, -1.17754, -0.880493 /) - UH_coef(:, 3) = (/ -0.172346, -0.862128, 1.20075, 3.48E-02 /) - UH_coef(:, 4) = (/ 8.04E-02, 5.24E-02, -0.916548, 0.247144 /) - UH_coef(:, 5) = (/ 2.88E-02, 0.112064, 1.51E-04, -0.466186 /) - UH_coef(:, 6) = (/ -2.75E-02, -9.01E-02, -0.321617, 0.379162 /) - UH_coef(:, 7) = (/ -1.08E-02, -0.161368, -2.51E-04, -1.33E-02 /) - UH_coef(:, 8) = (/ 5.09E-02, 0.228507, 0.195942, -0.45807 /) - UH_coef(:, 9) = (/ -1.98E-02, -7.23E-02, 6.66E-02, 0.133182 /) - UH_coef(:,10) = (/ -5.57E-03, -5.31E-02, 2.44E-02, 5.60E-02 /) - UH_coef(:,11) = (/ 3.71E-03, -1.63E-02, -5.44E-02, -1.40E-02 /) - CASE ( 8 ) ! 210-230 m - UH_coef(:, 1) = (/ 0.723721, -0.691359, -0.147971, 1.16041 /) - UH_coef(:, 2) = (/ 0.18799, 0.370199, 0.354538, -0.494962 /) - UH_coef(:, 3) = (/ -0.204727, -0.166723, 0.682431, 0.367566 /) - UH_coef(:, 4) = (/ 1.40E-02, 0.334677, 0.169944, 0.494211 /) - UH_coef(:, 5) = (/ 3.84E-02, 0.258361, 0.389453, -0.625709 /) - UH_coef(:, 6) = (/ -6.62E-03, -2.19E-02, -0.606278, 0.205521 /) - UH_coef(:, 7) = (/ -2.54E-02, -0.17744, 7.49E-02, 7.61E-02 /) - UH_coef(:, 8) = (/ 5.03E-02, 7.97E-02, -9.98E-02, -0.312218 /) - UH_coef(:, 9) = (/ -2.25E-02, 2.20E-02, 0.263227, 0.123311 /) - UH_coef(:,10) = (/ -1.43E-02, -2.01E-02, -5.14E-02, 0.159391 /) - UH_coef(:,11) = (/ 2.64E-03, 3.46E-02, -0.12318, -2.22E-02 /) - CASE ( 9 ) ! 230-250 m - UH_coef(:, 1) = (/ 0.717665, -0.294178, -0.521541, 0.876418 /) - UH_coef(:, 2) = (/ 0.183182, -0.52658, -1.34668, 0.414396 /) - UH_coef(:, 3) = (/ -0.196162, 9.84E-02, -3.83E-02, 0.156018 /) - UH_coef(:, 4) = (/ 2.92E-02, -0.362193, -0.658593, 0.521854 /) - UH_coef(:, 5) = (/ 3.37E-02, 0.108203, 0.318667, -0.375309 /) - UH_coef(:, 6) = (/ -8.24E-03, 0.128457, -0.149225, 0.1621 /) - UH_coef(:, 7) = (/ -3.06E-02, -0.210106, 4.55E-02, 8.42E-02 /) - UH_coef(:, 8) = (/ 3.02E-02, 0.184626, 9.46E-02, -0.215191 /) - UH_coef(:, 9) = (/ 7.03E-03, 2.49E-02, 3.13E-02, -9.70E-02 /) - UH_coef(:,10) = (/ -3.06E-03, -4.82E-02, -9.70E-02, 5.82E-02 /) - UH_coef(:,11) = (/ -9.57E-03, -3.93E-02, -0.125623, 0.112639 /) - CASE ( 10 ) ! 250-270 m - UH_coef(:, 1) = (/ 0.786229, -0.164848, 0.244948, -0.126263 /) - UH_coef(:, 2) = (/ 0.15218, -0.153233, -0.558524, 0.84425 /) - UH_coef(:, 3) = (/ -0.130716, -0.217411, 0.13439, -0.536893 /) - UH_coef(:, 4) = (/ 1.70E-03, 5.49E-02, 0.551012, 0.335778 /) - UH_coef(:, 5) = (/ 2.47E-02, 2.82E-02, 0.290918, -0.223416 /) - UH_coef(:, 6) = (/ 1.48E-02, 5.94E-02, -0.277959, 3.91E-02 /) - UH_coef(:, 7) = (/ -4.43E-02, 6.99E-03, 0.302386, 0.123719 /) - UH_coef(:, 8) = (/ 2.07E-02, 4.05E-02, -0.256155, -5.84E-02 /) - UH_coef(:, 9) = (/ 4.51E-03, -4.37E-02, -0.111911, -9.20E-03 /) - UH_coef(:,10) = (/ 4.05E-03, -6.90E-03, 0.14697, -7.03E-02 /) - UH_coef(:,11) = (/ -6.68E-03, 1.53E-02, -2.55E-02, 4.97E-02 /) - CASE ( 11 ) ! 270-290 m - UH_coef(:, 1) = (/ 0.715734, -0.772062, -0.556396, 1.02929 /) - UH_coef(:, 2) = (/ 0.322509, -0.465616, -0.671711, -1.2413 /) - UH_coef(:, 3) = (/ -0.166728, -0.281268, 0.924893, -0.282907 /) - UH_coef(:, 4) = (/ 1.27E-02, -0.342767, -1.10823, 0.516431 /) - UH_coef(:, 5) = (/ 3.80E-02, 5.35E-03, 0.833719, -0.510102 /) - UH_coef(:, 6) = (/ 1.97E-02, 0.279705, -0.179026, -4.36E-02 /) - UH_coef(:, 7) = (/ -4.74E-02, -0.227673, 9.00E-02, 0.341958 /) - UH_coef(:, 8) = (/ 8.99E-03, -1.92E-02, -0.433969, 5.90E-02 /) - UH_coef(:, 9) = (/ 4.34E-03, 8.12E-02, 0.25764, -0.148492 /) - UH_coef(:,10) = (/ 1.03E-02, 3.24E-02, 0.141971, -0.105207 /) - UH_coef(:,11) = (/ -4.84E-03, -1.99E-02, 7.33E-02, 2.84E-02 /) - CASE ( 12 ) ! 290-310 m - UH_coef(:, 1) = (/ 0.723348, -0.289581, -1.10618, 0.970713 /) - UH_coef(:, 2) = (/ 0.283383, 1.12986, -0.152861, -0.653269 /) - UH_coef(:, 3) = (/ -0.16513, 0.295047, 0.245326, -7.06E-02 /) - UH_coef(:, 4) = (/ 8.55E-03, 9.38E-02, -0.826824, 0.283436 /) - UH_coef(:, 5) = (/ 3.45E-02, 0.364581, 0.566317, -0.521081 /) - UH_coef(:, 6) = (/ 2.83E-02, 0.107252, -0.124867, -4.80E-02 /) - UH_coef(:, 7) = (/ -3.57E-02, -0.230151, -6.88E-02, 0.231208 /) - UH_coef(:, 8) = (/ 5.62E-04, 1.40E-02, -0.334942, 0.121313 /) - UH_coef(:, 9) = (/ -6.35E-03, -6.19E-02, 0.139396, 2.77E-02 /) - UH_coef(:,10) = (/ 1.14E-02, -2.67E-02, 0.24201, -0.127337 /) - UH_coef(:,11) = (/ 1.71E-04, -6.37E-04, 4.39E-02, -5.61E-03 /) - CASE ( 13 ) ! 310-330 m - UH_coef(:, 1) = (/ 0.736987, -0.103727, 9.95E-02, 0.343208 /) - UH_coef(:, 2) = (/ 0.28285, 0.370583, 1.17749, -0.490259 /) - UH_coef(:, 3) = (/ -0.130451, -0.557928, -0.272771, -0.230816 /) - UH_coef(:, 4) = (/ -1.83E-02, 1.00E-01, -0.367321, 0.486971 /) - UH_coef(:, 5) = (/ 2.66E-02, -0.149206, 0.365342, -0.318809 /) - UH_coef(:, 6) = (/ 4.16E-02, 3.60E-02, -0.801161, 6.00E-06 /) - UH_coef(:, 7) = (/ -2.36E-02, 1.96E-04, 0.340449, 2.72E-02 /) - UH_coef(:, 8) = (/ 1.30E-03, 0.214384, 0.125371, -8.47E-02 /) - UH_coef(:, 9) = (/ -1.23E-02, 4.75E-02, 0.182118, 1.78E-02 /) - UH_coef(:,10) = (/ 4.63E-03, -0.1309, -0.130584, 2.35E-02 /) - UH_coef(:,11) = (/ 9.03E-04, -6.18E-02, -7.85E-03, 1.17E-02 /) - CASE ( 14 ) ! 330-350 m - UH_coef(:, 1) = (/ 0.706488, -1.21766, 1.08617, 0.674247 /) - UH_coef(:, 2) = (/ 0.341777, 2.27476, 3.81434, -2.32363 /) - UH_coef(:, 3) = (/ -0.112822, 7.53E-02, 0.221349, -0.700428 /) - UH_coef(:, 4) = (/ -1.99E-02, -1.95E-02, 0.947788, 4.68E-02 /) - UH_coef(:, 5) = (/ 3.08E-02, 0.334947, 0.10847, -0.534662 /) - UH_coef(:, 6) = (/ 5.21E-02, 0.349056, -1.14517, -0.147474 /) - UH_coef(:, 7) = (/ -1.67E-02, -0.143994, -0.409398, 0.228081 /) - UH_coef(:, 8) = (/ -1.75E-03, -0.115198, 3.23E-03, 0.100094 /) - UH_coef(:, 9) = (/ -2.30E-02, -5.63E-02, 0.168561, 0.159537 /) - UH_coef(:,10) = (/ -6.41E-03, -8.48E-02, 0.135087, 8.81E-02 /) - UH_coef(:,11) = (/ 1.13E-03, 2.07E-02, 9.18E-02, -3.77E-02 /) - CASE ( 15 ) ! 350-370 m - UH_coef(:, 1) = (/ 0.721629, -0.941544, 0.923908, 0.543678 /) - UH_coef(:, 2) = (/ 0.346956, -0.281582, -2.32358, -0.244435 /) - UH_coef(:, 3) = (/ -0.109484, 0.275053, 0.86928, -0.771081 /) - UH_coef(:, 4) = (/ -3.96E-02, -0.790621, -8.84E-02, 0.723378 /) - UH_coef(:, 5) = (/ 1.59E-02, -0.394222, -0.479505, -8.67E-02 /) - UH_coef(:, 6) = (/ 2.68E-02, 0.466895, 0.522378, -0.263669 /) - UH_coef(:, 7) = (/ -9.57E-03, -8.52E-02, 1.11E-02, 3.20E-02 /) - UH_coef(:, 8) = (/ 3.46E-04, -5.34E-02, 0.15998, 0.108225 /) - UH_coef(:, 9) = (/ -1.10E-02, -0.116864, -6.06E-02, 6.09E-02 /) - UH_coef(:,10) = (/ -2.93E-03, 2.72E-02, 5.08E-02, 7.50E-03 /) - UH_coef(:,11) = (/ -2.04E-03, -2.07E-02, -3.07E-02, 3.58E-02 /) - CASE ( 16 ) ! 370-390 m - UH_coef(:, 1) = (/ 0.732127, -2.66819, -7.94E-02, 0.676096 /) - UH_coef(:, 2) = (/ 0.285167, 3.89442, -0.917426, 0.104248 /) - UH_coef(:, 3) = (/ -8.38E-02, 0.235268, -2.19E-03, -0.914663 /) - UH_coef(:, 4) = (/ -3.98E-02, -0.858603, -0.538194, 0.843739 /) - UH_coef(:, 5) = (/ -1.64E-02, 0.287007, -5.39E-02, 0.108834 /) - UH_coef(:, 6) = (/ 3.31E-02, 0.218726, 0.175636, -0.329844 /) - UH_coef(:, 7) = (/ 3.10E-05, -6.89E-02, 3.76E-02, -4.73E-02 /) - UH_coef(:, 8) = (/ 1.06E-02, -5.03E-02, 1.99E-02, 3.74E-02 /) - UH_coef(:, 9) = (/ -1.05E-02, 9.92E-02, 0.11293, 2.26E-02 /) - UH_coef(:,10) = (/ -2.99E-03, -0.106831, 0.122628, 1.83E-02 /) - UH_coef(:,11) = (/ -7.32E-03, 3.52E-02, -3.36E-02, 8.59E-02 /) - CASE ( 17 ) ! 390-410 m - UH_coef(:, 1) = (/ 0.707698, 0.119876, 0.427545, 0.2468 /) - UH_coef(:, 2) = (/ 0.307273, 0.428003, -3.09224, 1.01117 /) - UH_coef(:, 3) = (/ -7.33E-02, 0.51572, -0.229086, -0.792402 /) - UH_coef(:, 4) = (/ -4.73E-02, 8.49E-02, -0.52415, 0.571084 /) - UH_coef(:, 5) = (/ -2.83E-02, 0.165455, -0.691726, 0.349932 /) - UH_coef(:, 6) = (/ 2.17E-02, 0.258434, 0.170597, -0.236707 /) - UH_coef(:, 7) = (/ -4.59E-03, -0.130722, 0.182955, -3.40E-02 /) - UH_coef(:, 8) = (/ 1.82E-02, 9.79E-02, 0.189511, -0.158597 /) - UH_coef(:, 9) = (/ -7.84E-04, -2.50E-02, 0.137171, -5.77E-02 /) - UH_coef(:,10) = (/ -2.91E-03, -4.84E-02, 0.168698, 8.22E-03 /) - UH_coef(:,11) = (/ -4.67E-03, 1.75E-03, 1.80E-02, 4.41E-02 /) - CASE ( 18 ) ! 410-430 m - UH_coef(:, 1) = (/ 0.688761, -0.7286, -1.55711, 1.27145 /) - UH_coef(:, 2) = (/ 0.300421, 0.633115, 0.881706, -8.38E-03 /) - UH_coef(:, 3) = (/ -6.81E-02, 0.210301, 0.610772, -0.714435 /) - UH_coef(:, 4) = (/ -5.93E-02, -0.373997, -0.593894, 1.01556 /) - UH_coef(:, 5) = (/ -4.26E-02, -2.45E-02, -0.400705, 0.399717 /) - UH_coef(:, 6) = (/ 1.39E-02, 6.09E-02, -0.161239, -3.06E-02 /) - UH_coef(:, 7) = (/ -4.41E-03, -1.98E-02, 0.293288, -0.110401 /) - UH_coef(:, 8) = (/ 1.42E-02, 8.22E-02, -1.50E-02, -1.54E-02 /) - UH_coef(:, 9) = (/ 6.30E-03, -1.50E-02, -7.57E-02, -7.10E-02 /) - UH_coef(:,10) = (/ 2.19E-03, -2.59E-02, 8.53E-02, -2.29E-02 /) - UH_coef(:,11) = (/ -2.76E-03, 1.68E-02, -8.77E-02, 3.27E-02 /) - CASE ( 19 ) ! 430-450 m - UH_coef(:, 1) = (/ 0.659495, -0.22327, -1.75403, 1.65777 /) - UH_coef(:, 2) = (/ 0.384097, 1.06351, 2.53779, -1.63428 /) - UH_coef(:, 3) = (/ -2.42E-02, 0.113735, -1.42805, -0.690773 /) - UH_coef(:, 4) = (/ -3.30E-02, 8.60E-02, -1.00836, 0.764307 /) - UH_coef(:, 5) = (/ -2.76E-02, 0.297567, 0.697445, -0.187071 /) - UH_coef(:, 6) = (/ 1.21E-02, 0.212621, -0.570822, 1.23E-02 /) - UH_coef(:, 7) = (/ -2.22E-02, 0.166286, 0.50751, 1.87E-02 /) - UH_coef(:, 8) = (/ 1.52E-02, 5.81E-02, -0.256912, -5.10E-02 /) - UH_coef(:, 9) = (/ 2.11E-03, -1.45E-02, -8.94E-02, -2.00E-02 /) - UH_coef(:,10) = (/ 3.06E-03, 1.60E-02, 7.45E-02, -3.77E-02 /) - UH_coef(:,11) = (/ -1.84E-04, -1.56E-02, -6.25E-02, 1.57E-02 /) - CASE ( 20 ) ! 450-470 m - UH_coef(:, 1) = (/ 0.64099, -2.02496, 0.427597, 1.52166 /) - UH_coef(:, 2) = (/ 0.391609, 2.03441, -0.122486, -1.03579 /) - UH_coef(:, 3) = (/ 8.28E-03, 0.5942, -0.42469, -1.35655 /) - UH_coef(:, 4) = (/ -2.54E-02, -0.826812, -0.812187, 0.911776 /) - UH_coef(:, 5) = (/ -2.77E-02, -9.73E-03, 0.315974, 2.34E-02 /) - UH_coef(:, 6) = (/ 1.37E-02, 0.365984, 0.141952, -0.299349 /) - UH_coef(:, 7) = (/ -1.95E-02, -0.406182, 2.32E-02, 0.184752 /) - UH_coef(:, 8) = (/ 7.34E-03, 8.54E-02, -0.255458, 7.08E-02 /) - UH_coef(:, 9) = (/ 1.54E-03, 5.82E-02, -5.72E-02, -6.37E-02 /) - UH_coef(:,10) = (/ 5.11E-03, -6.11E-02, -7.04E-03, -3.64E-02 /) - UH_coef(:,11) = (/ 1.97E-03, -1.09E-02, -8.18E-02, -6.03E-03 /) - CASE ( 21 ) ! 470-490 m - UH_coef(:, 1) = (/ 0.547127, -0.327778, 2.00666, 2.67869 /) - UH_coef(:, 2) = (/ 0.427112, 8.56E-02, -1.61197, -1.17989 /) - UH_coef(:, 3) = (/ 6.23E-02, 0.760714, -0.659927, -2.30882 /) - UH_coef(:, 4) = (/ -4.04E-02, -0.873328, -0.118326, 1.19626 /) - UH_coef(:, 5) = (/ -4.85E-03, 0.130813, -0.169613, -0.181674 /) - UH_coef(:, 6) = (/ 4.82E-03, 0.289038, 7.34E-02, 6.45E-03 /) - UH_coef(:, 7) = (/ -2.49E-02, -0.375342, 0.15139, 0.208253 /) - UH_coef(:, 8) = (/ 9.48E-04, 5.23E-02, -0.213227, 0.137941 /) - UH_coef(:, 9) = (/ -9.18E-03, 3.91E-02, 7.26E-02, 4.73E-02 /) - UH_coef(:,10) = (/ -6.00E-05, 1.03E-02, 7.46E-03, 1.86E-02 /) - UH_coef(:,11) = (/ -2.21E-03, -9.70E-05, -7.13E-02, 4.29E-02 /) - CASE DEFAULT - CALL ProgAbort ('Error getting UH coefficients' ) - END SELECT - - SELECT CASE ( HtIndx ) - CASE ( 1 ) ! 70-90 m - WD_coef(:, 1) = (/ 5.07735, 96.4785, 18.8465, 110.986 /) - WD_coef(:, 2) = (/ 0.75209, -16.5103, -25.9592, 9.05636 /) - WD_coef(:, 3) = (/ -1.50806, 1.69319, -7.7859, 13.3041 /) - WD_coef(:, 4) = (/ 1.11287, 3.711, 13.1084, -11.9491 /) - WD_coef(:, 5) = (/ -0.987363, -2.93059, -4.75454, 9.04282 /) - WD_coef(:, 6) = (/ 0.65727, 0.560223, -0.541911, -5.33397 /) - WD_coef(:, 7) = (/ -0.493572, -0.455574, 2.03972, 3.53745 /) - WD_coef(:, 8) = (/ 0.244207, 0.390402, 1.5338, -1.9793 /) - WD_coef(:, 9) = (/ -1.26E-02, 0.19732, -2.70454, 0.179412 /) - WD_coef(:,10) = (/ 9.13E-04, 9.65E-02, 0.304467, 4.79E-02 /) - WD_coef(:,11) = (/ -7.71E-02, -0.11096, 0.51028, 0.585717 /) - CASE ( 2 ) ! 90-110 m - WD_coef(:, 1) = (/ 2.98622, 87.1045, 41.7453, 124.301 /) - WD_coef(:, 2) = (/ 0.241282, -10.9238, -31.5696, 11.0764 /) - WD_coef(:, 3) = (/ -0.380786, -1.71395, -8.35561, 3.68007 /) - WD_coef(:, 4) = (/ 0.287014, 6.76407, 17.1736, -7.4345 /) - WD_coef(:, 5) = (/ -0.682991, -5.48805, -12.7947, 10.9313 /) - WD_coef(:, 6) = (/ 0.415999, 2.36938, 4.47285, -5.47595 /) - WD_coef(:, 7) = (/ -0.184533, -7.04E-02, 0.81309, 1.06891 /) - WD_coef(:, 8) = (/ 0.152381, -0.344921, 3.40496, -1.81465 /) - WD_coef(:, 9) = (/ -0.113556, -1.02575, -5.54619, 2.51668 /) - WD_coef(:,10) = (/ 3.87E-02, 1.0794, 0.98668, -0.942351 /) - WD_coef(:,11) = (/ 7.37E-02, -0.284347, 1.12315, -1.04163 /) - CASE ( 3 ) ! 110-130 m - WD_coef(:, 1) = (/ -10.8064, 63.1523, 18.7751, 255.252 /) - WD_coef(:, 2) = (/ 1.89875, -15.7662, -27.2545, -5.90699 /) - WD_coef(:, 3) = (/ -1.81141, -7.58E-03, 4.49E-02, 19.4007 /) - WD_coef(:, 4) = (/ -0.420216, 4.54261, 16.6642, -1.5632 /) - WD_coef(:, 5) = (/ 3.09E-02, 0.162346, -5.68196, 1.70168 /) - WD_coef(:, 6) = (/ 0.372585, -0.888944, -0.400871, -3.98736 /) - WD_coef(:, 7) = (/ 0.137532, -1.86E-02, -1.97659, -1.07897 /) - WD_coef(:, 8) = (/ 7.11E-02, 0.275322, 2.06716, -0.99703 /) - WD_coef(:, 9) = (/ -0.142081, 0.690143, 1.74256, 0.963168 /) - WD_coef(:,10) = (/ -0.225792, -0.215169, 0.660299, 1.89319 /) - WD_coef(:,11) = (/ 1.91E-02, -0.23, -1.69222, 0.190668 /) - CASE ( 4 ) ! 130-150 m - WD_coef(:, 1) = (/ 0.270461, 107.786, 140.705, 143.549 /) - WD_coef(:, 2) = (/ 2.46519, 25.9261, 54.6629, -43.2182 /) - WD_coef(:, 3) = (/ -1.11746, -4.09287, -5.71316, 16.4144 /) - WD_coef(:, 4) = (/ -0.104557, 2.88836, 14.657, -5.58632 /) - WD_coef(:, 5) = (/ 1.4104, -0.862421, 1.88282, -13.3856 /) - WD_coef(:, 6) = (/ -0.994103, 6.07897, 6.16378, 6.53327 /) - WD_coef(:, 7) = (/ 0.440338, -7.14173, -12.2957, 0.653282 /) - WD_coef(:, 8) = (/ -0.705677, 2.13336, 2.39331, 5.62277 /) - WD_coef(:, 9) = (/ 0.398742, -3.5049, -3.97854, -1.68531 /) - WD_coef(:,10) = (/ -7.72E-02, 2.14124, 3.42657, -0.982025 /) - WD_coef(:,11) = (/ 0.120525, -1.80518, -3.44124, 0.391772 /) - CASE ( 5 ) ! 150-170 m - WD_coef(:, 1) = (/ 10.3894, 203.711, 87.9736, 0.818669 /) - WD_coef(:, 2) = (/ 4.15105, 37.734, 56.1061, -72.0928 /) - WD_coef(:, 3) = (/ -1.60031, -6.42686, 2.99983, 21.7355 /) - WD_coef(:, 4) = (/ 0.162421, -22.7335, 4.23498, 0.433394 /) - WD_coef(:, 5) = (/ -1.00817, -1.82237, -17.2291, 18.8346 /) - WD_coef(:, 6) = (/ 0.591051, 5.30019, 22.1782, -15.2786 /) - WD_coef(:, 7) = (/ -0.350898, -1.35238, -14.9057, 9.09022 /) - WD_coef(:, 8) = (/ 0.512704, 5.33682, 12.0501, -11.3284 /) - WD_coef(:, 9) = (/ -0.294613, -6.61282, -13.756, 9.48747 /) - WD_coef(:,10) = (/ 0.180824, 6.67558, 8.1748, -6.39538 /) - WD_coef(:,11) = (/ -0.168678, -3.5973, -2.92266, 3.62255 /) - CASE ( 6 ) ! 170-190 m - WD_coef(:, 1) = (/ -3.05838, 92.242, -6.17694, 218.678 /) - WD_coef(:, 2) = (/ -1.19176, 10.9436, 5.33317, 23.6574 /) - WD_coef(:, 3) = (/ 0.396791, 5.36609, 14.86, -12.1807 /) - WD_coef(:, 4) = (/ -0.260044, -3.3155, -1.83325, 3.07872 /) - WD_coef(:, 5) = (/ 0.147588, 3.54423, 2.61624, -2.87076 /) - WD_coef(:, 6) = (/ -3.09E-02, -0.298005, -3.99378, 2.512 /) - WD_coef(:, 7) = (/ 3.52E-02, 0.476622, 0.917889, -1.19482 /) - WD_coef(:, 8) = (/ -0.10397, -3.13393, -1.34654, 2.38467 /) - WD_coef(:, 9) = (/ 0.111959, 0.768005, 1.09164, -1.84864 /) - WD_coef(:,10) = (/ -5.32E-02, -0.753046, 0.517477, 0.77376 /) - WD_coef(:,11) = (/ 2.36E-02, -0.255733, -0.765475, -0.183366 /) - CASE ( 7 ) ! 190-210 m - WD_coef(:, 1) = (/ 2.63747, 48.8574, -148.839, 198.635 /) - WD_coef(:, 2) = (/ 0.276349, 8.15568, 11.5466, 4.89475 /) - WD_coef(:, 3) = (/ -0.161153, -3.92434, 15.2465, -2.75263 /) - WD_coef(:, 4) = (/ -0.215546, -6.05707, -0.221136, 2.96778 /) - WD_coef(:, 5) = (/ -0.174687, 0.722833, 2.58751, 1.43519 /) - WD_coef(:, 6) = (/ -3.24E-03, 0.841219, 2.36677, -0.541046 /) - WD_coef(:, 7) = (/ -0.14379, -0.422125, 6.03272, -3.55E-02 /) - WD_coef(:, 8) = (/ 4.94E-02, -0.165447, -1.64947, -0.118004 /) - WD_coef(:, 9) = (/ 6.88E-03, 0.618011, 0.600728, -0.312735 /) - WD_coef(:,10) = (/ -2.96E-02, -0.102388, -0.423526, 0.526055 /) - WD_coef(:,11) = (/ 3.77E-03, -0.79762, -1.48591, 0.487559 /) - CASE ( 8 ) ! 210-230 m - WD_coef(:, 1) = (/ 1.25931, 81.7121, -72.2497, 192.288 /) - WD_coef(:, 2) = (/ -0.421425, 0.812039, 26.4136, 12.7087 /) - WD_coef(:, 3) = (/ -0.477334, -0.804493, 10.2938, 2.63738 /) - WD_coef(:, 4) = (/ 0.27025, -1.48414, 6.44E-02, -3.62925 /) - WD_coef(:, 5) = (/ -0.206555, 2.60212, 4.78E-03, 1.41829 /) - WD_coef(:, 6) = (/ 0.199714, -0.145286, -1.43609, -1.0421 /) - WD_coef(:, 7) = (/ -8.81E-02, -1.11826, 0.562309, 0.568182 /) - WD_coef(:, 8) = (/ 4.38E-02, -0.94946, -1.20199, 0.184361 /) - WD_coef(:, 9) = (/ -5.13E-02, -0.157795, -0.596316, 0.747777 /) - WD_coef(:,10) = (/ 5.03E-02, 6.23E-02, -0.821348, -0.411198 /) - WD_coef(:,11) = (/ -2.45E-02, 3.66E-03, 0.61934, 0.147334 /) - CASE ( 9 ) ! 230-250 m - WD_coef(:, 1) = (/ 4.99773, 45.439, -22.9981, 142.166 /) - WD_coef(:, 2) = (/ 1.34923, -0.690733, 1.11037, -7.00256 /) - WD_coef(:, 3) = (/ -4.58E-02, -1.48399, 3.15438, -1.20619 /) - WD_coef(:, 4) = (/ -5.86E-02, -0.324401, -0.520264, 0.827308 /) - WD_coef(:, 5) = (/ 6.67E-02, 1.95293, -1.46579, -1.66186 /) - WD_coef(:, 6) = (/ 2.23E-02, 1.10257, 1.61038, -0.14154 /) - WD_coef(:, 7) = (/ 4.83E-02, -0.46633, 0.318096, -1.22718 /) - WD_coef(:, 8) = (/ -3.56E-02, -0.905797, -0.659337, 1.10221 /) - WD_coef(:, 9) = (/ -6.54E-04, 0.514329, 0.38488, -0.221416 /) - WD_coef(:,10) = (/ 2.40E-03, -0.307029, -0.455799, 0.167602 /) - WD_coef(:,11) = (/ 5.79E-03, -0.3575, -6.82E-02, -1.79E-02 /) - CASE ( 10 ) ! 250-270 m - WD_coef(:, 1) = (/ 2.87491, 81.7603, -14.221, 143.973 /) - WD_coef(:, 2) = (/ 0.176626, 0.711168, 14.3778, 3.41781 /) - WD_coef(:, 3) = (/ -0.112353, -4.44334, 5.01439, -0.539061 /) - WD_coef(:, 4) = (/ 0.135496, 0.868787, -2.54952, -1.4882 /) - WD_coef(:, 5) = (/ -5.87E-02, 7.34E-02, 0.618705, 0.341871 /) - WD_coef(:, 6) = (/ 4.36E-02, 1.16076, -2.2411, 0.371484 /) - WD_coef(:, 7) = (/ -4.21E-03, -0.219162, 3.07613, -1.48294 /) - WD_coef(:, 8) = (/ 2.91E-02, -7.90E-02, -2.06058, 0.637811 /) - WD_coef(:, 9) = (/ 6.84E-04, 0.398542, -0.227958, -0.195655 /) - WD_coef(:,10) = (/ -1.33E-02, -0.148014, 0.112677, 0.28039 /) - WD_coef(:,11) = (/ 4.56E-02, -0.4372, -1.05259, -0.39506 /) - CASE ( 11 ) ! 270-290 m - WD_coef(:, 1) = (/ -3.74E-02, 5.72313, -25.8459, 204.708 /) - WD_coef(:, 2) = (/ 0.387587, 5.70337, 37.0722, -5.10619 /) - WD_coef(:, 3) = (/ 0.130067, 8.86213, 7.6219, -6.77984 /) - WD_coef(:, 4) = (/ -1.83E-02, -4.80402, 1.26728, 1.1988 /) - WD_coef(:, 5) = (/ -0.125984, 5.69111, -2.4798, 0.370193 /) - WD_coef(:, 6) = (/ 7.02E-02, -4.02809, 0.545202, 0.396538 /) - WD_coef(:, 7) = (/ -4.89E-02, 1.99119, -7.47E-02, -0.617665 /) - WD_coef(:, 8) = (/ 7.28E-02, -1.94844, -0.9012, 0.174322 /) - WD_coef(:, 9) = (/ -2.75E-02, 0.875895, 8.29E-02, 1.47E-02 /) - WD_coef(:,10) = (/ -4.90E-03, -0.26505, 0.684299, -0.101304 /) - WD_coef(:,11) = (/ -2.46E-03, -9.03E-02, -0.25124, 0.130552 /) - CASE ( 12 ) ! 290-310 m - WD_coef(:, 1) = (/ 4.48806, 101.681, -24.2152, 108.849 /) - WD_coef(:, 2) = (/ 1.12228, -11.8153, -5.83094, -3.59506 /) - WD_coef(:, 3) = (/ 0.152934, 0.610899, 10.1148, -6.59595 /) - WD_coef(:, 4) = (/ 6.76E-02, 1.44362, -8.36227, 1.70741 /) - WD_coef(:, 5) = (/ -8.86E-02, 1.22016, 4.89384, -1.422 /) - WD_coef(:, 6) = (/ 1.14E-02, -0.801065, -4.6529, 2.29577 /) - WD_coef(:, 7) = (/ -5.68E-03, -0.156515, 3.48364, -1.85745 /) - WD_coef(:, 8) = (/ 3.21E-02, 0.643855, -1.80571, 0.499593 /) - WD_coef(:, 9) = (/ -5.96E-03, -0.645, 1.0105, -0.256849 /) - WD_coef(:,10) = (/ -1.79E-02, 0.137457, -7.45E-03, 0.232805 /) - WD_coef(:,11) = (/ -5.07E-04, -1.20E-03, -0.280138, 9.13E-02 /) - CASE ( 13 ) ! 310-330 m - WD_coef(:, 1) = (/ 0.253568, 43.3822, 42.3741, 166.917 /) - WD_coef(:, 2) = (/ -0.210713, 14.3161, 12.187, 9.66539 /) - WD_coef(:, 3) = (/ 0.176871, -3.28688, -2.78059, -1.64384 /) - WD_coef(:, 4) = (/ 0.30952, 2.34743, -5.8261, -3.72051 /) - WD_coef(:, 5) = (/ -0.211586, -1.38792, -0.891686, 3.26282 /) - WD_coef(:, 6) = (/ 0.114874, -1.0177, -2.95833, -0.285227 /) - WD_coef(:, 7) = (/ -0.168163, 1.33608, 5.32715, 0.270668 /) - WD_coef(:, 8) = (/ 0.106821, 0.746965, -1.28128, -1.11127 /) - WD_coef(:, 9) = (/ -2.17E-02, 0.198171, 0.911532, 2.31E-02 /) - WD_coef(:,10) = (/ -5.64E-03, 0.278658, 0.250055, -9.16E-02 /) - WD_coef(:,11) = (/ 7.21E-03, 2.24E-02, 6.76E-02, -0.1011 /) - CASE ( 14 ) ! 330-350 m - WD_coef(:, 1) = (/ 1.4365, 104.113, 86.7884, 138.082 /) - WD_coef(:, 2) = (/ 1.01951, -22.4231, 8.14651, -3.0374 /) - WD_coef(:, 3) = (/ -0.14238, 5.5217, -8.37098, 1.9052 /) - WD_coef(:, 4) = (/ -8.04E-02, 2.56411, 8.01756, 0.450076 /) - WD_coef(:, 5) = (/ 7.34E-03, -3.31792, -10.0037, 1.66433 /) - WD_coef(:, 6) = (/ -3.82E-02, 3.00083, 6.14358, -0.656165 /) - WD_coef(:, 7) = (/ 0.113861, -4.41267, -2.98194, -1.24882 /) - WD_coef(:, 8) = (/ -0.154066, 4.29174, 3.74587, 1.4816 /) - WD_coef(:, 9) = (/ 0.127996, -2.88696, -2.49795, -1.24336 /) - WD_coef(:,10) = (/ -6.71E-02, 1.70388, 0.935254, 0.748082 /) - WD_coef(:,11) = (/ 8.19E-03, -4.50E-02, -0.263839, -5.18E-02 /) - CASE ( 15 ) ! 350-370 m - WD_coef(:, 1) = (/ -0.675054, 121.016, 0.173435, 199.751 /) - WD_coef(:, 2) = (/ -0.52795, 26.7663, 36.6465, 8.14164 /) - WD_coef(:, 3) = (/ 0.686068, -2.58652, 1.37125, -12.8021 /) - WD_coef(:, 4) = (/ -0.115391, -0.715049, 0.225913, 2.68255 /) - WD_coef(:, 5) = (/ 0.127924, 1.18619, -3.81934, -2.40047 /) - WD_coef(:, 6) = (/ -0.201212, -1.51136, 4.51548, 3.23679 /) - WD_coef(:, 7) = (/ 0.175571, -0.664591, -5.74074, -2.24143 /) - WD_coef(:, 8) = (/ -0.107098, 0.889236, 3.25149, 1.18349 /) - WD_coef(:, 9) = (/ 3.15E-02, -6.48E-02, -0.882842, -0.404645 /) - WD_coef(:,10) = (/ -9.69E-03, -0.486174, -0.284323, 0.336898 /) - WD_coef(:,11) = (/ 1.04E-03, -0.144399, -6.10E-02, 6.62E-02 /) - CASE ( 16 ) ! 370-390 m - WD_coef(:, 1) = (/ 0.610558, -90.3161, -86.1311, 221.346 /) - WD_coef(:, 2) = (/ -0.878196, 0.234356, -1.96802, 30.3835 /) - WD_coef(:, 3) = (/ 0.536954, 2.31986, 0.611791, -11.624 /) - WD_coef(:, 4) = (/ -0.203843, -2.10521, -1.77538, 5.20693 /) - WD_coef(:, 5) = (/ -6.04E-02, -1.53784, 0.391834, 1.09004 /) - WD_coef(:, 6) = (/ -3.32E-02, 1.08307, 0.756223, 0.579045 /) - WD_coef(:, 7) = (/ 2.20E-03, 1.00851, 0.872176, -1.24302 /) - WD_coef(:, 8) = (/ -4.70E-02, 0.313443, -5.20E-02, 1.24129 /) - WD_coef(:, 9) = (/ 0.105906, 2.60251, -0.805126, -2.35033 /) - WD_coef(:,10) = (/ -3.95E-02, -0.866726, 0.244709, 0.996069 /) - WD_coef(:,11) = (/ 5.34E-02, 0.423689, -0.910358, -0.888237 /) - CASE ( 17 ) ! 390-410 m - WD_coef(:, 1) = (/ -0.256694, -53.0924, -28.899, 212.286 /) - WD_coef(:, 2) = (/ 0.368178, 0.200188,-15.1321, 9.40209 /) - WD_coef(:, 3) = (/ -0.102825, -4.83546, 9.24228, -0.64019 /) - WD_coef(:, 4) = (/ 0.191961, 2.99238, -4.8869, -2.80575 /) - WD_coef(:, 5) = (/ -9.33E-02, 0.237869, 3.72573, -8.03E-02 /) - WD_coef(:, 6) = (/ 1.70E-02, 2.22246, -0.874, 0.324301 /) - WD_coef(:, 7) = (/ -4.39E-02, -1.22545, 1.03253, -7.41E-02 /) - WD_coef(:, 8) = (/ 9.07E-03, -0.438369, -1.85468, 0.746178 /) - WD_coef(:, 9) = (/ -2.97E-02, -0.626331, 1.32958, 0.161941 /) - WD_coef(:,10) = (/ -4.73E-03, -0.639604, -0.50062, 0.398523 /) - WD_coef(:,11) = (/ 7.78E-04, 0.203885, 0.111938, -9.66E-02 /) - CASE ( 18 ) ! 410-430 m - WD_coef(:, 1) = (/ -1.05454, 19.3432, 14.3866, 209.914 /) - WD_coef(:, 2) = (/ -5.37E-02, -6.69143, -5.48868, 13.8188 /) - WD_coef(:, 3) = (/ 0.130461, 1.84379, 10.2975, -6.85151 /) - WD_coef(:, 4) = (/ 0.120135, 3.25255, -4.64527, -0.957415 /) - WD_coef(:, 5) = (/ -0.157071, -1.87681, 4.37492, 1.52585 /) - WD_coef(:, 6) = (/ 0.220174, 1.14707, -5.27774, -2.10403 /) - WD_coef(:, 7) = (/ -0.185849, -8.73E-02, 4.5702, 1.45097 /) - WD_coef(:, 8) = (/ 5.77E-02, -0.265271, -2.17262, 1.19E-02 /) - WD_coef(:, 9) = (/ -3.19E-02, 0.159054, 1.11463, 9.91E-02 /) - WD_coef(:,10) = (/ -9.31E-03, -0.514427, -0.486658, 0.472324 /) - WD_coef(:,11) = (/ 5.84E-03, -6.98E-02, -6.53E-02, -7.68E-02 /) - CASE ( 19 ) ! 430-450 m - WD_coef(:, 1) = (/ 0.624689, 63.9533, -115.139, 203.718 /) - WD_coef(:, 2) = (/ -0.249911, 8.56489, 12.0426, 11.2274 /) - WD_coef(:, 3) = (/ 0.208499, -2.38494, 8.76157, -7.17681 /) - WD_coef(:, 4) = (/ -0.205812, 3.60713, 5.60652, 2.51439 /) - WD_coef(:, 5) = (/ 0.320606, -7.16713, -10.6408, -3.32927 /) - WD_coef(:, 6) = (/ -0.178674, 5.15743, 3.70481, 2.92097 /) - WD_coef(:, 7) = (/ 0.101549, -5.22916, -1.89887, -1.64557 /) - WD_coef(:, 8) = (/ -9.30E-02, 2.8729, 1.14221, 1.4604 /) - WD_coef(:, 9) = (/ 1.45E-02, -1.29998, -0.491218, -6.91E-02 /) - WD_coef(:,10) = (/ -6.95E-04, 0.830442, 1.25591, -0.451134 /) - WD_coef(:,11) = (/ -6.90E-04, 1.30E-02, -0.16423, 7.65E-02 /) - CASE ( 20 ) ! 450-470 m - WD_coef(:, 1) = (/ 4.30205, 83.823, -77.8869, 120.115 /) - WD_coef(:, 2) = (/ 0.11147, -2.13123, -13.0305, 11.4506 /) - WD_coef(:, 3) = (/ 5.36E-02, -9.82942, 3.21203, -2.14437 /) - WD_coef(:, 4) = (/ 3.12E-02, -0.694, -2.56494, 0.846492 /) - WD_coef(:, 5) = (/ -3.97E-02, 0.628515, 0.898384, -0.403596 /) - WD_coef(:, 6) = (/ 0.187725, -1.32489, -3.10108, -1.64756 /) - WD_coef(:, 7) = (/ -8.75E-02, -0.750003, 1.2358, 0.95118 /) - WD_coef(:, 8) = (/ 4.29E-02, 0.206995, -0.591777, -0.495133 /) - WD_coef(:, 9) = (/ -3.25E-02, 0.187007, 0.351131, 0.374602 /) - WD_coef(:,10) = (/ -1.79E-02, -0.651232, -0.437205, 0.653204 /) - WD_coef(:,11) = (/ 5.74E-03, 0.210108, -0.185616, -8.91E-02 /) - CASE ( 21 ) ! 470-490 m - WD_coef(:, 1) = (/ 0.685959, 76.5757, -26.8137, 187.31 /) - WD_coef(:, 2) = (/ -0.229648, 3.36903, -12.3466, 19.5787 /) - WD_coef(:, 3) = (/ 5.56E-02, -6.33886, 2.64958, -2.35925 /) - WD_coef(:, 4) = (/ -3.42E-02, -1.78314, 1.51304, 0.43034 /) - WD_coef(:, 5) = (/ 5.81E-02, 4.2818, -1.08668, -2.13185 /) - WD_coef(:, 6) = (/ -1.94E-02, -2.76039, -0.573698, 1.97694 /) - WD_coef(:, 7) = (/ 1.26E-02, 0.932315, 0.974862, -1.5273 /) - WD_coef(:, 8) = (/ 1.04E-02, -0.143063, -0.728002, 0.464589 /) - WD_coef(:, 9) = (/ 1.21E-03, 0.262702, -0.133363, -0.236706 /) - WD_coef(:,10) = (/ -2.29E-04, -0.162697, -0.138587, 0.17236 /) - WD_coef(:,11) = (/ 6.61E-03, -5.47E-02, -0.104054, -9.64E-02 /) - CASE DEFAULT - CALL ProgAbort ('Error getting WD coefficients' ) - END SELECT - - RETURN -END SUBROUTINE get_coefs -!======================================================================= -FUNCTION getUStarProfile(p, WS, Ht, UStarOffset, UstarSlope) - - IMPLICIT NONE - - TYPE(TurbSim_ParameterType), INTENT(IN) :: p !< parameters - REAL(ReKi), INTENT(IN) :: Ht(:) ! Height at which ustar is defined - REAL(ReKi), INTENT(IN) :: WS(:) ! Wind speed(s) at heights, Ht - REAL(ReKi), INTENT(IN) :: UStarOffset ! A scaling/offset value used with the Ustar_profile to ensure that the mean hub u'w' and ustar inputs agree with the profile values - REAL(ReKi), INTENT(IN) :: UstarSlope ! A scaling/slope value used with the Ustar_profile to ensure that the mean hub u'w' and ustar inputs agree with the profile values - - REAL(ReKi) :: tmpZ ! a temporary value - REAL(ReKi) :: getUStarProfile(SIZE(Ht)) ! the array of ustar values - - INTEGER(IntKi) :: IZ - INTEGER(IntKi) :: Zindx - INTEGER(IntKi) :: Zindx_mn (1) - INTEGER(IntKi) :: Zindx_mx (1) - - LOGICAL :: mask(SIZE(Ht)) - - mask = Ht.GE.profileZmin - IF ( ANY(mask) ) THEN - Zindx_mn = MINLOC( Ht, MASK=mask ) - - mask = Ht.LE.profileZmax - IF ( ANY(mask) ) THEN - Zindx_mx = MAXLOC( Ht, MASK=mask ) - - DO IZ = 1,SIZE(Ht) - IF ( Ht(IZ) < profileZmin ) THEN - Zindx = Zindx_mn(1) - ELSEIF ( Ht(IZ) > profileZmax ) THEN - Zindx = Zindx_mx(1) - ELSE - Zindx = IZ - ENDIF - - tmpZ = Ht(Zindx) !ustar is constant below 50 meters, and we don't want to extrapolate too high (last measurement is at 116 m) - - getUStarProfile( IZ) = ( 0.045355367 + 4.47275E-8*tmpZ**3) & - + ( 0.511491978 - 0.09691157*LOG(tmpZ) - 199.226951/tmpZ**2 ) * WS(Zindx) & - + (-0.00396447 - 55.7818832/tmpZ**2 ) * p%met%RICH_NO & - + (-5.35764429 + 0.102002162*tmpZ/LOG(tmpZ) + 25.30585136/SQRT(tmpZ) ) * p%met%UstarDiab - ENDDO - - ELSE ! All are above the max height so we'll use the old relationship at all heights - getUStarProfile(:) = 0.17454 + 0.72045*p%met%UstarDiab**1.36242 - ENDIF - - ELSE ! All are below the min height so we'll use the diabatic Ustar value - getUStarProfile(:) = p%met%UstarDiab - ENDIF - - getUStarProfile = UstarSlope * getUStarProfile(:) + UstarOffset ! These terms are used to make the ustar profile match the rotor-disk averaged value and input hub u'w' - -END FUNCTION -!======================================================================= -FUNCTION getZLProfile(WS, Ht, RichNo, ZL, L, ZLOffset, WindProfileType) - - IMPLICIT NONE - - - REAL(ReKi), INTENT(IN) :: Ht(:) ! Height at which local z/L is defined - REAL(ReKi), INTENT(IN) :: WS(:) ! Wind speed(s) at heights, Ht - REAL(ReKi), INTENT(IN) :: RichNo ! Richardson Number - REAL(ReKi), INTENT(IN) :: ZL ! z/L, an alternate measure of stability (M-O) for RichNo - REAL(ReKi), INTENT(IN) :: L ! L, M-O length - REAL(ReKi), INTENT(IN) :: ZLOffset ! Offset to align profile with rotor-disk averaged z/L - - CHARACTER(*), INTENT(IN) :: WindProfileType - - REAL(ReKi) :: tmpZ ! a temporary value - REAL(ReKi) :: getZLProfile(SIZE(Ht)) ! the array of z/L values - - INTEGER :: IZ - INTEGER :: Zindx - INTEGER :: Zindx_mn (1) - INTEGER :: Zindx_mx (1) - - LOGICAL :: mask(SIZE(Ht)) - - mask = Ht.GE.profileZmin - IF ( ANY(mask) ) THEN - Zindx_mn = MINLOC( Ht, MASK=mask ) - - mask = Ht.LE.profileZmax - IF ( ANY(mask) ) THEN - Zindx_mx = MAXLOC( Ht, MASK=mask ) - - DO IZ = 1,SIZE(Ht) - IF ( Ht(IZ) < profileZmin ) THEN - Zindx = Zindx_mn(1) - tmpZ = Ht(IZ) / Ht(Zindx) ! This keeps L constant below 50 m - ELSEIF ( Ht(IZ) > profileZmax ) THEN - Zindx = Zindx_mx(1) - tmpZ = 1.0 ! L changes above measurement height, but since we don't know how much, we're going to keep z/L constant - ELSE - Zindx = IZ - tmpZ = 1.0 - ENDIF !L is constant below 50 meters, and we don't want to extrapolate too high (last measurement is at 116 m) - - IF ( INDEX( 'JU', WindProfileType(1:1) ) > 0 ) THEN - IF ( RichNo >= 0 ) THEN - getZLProfile( IZ) = - 0.352464*RichNo + 0.005272*WS(Zindx) + 0.465838 - ELSE - getZLProfile( IZ) = 0.004034*Ht(Zindx) + 0.809494*RichNo - 0.008298*WS(Zindx) - 0.386632 - ENDIF !RichNo - ELSE - IF ( RichNo >= 0 ) THEN - getZLProfile( IZ) = 0.003068*Ht(Zindx) + 1.140264*RichNo + 0.036726*WS(Zindx) - 0.407269 - ELSE - getZLProfile( IZ) = 0.003010*Ht(Zindx) + 0.942617*RichNo - 0.221886 - ENDIF - ENDIF - getZLProfile( IZ) = MIN( getZLProfile( IZ), 1.0_ReKi ) - getZLProfile( IZ) = getZLProfile(IZ) * tmpZ - - ENDDO - - ELSE ! All are above the max height so instead of extrapolating, we'll use ZL at all heights - getZLProfile(:) = ZL - ENDIF - - ELSE ! All are below the min height so we'll keep L constant (as is the case in the surface layer) - getZLProfile(:) = Ht(:) / L - ENDIF - - getZLProfile = getZLProfile(:) + ZLOffset ! This offset term is used to make the zl profile match the rotor-disk averaged value - - -END FUNCTION getZLProfile -!======================================================================= -END MODULE TS_Profiles diff --git a/OpenFAST/modules/turbsim/src/RandNum.f90 b/OpenFAST/modules/turbsim/src/RandNum.f90 deleted file mode 100644 index 34910d3c4..000000000 --- a/OpenFAST/modules/turbsim/src/RandNum.f90 +++ /dev/null @@ -1,1046 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2014, 2016 National Renewable Energy Laboratory -! -! This file is part of TurbSim. -! -! 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. -! -!********************************************************************************************************************************** -MODULE TS_RandNum - - USE TurbSim_Types - USE Ran_Lux_Mod - - IMPLICIT NONE - - - INTEGER(IntKi), PARAMETER :: pRNG_RANLUX = 1 - INTEGER(IntKi), PARAMETER :: pRNG_INTRINSIC = 2 - INTEGER(IntKi), PARAMETER :: pRNG_SNLW3 = 3 - - - INTEGER, PARAMETER :: LuxLevel = 3 ! Luxury Level for RanLux RNG - - -CONTAINS - -!======================================================================= -SUBROUTINE RandNum_Init(p, OtherSt, ErrStat, ErrMsg ) - - ! Initialize the Random Number Generators - - -IMPLICIT NONE - -TYPE(RandNum_ParameterType), INTENT(IN ) :: p ! parameters for random number generation -TYPE(RandNum_OtherStateType), INTENT(INOUT) :: OtherSt ! other states for random number generation -INTEGER(IntKi) , INTENT(OUT) :: ErrStat ! allocation status -CHARACTER(*) , INTENT(OUT) :: ErrMsg ! error message - - - -REAL(ReKi) :: RN(1) -INTEGER :: I ! loop counter -INTEGER :: NumSeeds ! number of seeds in the intrinsic random number generator - -ErrStat = ErrID_None -ErrMsg = "" - -IF (p%pRNG == pRNG_INTRINSIC) THEN ! RNG_type == 'NORMAL' - - - ! determine the number of seeds necessary (gfortran needs 8 or 12 seeds, not just 2) - - CALL RANDOM_SEED ( SIZE = NumSeeds ) - - IF ( NumSeeds /= 2 ) THEN - CALL ProgWarn( ' The random number generator in use differs from the original code provided by NREL. This pRNG uses ' & - //TRIM(Int2LStr(NumSeeds))//' seeds instead of the 2 in the TurbSim input file.') - END IF - - IF ( .NOT. ALLOCATED( OtherSt%nextSeed ) ) THEN - CALL AllocAry( OtherSt%nextSeed, NumSeeds, 'nextSeed', ErrSTat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN - END IF - - - ! We'll just populate this with odd seeds = Seed(1) and even seeds = Seed(2) - DO I = 1,NumSeeds,2 - OtherSt%nextSeed(I) = p%RandSeed(1) - END DO - DO I = 2,NumSeeds,2 - OtherSt%nextSeed(I) = p%RandSeed(2) - END DO - - - CALL RANDOM_SEED ( PUT=OtherSt%nextSeed ) - - -ELSEIF (p%pRNG == pRNG_RANLUX) THEN ! RNG_type == 'RANLUX' - - CALL RLuxGo ( LuxLevel, ABS( p%RandSeed(1) ), 0, 0 ) - - IF (.NOT. ALLOCATED( OtherSt%nextSeed ) ) THEN - CALL AllocAry( OtherSt%nextSeed, 2, 'nextSeed', ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN - END IF - - - -ELSE ! pRNG == pRNG_SNLW3 - - - IF (.NOT. ALLOCATED( OtherSt%nextSeed ) ) THEN - CALL AllocAry( OtherSt%nextSeed, 3, 'nextSeed', ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN - END IF - - - ! A quick and dirty way to get three random seeds for u, v, and w - ! This implementation allows comparisons with Neil's SNLWIND-3D - - OtherSt%nextSeed = p%RandSeed - - CALL ARand( OtherSt%nextSeed(1), RN,1,1) - - OtherSt%nextSeed(2) = OtherSt%nextSeed(1)+1 - CALL ARand( OtherSt%nextSeed(2), RN,1,1) - - OtherSt%nextSeed(3) = OtherSt%nextSeed(2)+1 - CALL ARand( OtherSt%nextSeed(3), RN,1,1) - - -ENDIF - -END SUBROUTINE RandNum_Init -!======================================================================= -SUBROUTINE ARand(ix, RandNum_Ary,I, RNG_start) - -IMPLICIT NONE - - ! Passed variables - - -REAL(ReKi), INTENT(OUT) :: RandNum_Ary(:) ! Output: random numbers -INTEGER(IntKi), INTENT(IN) :: I ! Input: Size of RandNum_Ary to be filled -INTEGER(IntKi), INTENT(INOUT) :: ix ! Input/Output: Seed !BONNIE: should this be set to Integer(4), not default integer size? -INTEGER(IntKi), INTENT(IN) :: RNG_start - - ! Local variables - -INTEGER, PARAMETER :: B15 = 32768 ! = 2^15 -INTEGER, PARAMETER :: B16 = 65536 ! = 2^16 -INTEGER :: fHI -INTEGER :: K ! Loop counter -INTEGER :: leftLO -INTEGER, PARAMETER :: ranA = 16807 ! = 7^5 -INTEGER :: rank -INTEGER, PARAMETER :: ranP = 2147483647 ! = 2^31 - 1 = huge(ranP) -INTEGER :: xHI -INTEGER :: xaLO - -REAL(ReKi), PARAMETER :: ranPR = 1.0 / REAL(ranP, ReKi) - -!BONNIE: We should check that RandNum_Ary is dimensioned correctly.... - -DO K = RNG_start, RNG_start+I-1 - - xHI = ix / B16 - xaLO = (ix - B16*xHI) * ranA ! MOD( ix, B16 ) * ranA - - leftLO = xaLO / B16 - fHI = xHI*ranA + leftLO - rank = fHI / B15 - - ix = (((xaLO - leftLO*B16) - ranP) + (fHI - rank*B15)*B16) + rank - ! ranP is subtracted in order to avoid overflow - ! MOD( xaLO, B16 ) - ranP + B16*MOD( fHI, B15 ) + (fHI / B15) - - IF (ix < 0) ix = ix + ranP - - RandNum_Ary(K) = REAL(ix) * ranPR - -ENDDO - -END SUBROUTINE ARand -!======================================================================= -SUBROUTINE Rnd4ParmLogNorm( p, OtherSt, RandNum, Parms, FnRange ) - ! This subroutine generates a random variate with a PDF of the form - ! f(x) = A + B*exp(-0.5*(ln(x/C)/D)^2) - ! a truely log-normal distribution has A = 0 - -IMPLICIT NONE -TYPE(RandNum_ParameterType), INTENT(IN ) :: p ! parameters for random number generation -TYPE(RandNum_OtherStateType), INTENT(INOUT) :: OtherSt ! other states for random number generation - -REAL(ReKi), INTENT(IN) :: Parms(4) ! 1=a, 2=b, 3=c, 4=d -REAL(ReKi), INTENT(IN) :: FnRange(2) - -REAL(ReKi) :: fMAX ! Max(f(x)) ! occurs at f(b) -REAL(ReKi) :: Gx ! The function g(x) = f(x)/fMAX -REAL(ReKi) :: MaxVALUE ! Maximum value of returned variate -REAL(ReKi) :: MinVALUE ! Minimum value of returned variate -REAL(ReKi), INTENT(OUT) :: RandNum ! numbers distributed with the pdf above -REAL(ReKi) :: RN ! A random number for the acceptance-rejection method - -INTEGER :: Count -INTEGER, PARAMETER :: MaxIter = 10000 ! Max number of iterations to converge (so we don't get an infinite loop) - -fMAX = Parms(1) + Parms(2) !See if this is correct. -MaxVALUE = MAX(FnRange(1),FnRange(2)) -MinVALUE = MIN(FnRange(1),FnRange(2)) - -Count = 1 - - ! Generate a normal distribution on (0,1) from a uniform distribution ( ACTUALLY [0,1) ) - -DO WHILE (Count < MaxIter) - - CALL RndUnif( p, OtherSt, RN ) ! Generate RN from U(0,1) - - CALL RndUnif( p, OtherSt, RandNum ) ! Generate RandNum from h(y) = 1 / (MaxVALUE - MinVALUE) - RandNum = RandNum*(MaxVALUE-MinVALUE)+MinVALUE; - - Gx = Parms(1) + Parms(2)*EXP(-0.5*(LOG(RandNum/Parms(3))/Parms(4))**2); - Gx = Gx / fMAX - - IF ( RN <= Gx ) THEN - Count = MaxIter ! Let's keep this deviate - ELSE - Count = Count + 1 ! try again - RandNum = -1 - ENDIF - -ENDDO - -END SUBROUTINE Rnd4ParmLogNorm -!======================================================================= -SUBROUTINE Rnd3ParmNorm( p, OtherSt, RandNum, A, B, C, xMin, xMax, ErrStat, ErrMsg ) - -! Calculates a deviate from a distribution with pdf: -! f(x) = A * EXP( -0.5 * ((x-B)/C)**2 ) -! A 3-parameter normal distribution -! We assume the returned values are between -1 and 1, since this is for the Cross-Correlations, unless -! the optional values, xMin and xMax are used - - IMPLICIT NONE - - TYPE(RandNum_ParameterType), INTENT(IN ) :: p ! parameters for random number generation - TYPE(RandNum_OtherStateType), INTENT(INOUT) :: OtherSt ! other states for random number generation - - REAL(ReKi), INTENT(IN) :: A - REAL(ReKi), INTENT(IN) :: B - REAL(ReKi), INTENT(IN) :: C - - INTEGER(IntKi), intent( out) :: ErrStat ! Error level - CHARACTER(*), intent( out) :: ErrMsg ! Message describing error - - - -REAL(ReKi) :: fMAX ! Max(f(x)) = f(B) = A -REAL(ReKi) :: Gx ! The function g(x) = f(x)/fMAX -REAL(ReKi) :: MaxVALUE ! Maximum value of returned variate -REAL(ReKi) :: MinVALUE ! Minimum value of returned variate -REAL(ReKi), INTENT(OUT) :: RandNum ! numbers distributed with the pdf above -REAL(ReKi) :: RN ! A random number for the acceptance-rejection method -REAL(ReKi), OPTIONAL, INTENT(IN) :: xMax ! The maximum returned iterate -REAL(ReKi), OPTIONAL, INTENT(IN) :: xMin ! The minimum returned iterate - -INTEGER :: Count -INTEGER, PARAMETER :: MaxIter = 10000 ! Max number of iterations to converge (so we don't get an infinite loop) - - - ErrStat = ErrID_None - ErrMsg = "" - -! If A < 0 then we have a minimum value in the center of the distribution, not a maximum -- this method won't work. -! If A < 1/(MaxVALUE-MinVALUE), then this acceptance-rejection method won't work. - -IF ( PRESENT(xMax) ) THEN - MaxVALUE = xMax -ELSE - MaxVALUE = 1.0 -ENDIF - -IF ( PRESENT(xMin) ) THEN - MinVALUE = xMin -ELSE - MinVALUE = -MaxVALUE -ENDIF - -RN = 1. / (MaxVALUE-MinVALUE) -IF (A < RN .OR. C==0. .OR. MaxVALUE <= MinVALUE) THEN - ErrStat = ErrID_Fatal - ErrMsg = 'Rnd3ParmNorm: Parameter A must at least 1/(xMax-xMin) and parameter C cannot be zero in this 3-parameter normal distribution.' - RETURN -ENDIF - - -fMAX = A -Count = 1 - - ! Generate a 3-parameter normal distribution on (-1,1) from a uniform distribution - -DO WHILE (Count < MaxIter) - - CALL RndUnif( p, OtherSt, RN ) ! Generate RN from U(0,1) - CALL RndUnif( p, OtherSt, RandNum ) ! Generate RandNum from h(y) = 1 / (MaxVALUE - MinVALUE) - RandNum = RandNum*(MaxVALUE-MinVALUE)+MinVALUE; - - Gx = A * EXP( -0.5 * ((RandNum-B)/C)**2 ) - Gx = Gx / fMAX - - IF ( RN <= Gx ) THEN - Count = MaxIter ! Let's keep this deviate - ELSE - Count = Count + 1 ! try again - RandNum = -100 - ENDIF - -ENDDO - -END SUBROUTINE Rnd3ParmNorm -!======================================================================= -SUBROUTINE RndExp( p, OtherSt, RandExpNum, mu ) - - ! This subroutine computes an exponential distribution on (0,inf). If the - ! number of random variates to return is large, a different algorithm will - ! probably be faster (i.e. one that computes LOG(x) fewer times). - ! mu must be positive, it defaults to 1.0 if the parameter is not included. - ! RandNum has p.d.f.(x) = 1/mu * exp(-x/mu), x>=0 - ! The expected value of RandNum is mu. - - - IMPLICIT NONE - - ! Passed Variables - -TYPE(RandNum_ParameterType), INTENT(IN ) :: p ! parameters for random number generation -TYPE(RandNum_OtherStateType), INTENT(INOUT) :: OtherSt ! other states for random number generation - -REAL(ReKi), INTENT(OUT) :: RandExpNum ! The exponentially distributed numbers in (0,1) -REAL(ReKi), OPTIONAL, INTENT(IN) :: mu ! The exponential distribution parameter equal to the expected value of the distribution - - ! Local Variable - -REAL(ReKi) :: mu_use - - -IF ( PRESENT(mu) ) THEN - IF (mu < 0.0) THEN - CALL WrScr( 'RndExp: Parameter mu is negative. Using -mu for exponential distribution.') - ENDIF - mu_use = ABS( mu ) -ELSE - mu_use = 1.0 -ENDIF - - - ! Get a uniform distribution of random numbers - -CALL RndUnif( p, OtherSt, RandExpNum ) - -IF ( RandExpNum == 0.0 ) THEN ! We shouldn't get two zeros in a row... - CALL RndUnif( p, OtherSt, RandExpNum ) -ENDIF - - ! Transform the uniform distribution to an exponential distribution - -RandExpNum = - mu_use * LOG( RandExpNum ) - -END SUBROUTINE RndExp - -!======================================================================= -SUBROUTINE RndJetHeight( p, OtherSt, RandNum ) -! This function uses the Pearson IV equation - -IMPLICIT NONE - -TYPE(RandNum_ParameterType), INTENT(IN ) :: p ! parameters for random number generation -TYPE(RandNum_OtherStateType), INTENT(INOUT) :: OtherSt ! other states for random number generation - -REAL(ReKi), PARAMETER :: a = 0.021548497 -REAL(ReKi), PARAMETER :: b = -13.173289 -REAL(ReKi), PARAMETER :: c = 13.43201034 -REAL(ReKi), PARAMETER :: d = 0.896588964 -REAL(ReKi), PARAMETER :: e = -0.71128456 - -REAL(ReKi), PARAMETER :: MaxVALUE = 120 ! Maximum value of returned variate -REAL(ReKi), PARAMETER :: MinVALUE = -160 ! Minimum value of returned variate -REAL(ReKi), PARAMETER :: Parms(5) = (/ a, b, c, d, e /) -REAL(ReKi), INTENT(OUT) :: RandNum ! numbers distributed with the pdf above -REAL(ReKi), PARAMETER :: RangeFn(2) = (/ MinVALUE, MaxVALUE /) - - - CALL RndPearsonIV( p, OtherSt, RandNum, Parms, RangeFn ) - - -END SUBROUTINE RndJetHeight -!======================================================================= -SUBROUTINE RndModLogNorm( p, OtherSt, RandNum, Height ) - ! This subroutine generates a random variate with a PDF of the form - ! f(x) = A + B*exp(-0.5*(ln(x/C)/D)^2) - -!BJJ use Rnd4ParmLogNorm() -IMPLICIT NONE - -TYPE(RandNum_ParameterType), INTENT(IN ) :: p ! parameters for random number generation -TYPE(RandNum_OtherStateType), INTENT(INOUT) :: OtherSt ! other states for random number generation - -REAL(ReKi), INTENT(OUT) :: RandNum ! Near-Log-Normally distributed numbers -REAL(ReKi), OPTIONAL, INTENT(IN) :: Height ! height (in meters), determining what parameters to use - - ! Internal variables - -REAL(ReKi), PARAMETER :: A(3) = (/-0.0041046, -0.00566512, -0.00216964 /) -REAL(ReKi), PARAMETER :: B(3) = (/ 0.162945643, 0.278246235, 0.113718973 /) -REAL(ReKi), PARAMETER :: C(3) = (/ 0.67493672, 0.203262077, 3.211606394 /) -REAL(ReKi), PARAMETER :: D(3) = (/ 2.391316782, 2.715789776, 1.700298642 /) -REAL(ReKi) :: G ! The function g(x) = f(x)/B -REAL(ReKi) :: RN (2) ! Two random numbers for the acceptance-rejection method - - -INTEGER :: Count -INTEGER :: Indx -INTEGER, PARAMETER :: MaxIter = 10000 ! Max number of iterations to converge (so we don't get an infinite loop) -INTEGER, PARAMETER :: MaxTime = 600 ! Maximum value of returned value (the data used to compute A,B,C,D is valid up to 600 s.) - - !Get the index closest to the station we want to use... -Indx = 2 ! Index 2 == NC-CC-SC stations (37 m) -IF ( PRESENT(Height) ) THEN - IF (Height > 47) THEN - Indx = 1 ! Index 1 == UC station (58 m) - ELSEIF (Height < 26) THEN - Indx = 3 ! Index 3 = LC station (15 m) - ENDIF -ENDIF - -Count = 1 - - ! Generate a normal distribution on (0,1) from a uniform distribution ( ACTUALLY [0,1) ) - -DO WHILE (Count < MaxIter) - - CALL RndUnif( p, OtherSt, RN(1) ) - CALL RndUnif( p, OtherSt, RN(2) ) - - RandNum = RN(2)*MaxTime; - - g = A(Indx)/B(Indx) + EXP(-0.5*(LOG(RandNum/C(Indx))/D(Indx))**2); - - IF ( RN(1) <= g ) THEN - Count = MaxIter ! Let's keep this deviate - ELSE - Count = Count + 1 ! try again - RandNum = -1 - ENDIF - -ENDDO - - -END SUBROUTINE RndModLogNorm -!======================================================================= -SUBROUTINE RndNorm( p, OtherSt, RandNormNum, mu, sigma ) - -IMPLICIT NONE - -TYPE(RandNum_ParameterType), INTENT(IN ) :: p ! parameters for random number generation -TYPE(RandNum_OtherStateType), INTENT(INOUT) :: OtherSt ! other states for random number generation - -REAL(ReKi), INTENT(OUT) :: RandNormNum ! Normally distributed numbers -REAL(ReKi), OPTIONAL, INTENT(IN) :: mu ! mean of the distributed numbers - DEFAULT IS 0.0 -REAL(ReKi), OPTIONAL, INTENT(IN) :: sigma ! standard deviation of the distributed numbers - DEFAULT IS 1.0 - - ! Internal variable - -REAL(ReKi) :: RN (2) ! Two random numbers - - - ! Generate a normal distribution on (0,1) from a uniform distribution ( ACTUALLY [0,1) ) - - CALL RndUnif( p, OtherSt, RN(1) ) - CALL RndUnif( p, OtherSt, RN(2) ) - - RandNormNum = SQRT( PI / 8.0 ) * LOG( ( 1.0 + RN(1) ) / ( 1.0 - RN(1) ) ) - - IF ( RN(2) < 0.5 ) THEN - RandNormNum = -RandNormNum - ENDIF - - - ! Give the correct mean and standard deviation, if specified - - IF ( PRESENT( sigma ) ) THEN - RandNormNum = RandNormNum * sigma - ENDIF - - IF ( PRESENT( mu ) ) THEN - RandNormNum = RandNormNum + mu - ENDIF - -END SUBROUTINE RndNorm -!======================================================================= -SUBROUTINE RndNWTCpkCTKE( p, OtherSt, RandNum ) - ! This subroutine generates a random variate with a PDF of the form - ! f(x) = A + B * EXP( (-X + C + D - D*E*EXP(-( X + D*LOG(E) - C)/D)) / (D*E) - ! Maximum, f(C) = A + B - ! Uses the Acceptance-Rejection: f(x) = Cf*h(x)*g(x) - ! where h(x) = 1 / (150-30) (for our domain) - ! g(x) = f(x)/(A+B), and - ! Cf = (150-30)*(A+B) - -IMPLICIT NONE - -TYPE(RandNum_ParameterType), INTENT(IN ) :: p ! parameters for random number generation -TYPE(RandNum_OtherStateType), INTENT(INOUT) :: OtherSt ! other states for random number generation - -REAL(ReKi), INTENT(OUT) :: RandNum ! numbers distributed with the pdf above - - ! Internal variables - -REAL(ReKi), PARAMETER :: A = 0.000500609 -REAL(ReKi), PARAMETER :: B = 0.286202317 -REAL(ReKi), PARAMETER :: C = -38.4131676 -REAL(ReKi), PARAMETER :: D = 244.6908697 -REAL(ReKi), PARAMETER :: E = 0.02115063 - -REAL(ReKi), PARAMETER :: fMAX = A + B ! Max(f(x)) -REAL(ReKi) :: Gx ! The function g(x) = f(x)/B -REAL(ReKi), PARAMETER :: MaxVALUE = 150.0 ! Maximum value of returned variate -REAL(ReKi), PARAMETER :: MinVALUE = 30.0 ! Minimum value of returned variate -REAL(ReKi) :: RN ! A random number for the acceptance-rejection method - -INTEGER :: Count -INTEGER, PARAMETER :: MaxIter = 10000 ! Max number of iterations to converge (so we don't get an infinite loop) - -Count = 1 - - ! Generate a normal distribution on (0,1) from a uniform distribution ( ACTUALLY [0,1) ) - -DO WHILE (Count < MaxIter) - - CALL RndUnif( p, OtherSt, RN ) ! Generate RN from U(0,1) - - CALL RndUnif( p, OtherSt, RandNum ) ! Generate RandNum from h(y) = 1 / (MaxVALUE - MinVALUE) - RandNum = RandNum*(MaxVALUE-MinVALUE)+MinVALUE; - - Gx = A + B * EXP( (-RandNum + C + D - D*E*EXP(-( RandNum + D*LOG(E) - C)/D)) / (D*E) ) - Gx = Gx / fMAX - - IF ( RN <= Gx ) THEN - Count = MaxIter ! Let's keep this deviate - ELSE - Count = Count + 1 ! try again - RandNum = -1 - ENDIF - -ENDDO - -END SUBROUTINE RndNWTCpkCTKE -!======================================================================= -SUBROUTINE RndNWTCuStar( p, OtherSt, RandNum ) -!bjj 17-jul-2014: this isn't used anywhere.... - ! This subroutine generates a random variate with a PDF of the form - ! f(x) = (A + Cx + Ex^2 + Gx^3) / (1 + Bx + Dx^2 + Fx^3 + Hx^4) - ! using the acceptance/rejection method. - -IMPLICIT NONE - -TYPE(RandNum_ParameterType), INTENT(IN ) :: p ! parameters for random number generation -TYPE(RandNum_OtherStateType), INTENT(INOUT) :: OtherSt ! other states for random number generation - -REAL(ReKi), INTENT(OUT) :: RandNum ! numbers distributed with the pdf above - - ! Internal variables - -REAL(ReKi), PARAMETER :: A = 4.50581 ! Scaling parameters for the pdf -REAL(ReKi), PARAMETER :: B = -0.60722 ! Scaling parameters for the pdf -REAL(ReKi), PARAMETER :: C = -14.23826 ! Scaling parameters for the pdf -REAL(ReKi), PARAMETER :: D = -0.96523 ! Scaling parameters for the pdf -REAL(ReKi), PARAMETER :: E = 15.92342 ! Scaling parameters for the pdf -REAL(ReKi), PARAMETER :: F = 14.41326 ! Scaling parameters for the pdf -REAL(ReKi), PARAMETER :: G = -6.16188 ! Scaling parameters for the pdf -REAL(ReKi), PARAMETER :: H = -4.82923 ! Scaling parameters for the pdf - -REAL(DbKi) :: Gx ! The function g(x) = f(x)/A -REAL(ReKi), PARAMETER :: MaxUstar = 1.0 ! Maximum value of returned value (the data used to compute A,B,C,D is valid up to 600 s.) -REAL(DbKi) :: RandNum2 ! RandNum**2 -REAL(DbKi) :: RandNum3 ! RandNum**3 -REAL(DbKi) :: RandNum4 ! RandNum**4 -REAL(ReKi) :: RN ! A random number for the acceptance-rejection method - -INTEGER :: Count -INTEGER, PARAMETER :: MaxIter = 10000 ! Max number of iterations to converge (so we don't get an infinite loop) - -Count = 1 - - ! Generate a normal distribution on (0,1) from a uniform distribution ( ACTUALLY [0,1) ) - -DO WHILE (Count < MaxIter) - - CALL RndUnif( p, OtherSt, RN ) - CALL RndUnif( p, OtherSt, RandNum ) - - RandNum = RandNum*MaxUstar; - - RandNum2 = RandNum*RandNum - RandNum3 = RandNum*RandNum2 - RandNum4 = RandNum*RandNum3 - - Gx = (A + C*RandNum + E*RandNum2 + G*RandNum3) / & - (1 + B*RandNum + D*RandNum2 + F*RandNum3 + H*RandNum4) - Gx = Gx / A ! This makes 0= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - - ! Let's go ahead and get all the random numbers we will need for the entire - ! run. This (hopefully) will be faster than getting them one at a time, - ! but it will use more memory. - ! These pRNGs have been initialized in the GetInput() subroutine - - IF ( p%pRNG == pRNG_INTRINSIC ) THEN ! RNG_type == 'NORMAL' - - !The first two real numbers in the RandSeed array are used as seeds - !The number of seeds needed are compiler specific, thus we can't assume only 2 seeds anymore - - CALL RANDOM_NUMBER ( RandNum ) - - ! Let's harvest the random seeds so that they can be used for the next run if desired. - ! Write them to the summary file. - - CALL RANDOM_SEED ( GET = OtherSt%nextSeed(:) ) ! bjj: 16-jul-2014: without the (:), I get an "internal compiler error" here using Intel(R) Visual Fortran Compiler XE 12.1.3.300 [Intel(R) 64] - - NextSeedText = ' Harvested seed #' - - ELSEIF ( p%pRNG == pRNG_RANLUX ) THEN ! RNG_type == 'RANLUX' - - CALL RanLux ( RandNum ) - - CALL RLuxAT ( LuxLevelOut, InitSeed, OtherSt%nextSeed(1), OtherSt%nextSeed(2) ) !luxury level, seed, nextSeed - - !InitSeed = p%RandSeed(1)???? - NextSeedText = ' K' - - ELSE - - NumPointsFreq = NPoints*NumFreq - - Indx = 1 - DO IVec = 1,3 ! 3 wind components - CALL ARand( OtherSt%nextSeed(IVec), RandNum, NumPointsFreq, Indx) - Indx = Indx + NumPointsFreq - ENDDO - - NextSeedText = ' Next seed #' - - ENDIF - -! set them to the range 0-2pi and -! sort them so we get the same random numbers as previous versions of TurbSim - - DO IVec = 1,3 - DO IFreq = 1,NumFreq - DO J=1,NPoints - Indx = IFreq + (J-1)*NumFreq + (IVec-1)*NPoints*NumFreq ! This sorts the random numbers as they were done previously - - PhaseAngles(J,IFreq,IVec) = TwoPi*RandNum(Indx) - ENDDO ! J - ENDDO !IFreq - ENDDO !IVec - - call cleanup() - - IF ( US > 0 ) THEN - - WRITE(US,"(//,'Harvested Random Seeds after Generation of the Random Numbers:',/)") - - DO J = 1,SIZE( OtherSt%nextSeed ) - WRITE(US,"(I13,A,I2)") OtherSt%nextSeed(J), TRIM(NextSeedText), J - END DO - - END IF - -contains - subroutine cleanup() - IF (ALLOCATED(RandNum)) DEALLOCATE(RandNum) - end subroutine cleanup - -END SUBROUTINE RndPhases -!======================================================================= - - -END MODULE TS_RandNum diff --git a/OpenFAST/modules/turbsim/src/Root_Searching.f90 b/OpenFAST/modules/turbsim/src/Root_Searching.f90 deleted file mode 100644 index bd01c5ca7..000000000 --- a/OpenFAST/modules/turbsim/src/Root_Searching.f90 +++ /dev/null @@ -1,98 +0,0 @@ -MODULE NEWTON_MOD -IMPLICIT NONE -PUBLIC :: F, FP -CONTAINS -!============================================================================== -FUNCTION F(X,URef,RefHt,HubHt) RESULT (Y) -USE NWTC_Library -REAL(ReKi), INTENT(IN) :: X -!REAL(ReKi), INTENT(IN) :: V_10 -REAL(ReKi), INTENT(IN) :: URef -REAL(ReKi), INTENT(IN) :: RefHt -REAL(ReKi), INTENT(IN) :: HubHt -REAL(ReKi) :: Y -REAL(ReKi) :: C_1 -REAL(ReKi) :: C_2 -REAL(ReKi) :: D_1 -REAL(ReKi) :: D_2 -REAL(ReKi) :: D_3 -REAL(ReKi) :: D_4 - -IF ( EqualRealNos( RefHt, 10.0_ReKi ) ) THEN - C_1=1.0-0.41*0.06*LOG(600.0/3600.0) - C_2=0.41*0.06*0.043*LOG(600.0/3600.0) - Y=C_1*X-C_2*X*X-URef -ELSEIF ( EqualRealNos( RefHt, HubHt) ) THEN - D_1=1.0-0.41*0.06*LOG(600.0/3600.0)*(RefHt/10.0)**(-0.22) - D_2=0.41*0.06*0.043*LOG(600.0/3600.0)*(RefHt/10.0)**(-0.22) - D_3=D_1*0.0573*LOG(RefHt/10.0) - D_4=D_2*0.0573*LOG(RefHt/10.0) - Y=D_1*X-D_2*X*X+D_3*X*(1.0+0.15*X)**0.5-D_4*X*X*(1.0+0.15*X)**0.5-URef -ELSE - Y = -9999999 -ENDIF - -END FUNCTION F -!============================================================================== -FUNCTION FP(X,URef,RefHt,HubHt) RESULT (Y) -USE NWTC_Library -REAL(ReKi), INTENT(IN) :: X -REAL(ReKi), INTENT(IN) :: URef -REAL(ReKi), INTENT(IN) :: RefHt -REAL(ReKi), INTENT(IN) :: HubHt -REAL(ReKi) :: Y -REAL(ReKi) :: C_1 -REAL(ReKi) :: C_2 -REAL(ReKi) :: D_1 -REAL(ReKi) :: D_2 -REAL(ReKi) :: D_3 -REAL(ReKi) :: D_4 - -IF ( EqualRealNos( RefHt, 10.0_ReKi ) ) THEN - C_1 = 1.0-0.41*0.06*LOG(600.0/3600.0) - C_2 = 0.41*0.06*0.043*LOG(600.0/3600.0) - Y = C_1-2.0*C_2*X -ELSEIF ( EqualRealNos( RefHt, HubHt) ) THEN - C_1 = 1.0 - 0.41 * 0.06 * LOG(600.0/3600.0) - C_2 = 0.41 * 0.06*0.043 * LOG(600.0/3600.0) - D_1 = 1.0-0.41*0.06*LOG(600.0/3600.0)*(RefHt/10.0)**(-0.22) - D_2 = 0.41*0.06*0.043*LOG(600.0/3600.0)*(RefHt/10.0)**(-0.22) - D_3 = D_1*0.0573*LOG(RefHt/10.0) - D_4 = D_2*0.0573*LOG(RefHt/10.0) - Y = D_1-2.0*D_2*X+D_3*((1.0+0.15*X)**0.5+0.15*X/2.0/(1.0+0.15*X)**0.5) & - -D_4*(2.0*X*(1.0+0.15*X)**0.5+0.15*X*X/2.0/(1.0+0.15*X)**0.5) -ELSE - Y = -9999999 -ENDIF - -END FUNCTION FP -!============================================================================== -END MODULE NEWTON_MOD - - -SUBROUTINE ROOT_SEARCHING(X0,X,URef,RefHt,HubHt) -USE NEWTON_MOD -USE NWTC_Library -IMPLICIT NONE - -REAL(ReKi), PARAMETER :: TOL=1.0E-5 - -REAL(ReKi), INTENT(IN ) :: URef -REAL(ReKi), INTENT(IN ) :: RefHt -REAL(ReKi), INTENT(IN ) :: HubHt -REAL(ReKi), INTENT(IN ) :: X0 -REAL(ReKi), INTENT( OUT) :: X - -X=X0 -DO ! bjj: I'd like this better if there were absolutely no way to have an infinite loop here... - X = X - F(X,URef,RefHt,HubHt) / FP(X,URef,RefHt,HubHt) - IF (ABS(F(X,URef,RefHt,HubHt)) < TOL) THEN - EXIT - END IF - -END DO -END SUBROUTINE ROOT_SEARCHING - - - - \ No newline at end of file diff --git a/OpenFAST/modules/turbsim/src/TS_FileIO.f90 b/OpenFAST/modules/turbsim/src/TS_FileIO.f90 deleted file mode 100644 index d13fd8d0d..000000000 --- a/OpenFAST/modules/turbsim/src/TS_FileIO.f90 +++ /dev/null @@ -1,5475 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2014, 2016 National Renewable Energy Laboratory -! -! This file is part of TurbSim. -! -! 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. -! -!********************************************************************************************************************************** -MODULE TS_FileIO - - USE NWTC_Library - - use TS_Profiles - use TSSubs - use TS_RandNum - - IMPLICIT NONE - -CONTAINS - -!======================================================================= -!> This subroutine reads parameters from the primary TurbSim input file. -!> It validates most of the meteorology data (because it is used to -!> calculate default values later in the routine) -SUBROUTINE ReadInputFile(InFile, p, OtherSt_RandNum, ErrStat, ErrMsg) - - - ! This subroutine is used to read parameters from the input file. - - IMPLICIT NONE - - CHARACTER(*), INTENT(IN) :: InFile !< name of the primary TurbSim input file - TYPE(TurbSim_ParameterType), INTENT(INOUT) :: p !< TurbSim's parameters - TYPE(RandNum_OtherStateType), INTENT(INOUT) :: OtherSt_RandNum !< other states for random numbers (next seed, etc) - - - INTEGER(IntKi) , INTENT(OUT) :: ErrStat !< allocation status - CHARACTER(*) , INTENT(OUT) :: ErrMsg !< error message - - - - ! Local variables - - REAL(ReKi) :: InCVar (2) ! Contains the coherence parameters (used for input) - REAL(ReKi) :: tmp ! variable for estimating Ustar and calculating wind speeds - REAL(ReKi) :: TmpUary (3) !Temporary vector to store windSpeed(z) values - REAL(ReKi) :: TmpUstar(3) !Temporary vector to store ustar(z) values - REAL(ReKi) :: TmpUstarD !Temporary ustarD value - REAL(ReKi) :: RotorDiskHeights (3) !Temporary vector to store height(z) values - REAL(ReKi) :: TmpZLary(3) !Temporary vector to store zL(z) values - - INTEGER :: TmpIndex ! Contains the index number when searching for substrings - INTEGER :: UI ! I/O unit for input file - INTEGER :: UnEc ! I/O unit for echo file - - LOGICAL :: getDefaultPLExp ! Whether a default PLExp needs to be calculated - LOGICAL :: getDefaultURef ! Whether a default URef needs to be calculated - LOGICAL :: getDefaultZJetMax ! Whether a default ZJetMax needs to be calculated - - LOGICAL :: Randomize ! Whether to randomize the coherent turbulence scaling - LOGICAL :: UseDefault ! Whether or not to use a default value - LOGICAL :: IsUnusedParameter ! Whether or not this variable will be ignored - - CHARACTER(200) :: Line ! An input line - CHARACTER(1) :: Line1 ! The first character of an input line - - INTEGER(IntKi) :: ErrStat2 ! Temporary Error status - INTEGER(IntKi) :: I ! Loop counter (number of times file has been read) - - LOGICAL :: Echo ! Determines if an echo file should be written - CHARACTER(MaxMsgLen) :: ErrMsg2 ! Temporary Error message - CHARACTER(1024) :: PriPath ! Path name of the primary file - - CHARACTER(1024) :: UserFile ! Name of file containing user-defined spectra or time-series files - CHARACTER(1024) :: ProfileFile ! Name of the file containing profile data for user-defined velocity profiles and/or USRVKM model - CHARACTER(*), PARAMETER :: RoutineName = 'ReadInputFile' - - ! Initialize some variables: - ErrStat = ErrID_None - ErrMsg = "" - - p%met%NumUSRz = 0 ! initialize the number of points in a user-defined wind profile - - - UnEc = -1 - Echo = .FALSE. - CALL GetPath( InFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - - - !=============================================================================================================================== - ! Open input file - !=============================================================================================================================== - - CALL GetNewUnit( UI, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL OpenFInpFile( UI, InFile, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - CALL WrScr1(' Reading the input file "'//TRIM(InFile)//'".' ) - - ! Read the lines up/including to the "Echo" simulation control variable - ! If echo is FALSE, don't write these lines to the echo file. - ! If Echo is TRUE, rewind and write on the second try. - - I = 1 !set the number of times we've read the file - DO - !-------------------------- HEADER --------------------------------------------- - - - !=============================================================================================================================== - ! Read the runtime options. - !=============================================================================================================================== - - CALL ReadCom( UI, InFile, "File Heading Line 1", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL ReadCom( UI, InFile, "File Heading Line 2", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL ReadCom( UI, InFile, "Runtime Options Heading",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL ReadVar( UI, InFile, Echo, 'Echo', 'Echo switch', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - - 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(p%RootName)//'.ech', ErrStat2, ErrMsg2, TurbSim_Ver ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - IF ( UnEc > 0 ) WRITE (UnEc,'(/,A,/)') 'Data from '//TRIM(TurbSim_Ver%Name)//' primary input file "'//TRIM( InFile )//'":' - - REWIND( UI, IOSTAT=ErrStat2 ) - IF (ErrStat2 /= 0_IntKi ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error rewinding file "'//TRIM(InFile)//'".', ErrStat, ErrMsg, RoutineName) - RETURN - END IF - - END DO - - - - ! RandSeed(1) - CALL ReadVar( UI, InFile, p%RNG%RandSeed(1), "RandSeed(1)", "Random seed #1",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! RandSeed(2) - CALL ReadVar( UI, InFile, Line, "RandSeed(2)", "Random seed #2",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - ! Check if alternate random number generator is to be used >>>>>>>>>>>>>>>> - - READ (Line,*,IOSTAT=ErrStat2) Line1 ! check the first character to make sure we don't have T/F, which can be interpreted as 1/-1 or 0 in Fortran - - CALL Conv2UC( Line1 ) - IF ( (Line1 == 'T') .OR. (Line1 == 'F') ) THEN - CALL SetErrStat( ErrID_Fatal, ' RandSeed(2): Invalid RNG type.', ErrStat, ErrMsg, RoutineName) - CALL Cleanup() - RETURN - ENDIF - - READ (Line,*,IOSTAT=ErrStat2) p%RNG%RandSeed(2) - - IF (ErrStat2 == 0) THEN ! the user entered a number - p%RNG%RNG_type = "NORMAL" - p%RNG%pRNG = pRNG_INTRINSIC - ELSE - - p%RNG%RNG_type = ADJUSTL( Line ) - CALL Conv2UC( p%RNG%RNG_type ) - - IF ( p%RNG%RNG_type == "RANLUX") THEN - p%RNG%pRNG = pRNG_RANLUX - ELSE IF ( p%RNG%RNG_type == "RNSNLW") THEN - p%RNG%pRNG = pRNG_SNLW3 - ELSE - CALL SetErrStat( ErrID_Fatal, ' RandSeed(2): Invalid alternative random number generator.', ErrStat, ErrMsg, RoutineName) - CALL Cleanup() - RETURN - ENDIF - - ENDIF - - !<<<<<<<<<<<<<<<<<<<<<< end rng - - - ! --------- Read the flag for writing the binary HH (GenPro) turbulence parameters. ------------- - CALL ReadVar( UI, InFile, p%WrFile(FileExt_BIN), "WrBHHTP", "Output binary HH turbulence parameters? [RootName.bin]",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! --------- Read the flag for writing the formatted turbulence parameters. ---------------------- - CALL ReadVar( UI, InFile, p%WrFile(FileExt_DAT), "WrFHHTP", "Output formatted turbulence parameters? [RootName.dat]",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ---------- Read the flag for writing the AeroDyn HH files. ------------------------------------- - CALL ReadVar( UI, InFile, p%WrFile(FileExt_HH), "WrADHH", "Output AeroDyn HH files? [RootName.hh]",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ---------- Read the flag for writing the AeroDyn FF files. --------------------------------------- - CALL ReadVar( UI, InFile, p%WrFile(FileExt_BTS), "WrADFF", "Output AeroDyn FF files? [RootName.bts]",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ---------- Read the flag for writing the BLADED FF files. ----------------------------------------- - CALL ReadVar( UI, InFile, p%WrFile(FileExt_WND) , "WrBLFF", "Output BLADED FF files? [RootName.wnd]",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ---------- Read the flag for writing the AeroDyn tower files. -------------------------------------- - CALL ReadVar( UI, InFile, p%WrFile(FileExt_TWR), "WrADTWR", "Output tower data? [RootName.twr]",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ---------- Read the flag for writing the formatted FF files. --------------------------------------- - CALL ReadVar( UI, InFile, p%WrFile(FileExt_UVW), "WrFMTFF", "Output formatted FF files? [RootName.u, .v, .w]",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ---------- Read the flag for writing coherent time series files. -------------------------------------- - CALL ReadVar( UI, InFile, p%WrFile(FileExt_CTS), "WrACT", "Output coherent time series files? [RootName.cts]",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ---------- Read the flag for turbine rotation. ----------------------------------------------------------- - CALL ReadVar( UI, InFile, p%grid%Clockwise, "Clockwise", "Clockwise rotation when looking downwind?",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ---------- Read the flag for determining IEC scaling ----------------------------------------------------- - CALL ReadVar( UI, InFile, p%IEC%ScaleIEC, "ScaleIEC", "Scale IEC turbulence models to specified standard deviation?",& - ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - ! we'll check the errors before going to the next section of the input file - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - !=============================================================================================================================== - ! Read the turbine/model specifications. - !=============================================================================================================================== - - CALL ReadCom( UI, InFile, "Turbine/Model Specifications Heading Line 1",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL ReadCom( UI, InFile, "Turbine/Model Specifications Heading Line 2",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read in the vertical matrix dimension. --------------------------------------------- - CALL ReadVar( UI, InFile, p%grid%NumGrid_Z, "NumGrid_Z", "Vertical grid-point matrix dimension [-]",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read in the lateral matrix dimension. --------------------------------------------- - CALL ReadVar( UI, InFile, p%grid%NumGrid_Y, "NumGrid_Y", "Horizontal grid-point matrix dimension [-]",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read in the time step. --------------------------------------------- - CALL ReadVar( UI, InFile, p%grid%TimeStep, "TimeStep", "Time step [seconds]",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read in the analysis time. --------------------------------------------- - CALL ReadVar( UI, InFile, p%grid%AnalysisTime, "AnalysisTime", "Analysis time [seconds]",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read in the usable time. --------------------------------------------- - CALL ReadVar( UI, InFile, Line, "UsableTime", "Usable output time [seconds]",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - ! Check if usable time is "ALL" (for periodic files) >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> - READ( Line, *, IOSTAT=ErrStat2) p%grid%UsableTime - - IF ( ErrStat2 /= 0 ) THEN ! Line didn't contain a number - CALL Conv2UC( Line ) - IF ( TRIM(Line) == 'ALL' ) THEN - p%grid%Periodic = .TRUE. - p%grid%UsableTime = p%grid%AnalysisTime - ELSE - CALL SetErrStat( ErrID_Fatal, 'The usable output time must be a number greater than zero (or the string "ALL").', & - ErrStat, ErrMsg, RoutineName ) - CALL Cleanup() - RETURN - END IF - ELSE - p%grid%Periodic = .FALSE. - END IF - ! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< end check for UsableTime = "ALL" (periodic) - - ! ------------ Read in the hub height. --------------------------------------------- - CALL ReadVar( UI, InFile, p%grid%HubHt, "HubHt", "Hub height [m]",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read in the grid height. --------------------------------------------- - CALL ReadVar( UI, InFile, p%grid%GridHeight, "GridHeight", "Grid height [m]",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read in the grid width. --------------------------------------------- - CALL ReadVar( UI, InFile, p%grid%GridWidth, "GridWidth", "Grid width [m]",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read in the vertical flow angle. --------------------------------------------- - CALL ReadVar( UI, InFile, p%met%VFlowAng, "VFlowAng", "Vertical flow angle [degrees]",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read in the horizontal flow angle. --------------------------------------------- - CALL ReadVar( UI, InFile, p%met%HFlowAng, "HFlowAng", "Horizontal flow angle [degrees]",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - -!.................................................................................................................................. -! Do some error checking on the runtime options and turbine/model specifications before we read the meteorology data -!.................................................................................................................................. - - IF ( p%IEC%ScaleIEC > 2 .OR. p%IEC%ScaleIEC < 0 ) CALL SetErrStat( ErrID_Fatal, 'The value for parameter ScaleIEC must be 0, 1, or 2.', ErrStat, ErrMsg, RoutineName) - IF ( p%grid%NumGrid_Z < 2 ) CALL SetErrStat( ErrID_Fatal, 'The matrix must be >= 2x2.', ErrStat, ErrMsg, RoutineName) - IF ( p%grid%NumGrid_Y < 2 ) CALL SetErrStat( ErrID_Fatal, 'The matrix must be >= 2x2.', ErrStat, ErrMsg, RoutineName) - IF ( 0.5*p%grid%GridHeight > p%grid%HubHt ) CALL SetErrStat( ErrID_Fatal, 'The hub must be higher than half of the grid height.', ErrStat, ErrMsg, RoutineName) - IF ( p%grid%GridWidth <= 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'The grid width must be greater than zero.', ErrStat, ErrMsg, RoutineName) - IF ( p%grid%HubHt <= 0.0 ) CALL SetErrStat( ErrID_Fatal, 'The hub height must be greater than zero.', ErrStat, ErrMsg, RoutineName) - IF ( p%grid%AnalysisTime <= 0.0 ) CALL SetErrStat( ErrID_Fatal, 'The analysis time must be greater than zero.', ErrStat, ErrMsg, RoutineName) - IF ( p%grid%TimeStep <= 0.0 ) CALL SetErrStat( ErrID_Fatal, 'The time step must be greater than zero.', ErrStat, ErrMsg, RoutineName) - IF ( ABS( p%met%VFlowAng ) > 45.0 ) CALL SetErrStat( ErrID_Fatal, 'The vertical flow angle must not exceed +/- 45 degrees.', ErrStat, ErrMsg, RoutineName) - IF ( p%grid%UsableTime <= 0.0 ) CALL SetErrStat( ErrID_Fatal, 'The usable output time must be a number greater than zero'& - //' or the string "ALL".', ErrStat, ErrMsg, RoutineName) - -!.................................................................................................................................. -! initialize secondary parameters that will be used to calculate default values in the meteorological boundary conditions section -!.................................................................................................................................. - ! Initialize the RNG (for computing "default" values that contain random variates) - CALL RandNum_Init(p%RNG, OtherSt_RandNum, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ***** Calculate the diameter of the rotor disk ***** - p%grid%RotorDiameter = MIN( p%grid%GridWidth, p%grid%GridHeight ) - - ! we'll check the errors before going to the next section of the input file - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - !=============================================================================================================================== - ! Read the meteorological boundary conditions. - !=============================================================================================================================== - - CALL ReadCom( UI, InFile, "Meteorological Boundary Conditions Heading Line 1",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL ReadCom( UI, InFile, "Meteorological Boundary Conditions Heading Line 2",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read in the turbulence model. --------------------------------------------- - CALL ReadVar( UI, InFile, p%met%TurbModel, "TurbModel", "spectral model",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read in the UserFile------------------- --------------------------------------------- - CALL ReadVar( UI, InFile, UserFile, "UserFile", "Name of the input file for user-defined spectra or time-series inputs",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF ( PathIsRelative( UserFile ) ) UserFile = TRIM(PriPath)//TRIM(UserFile) - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - ! Verify turbulence model is valid (used for default values later) and read supplemental files - ! for user-defined spectra or time-series >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> - p%met%TurbModel = ADJUSTL( p%met%TurbModel ) - CALL Conv2UC( p%met%TurbModel ) - - p%met%IsIECModel = .FALSE. - p%usr%nPoints = 0 - SELECT CASE ( TRIM(p%met%TurbModel) ) - CASE ( 'IECKAI' ) - p%met%TMName = 'IEC Kaimal' - p%met%TurbModel_ID = SpecModel_IECKAI - p%met%IsIECModel = .TRUE. - CASE ( 'IECVKM' ) - p%met%TMName = 'IEC von Karman' - p%met%TurbModel_ID = SpecModel_IECVKM - p%met%IsIECModel = .TRUE. - CASE ( 'TIDAL' ) - p%met%TMName = 'Tidal Channel Turbulence' - p%met%TurbModel_ID = SpecModel_TIDAL - CASE ( 'RIVER' ) - p%met%TMName = 'River Turbulence' - p%met%TurbModel_ID = SpecModel_RIVER - CASE ( 'SMOOTH' ) - p%met%TMName = 'RISO Smooth Terrain' - p%met%TurbModel_ID = SpecModel_SMOOTH - CASE ( 'WF_UPW' ) - p%met%TMName = 'NREL Wind Farm Upwind' - p%met%TurbModel_ID = SpecModel_WF_UPW - CASE ( 'WF_07D' ) - p%met%TMName = 'NREL 7D Spacing Wind Farm' - p%met%TurbModel_ID = SpecModel_WF_07D - CASE ( 'WF_14D' ) - p%met%TMName = 'NREL 14D Spacing Wind Farm' - p%met%TurbModel_ID = SpecModel_WF_14D - CASE ( 'NONE' ) - p%met%TMName = 'Steady wind components' - p%met%TurbModel_ID = SpecModel_NONE - CASE ( 'MODVKM' ) - p%met%TMName = 'Modified von Karman' - p%met%TurbModel_ID = SpecModel_MODVKM - p%met%IsIECModel = .TRUE. - CASE ( 'API' ) - p%met%TMName = 'API' - p%met%TurbModel_ID = SpecModel_API - p%met%IsIECModel = .TRUE. - CASE ( 'NWTCUP' ) - p%met%TMName = 'NREL National Wind Technology Center' - p%met%TurbModel_ID = SpecModel_NWTCUP - CASE ( 'GP_LLJ' ) - p%met%TMName = 'Great Plains Low-Level Jet' - p%met%TurbModel_ID = SpecModel_GP_LLJ - CASE ( 'USRVKM' ) - p%met%TMName = 'von Karman model with user-defined specifications' - p%met%TurbModel_ID = SpecModel_USRVKM - CASE ( 'USRINP' ) - p%met%TMName = 'Uniform user-input' - p%met%TurbModel_ID = SpecModel_USER - - CALL GetUSRspec(UserFile, p, UnEc, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CASE ( 'TIMESR' ) - p%met%TMName = 'User-input time series' - p%met%TurbModel_ID = SpecModel_TimeSer - - CALL GetUSRTimeSeries(UserFile, p, UnEc, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat,ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - CALL TimeSeriesToSpectra( p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat,ErrMsg, RoutineName) - - CASE DEFAULT - !BONNIE: todo: add the UsrVKM model to this list when the model is complete - CALL SetErrStat( ErrID_Fatal, 'The turbulence model must be one of the following: "IECKAI", "IECVKM", "SMOOTH",' & - //' "WF_UPW", "WF_07D", "WF_14D", "NWTCUP", "GP_LLJ", "TIDAL", "RIVER", "API", "USRINP", "TIMESR" "NONE".', ErrStat, ErrMsg, RoutineName) - CALL Cleanup() - RETURN - - END SELECT ! TurbModel - - ! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< end TurbModel verification - -!bjj: todo: verify that the API model sets the parameters for IECKAI as well (because it's using IECKAI for the v and w components) - - ! ------------ Read in the IEC standard and edition numbers. --------------------------------------------- - CALL ReadVar( UI, InFile, Line, "IECstandard", "Number of the IEC standard",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - ! Process this line for IEC standard & edition & IECeditionStr >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> - CALL ProcessLine_IECstandard( Line, p%met%IsIECModel, p%met%TurbModel_ID, p%IEC%IECstandard, p%IEC%IECedition, p%IEC%IECeditionStr, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - ! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< end processing of IECstandard input variable - - ! ------------ Read in the IEC turbulence characteristic. --------------------------------------------- - CALL ReadVar( UI, InFile, Line, "IECturbc", "IEC turbulence characteristic",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! Process this line for NumTurbInp, IECPerTurbInt, IECTurbC, and KHtest >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> - CALL ProcessLine_IECTurbc(Line, p%met%IsIECModel, p%IEC%IECstandard, p%IEC%IECedition, p%IEC%IECeditionStr, & - p%IEC%NumTurbInp, p%IEC%IECTurbC, p%IEC%PerTurbInt, p%met%KHtest, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - ! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< end processing of IECturbc input variable - - ! ------------ Read in the IEC wind turbulence type --------------------------------------------- - CALL ReadVar( UI, InFile, Line, "IEC_WindType", "IEC turbulence type",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - ! Process this line for IECTurbE, Vref, IEC_WindType, and IEC_WindDes >>>>>>>>>>>>>>>>>>>>>>>>>>>>> - CALL ProcessLine_IEC_WindType(Line, p, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - ! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< end processing of IEC_WindType input variable - - -!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> - ! set default ETMc, WindProfileType, Z0, CohExp, and Latitude - ! for use in ReadRVarDefault, ReadRAryDefault, and ReadCVarDefault routines -CALL DefaultMetBndryCndtns(p) ! Requires turbModel (some require RICH_NO, which we'll have to redo later) -!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - - - ! ------------ Read in the ETM c parameter (IEC 61400-1, Ed 3: Section 6.3.2.3, Eq. 19) ---------------------- - CALL ReadRVarDefault( UI, InFile, p%IEC%ETMc, "ETMc", 'IEC Extreme Turbulence Model (ETM) "c" parameter [m/s]', UnEc, & - UseDefault, ErrStat2, ErrMsg2, IGNORE=(p%IEC%IEC_WindType /= IEC_ETM )) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read in the wind profile type ----------------------------------------------------------------- - CALL ReadCVarDefault( UI, InFile, p%met%WindProfileType, "WindProfileType", "Wind profile type", UnEc, UseDefault, ErrStat2, ErrMsg2) !converts WindProfileType to upper case - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read in the ProfileFile------------------- --------------------------------------------- - CALL ReadVar( UI, InFile, ProfileFile, "ProfileFile", 'Name of the input file for profiles used with WindProfileType="USR" or TurbModel="USRVKM"',ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF ( PathIsRelative( ProfileFile ) ) ProfileFile = TRIM(PriPath)//TRIM(ProfileFile) - - ! ------------ Read in the height for the reference wind speed. --------------------------------------------- - CALL ReadVar( UI, InFile, p%met%RefHt, "RefHt", "Reference height [m]",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read in the reference wind speed. ----------------------------------------------------- - IsUnusedParameter = p%IEC%IEC_WindType > IEC_ETM .OR. INDEX('TU',p%met%WindProfileType(1:1)) > 0 ! p%IEC%IEC_WindType > IEC_ETM == EWM models - CALL ReadRVarDefault( UI, InFile, p%met%URef, "URef", "Reference wind speed [m/s]", UnEc, getDefaultURef, ErrStat2, ErrMsg2, & - IGNORE=IsUnusedParameter ) ! p%IEC%IEC_WindType > IEC_ETM == EWM models - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - getDefaultURef = getDefaultURef .AND. .NOT. IsUnusedParameter - - - ! ------------ Read in the jet height ------------------------------------------------------------- - IsUnUsedParameter = TRIM(p%met%WindProfileType) /= 'JET' - CALL ReadRVarDefault( UI, InFile, p%met%ZJetMax, "ZJetMax", "Jet height [m]", UnEc, getDefaultZJetMax, ErrStat2, ErrMsg2, IGNORE=IsUnusedParameter) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - getDefaultZJetMax = getDefaultZJetMax .AND. .NOT. IsUnusedParameter ! Jet height for - - ! ------------ Read in the power law exponent, PLExp --------------------------------------------- - IsUnusedParameter = (TRIM(p%met%WindProfileType) /= "PL" .AND. TRIM(p%met%WindProfileType) /= "IEC") - CALL ReadRVarDefault( UI, InFile, p%met%PLExp, "PLExp", "Power law exponent [-]", UnEc, getDefaultPLExp, ErrStat2, ErrMsg2, IGNORE=IsUnusedParameter) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - getDefaultPLExp = getDefaultPLExp .AND. .NOT. IsUnusedParameter ! we need RICH_NO before we can calculate a default for this value RICH_NO - - ! ------------ Read in the surface roughness length, Z0 (that's z-zero) --------------------------------------------- - IsUnusedParameter = p%met%TurbModel_ID==SpecModel_TIDAL - CALL ReadRVarDefault( UI, InFile, p%met%Z0, "Z0", "Surface roughness length [m]", UnEc, UseDefault, ErrStat2, ErrMsg2, & - IGNORE=IsUnusedParameter) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - -!.................................................................................................................................. -! Do some error checking on the meteorology before we read the non-IEC meteorology data -!.................................................................................................................................. - IF ( p%IEC%IEC_WindType == IEC_ETM .AND. p%IEC%ETMc <= 0. ) CALL SetErrStat( ErrID_Fatal, 'The ETM "c" parameter must be a positive number', ErrStat, ErrMsg, RoutineName) - - ! Make sure WindProfileType is valid for this turbulence model - SELECT CASE ( TRIM(p%met%WindProfileType) ) - CASE ( 'JET' ) - IF ( p%met%TurbModel_ID /= SpecModel_GP_LLJ ) CALL SetErrStat( ErrID_Fatal, 'The jet wind profile is available with the GP_LLJ spectral model only.', ErrStat, ErrMsg, RoutineName) - CASE ( 'LOG') - IF (p%IEC%IEC_WindType /= IEC_NTM ) CALL SetErrStat( ErrID_Fatal, 'The IEC turbulence type must be NTM for the logarithmic wind profile.', ErrStat, ErrMsg, RoutineName) - CASE ( 'PL' ) !this is a valid WindProfileType - CASE ( 'H2L' ) - IF ( p%met%TurbModel_ID /= SpecModel_TIDAL ) CALL SetErrStat( ErrID_Fatal, 'The "H2L" mean profile type can be used with only the "TIDAL" spectral model.', ErrStat, ErrMsg, RoutineName) - CASE ( 'IEC' ) - CASE ( 'USR' ) - !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> - ! Get parameters for USR wind profile (so that we can use these parameters to get the wind speed later): - CALL GetUSRProfiles( ProfileFile, p%met, UnEc, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - - CASE ( 'TS' ) - IF ( p%met%TurbModel_ID /= SpecModel_TimeSer ) CALL SetErrStat( ErrID_Fatal, 'The "TS" mean profile type is valid only with the "TIMESR" spectral model.', ErrStat, ErrMsg, RoutineName) - CASE ( 'API' ) ! ADDED BY Y.GUO -!bjj: I think we need to add some checks here??? MLB has comments about difference between RefHt and HubHt and 10 m - CASE DEFAULT - CALL SetErrStat( ErrID_Fatal, 'The wind profile type must be "JET", "LOG", "PL", "IEC", "USR", "H2L", "TS", or default.' , ErrStat, ErrMsg, RoutineName) - END SELECT - - IF ( p%met%TurbModel_ID == SpecModel_TIDAL .AND. TRIM(p%met%WindProfileType) /= "H2L" ) THEN - p%met%WindProfileType = 'H2L' - CALL SetErrStat( ErrID_Warn, 'Overwriting wind profile type to "H2L" for the "TIDAL" spectral model.', ErrStat, ErrMsg, RoutineName) - ENDIF - - - IF (p%met%KHtest) THEN - IF ( p%met%TurbModel_ID /= SpecModel_NWTCUP ) CALL SetErrStat( ErrID_Fatal, 'The KH test can be used with the "NWTCUP" spectral model only.', ErrStat, ErrMsg, RoutineName) - - IF ( TRIM(p%met%WindProfileType) /= 'IEC' .AND. TRIM(p%met%WindProfileType) /= 'PL' ) THEN - CALL SetErrStat( ErrID_Warn, 'Overwriting wind profile type for the KH test.', ErrStat, ErrMsg, RoutineName) - p%met%WindProfileType = 'IEC' - ENDIF - - IF ( .NOT. p%WrFile(FileExt_CTS) ) THEN - CALL SetErrStat( ErrID_Warn, 'Coherent turbulence time step files must be generated when using the "KHTEST" option.', ErrStat, ErrMsg, RoutineName) - p%WrFile(FileExt_CTS) = .TRUE. - ENDIF - - IF ( .NOT. EqualRealNos(p%met%PLExp, 0.3_ReKi) ) THEN - CALL SetErrStat( ErrID_Warn, 'Overwriting the power law exponent for KH test.', ErrStat, ErrMsg, RoutineName) - p%met%PLExp = 0.3 - ENDIF - END IF - - - IF ( getDefaultURef ) THEN - IF ( p%usr%NPoints > 0 ) THEN - p%met%RefHt = p%usr%pointzi(p%usr%RefPtID) - p%met%URef = p%usr%meanU(p%usr%RefPtID,1) - getDefaultURef = .FALSE. - ELSEIF( TRIM(p%met%WindProfileType) /= 'JET' ) THEN - ! Also note that if we specify a "default for Ustar , we cannot enter "default" for URef. Otherwise, we get circular logic. Will check for that later. - CALL SetErrStat( ErrID_Fatal, 'URef can be "default" for only the "JET" WindProfileType.', ErrStat, ErrMsg, RoutineName) - END IF - END IF - - IF ( p%met%Z0 <= 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'The surface roughness length must be a positive number or "default".', ErrStat, ErrMsg, RoutineName) - - IF ( TRIM(p%met%WindProfileType) == 'JET' .AND. .NOT. getDefaultZJetMax ) THEN - IF ( p%met%ZJetMax < ZJetMax_LB .OR. p%met%ZJetMax > ZJetMax_UB ) THEN - CALL SetErrStat( ErrID_Fatal, 'The height of the maximum jet wind speed must be between '//TRIM(num2lstr(ZJetMax_LB))//& - ' and '//TRIM(num2lstr(ZJetMax_UB))//' m.', ErrStat, ErrMsg, RoutineName) - ENDIF - ENDIF - - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - !................................................. - ! overwrite RefHt and URef for cases where they are unused [USR wind profiles (or TS)] - !................................................. - - ! NOTE: return on abortErrLev before calling getVelocity - IF ( TRIM(p%met%WindProfileType) == 'USR' .OR. TRIM(p%met%WindProfileType) == 'TS') THEN ! for user-defined wind profiles, we overwrite RefHt and URef because they don't mean anything otherwise - ! Calculate URef, which is UHub: - ! note that the 2 "ref" values in the subroutine arguments aren't used for the USR wind profile type. - ! (also, we do not necessarially know PLExp, yet, so we can't call this routine when we have "PL" or "IEC" wind profile types.) - CALL getVelocity(p, p%met%URef, p%met%RefHt, p%met%RefHt, tmp, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - !p%met%RefHt = p%grid%HubHt bjj changed this on 23-sep-2014 - p%met%URef = tmp - ELSEIF( p%IEC%IEC_WindType > IEC_ETM ) THEN !i.e., any of the EWM models: IEC_EWM1, IEC_EWM50, IEC_EWM100 - p%met%RefHt = p%grid%HubHt - p%met%URef = p%IEC%VRef - ENDIF - - ! check that RefHt and URef are appropriate values: - IF ( p%met%RefHt <= 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'The reference height must be greater than zero.', ErrStat, ErrMsg, RoutineName) - IF ( .NOT. getDefaultURef ) THEN - IF ( p%met%URef <= 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'The reference wind speed must be greater than zero.', ErrStat, ErrMsg, RoutineName) - ENDIF ! Otherwise, we're using a Jet profile with default wind speed (for now it's -999.9) - - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - !=============================================================================================================================== - ! Read the meteorological boundary conditions for non-IEC models. - !=============================================================================================================================== - - CALL ReadCom( UI, InFile, "Non-IEC Meteorological Boundary Conditions Heading Line 1", ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL ReadCom( UI, InFile, "Non-IEC Meteorological Boundary Conditions Heading Line 2", ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read in the site latitude, LATITUDE --------------------------------------------- - IsUnusedParameter = p%met%IsIECModel .AND. p%met%TurbModel_ID /= SpecModel_MODVKM ! Used to caluculte z0 in ModVKM model; also used for default ZI - CALL ReadRVarDefault( UI, InFile, p%met%Latitude, "Latitude", "Site latitude [degrees]", UnEc, UseDefault, ErrStat2, ErrMsg2, & - IGNORE=IsUnusedParameter) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read in the gradient Richardson number, RICH_NO --------------------------------------------- - CALL ReadVar( UI, InFile, p%met%Rich_No, "RICH_NO", "Gradient Richardson number",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - -!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> - - ! Convert RICH_NO input to value that will be used in the code: - - IF ( p%met%KHtest ) THEN - IF ( .NOT. EqualRealNos(p%met%Rich_No, 0.02_ReKi) ) THEN - p%met%Rich_No = 0.02 - CALL SetErrStat( ErrID_Warn, 'Overwriting the Richardson Number for KH test.', ErrStat, ErrMsg, RoutineName) - ENDIF - ELSEIF ( p%met%TurbModel_ID == SpecModel_USRVKM ) THEN - IF ( .NOT. EqualRealNos(p%met%Rich_No, 0.0_ReKi) ) THEN - CALL SetErrStat( ErrID_Warn, 'Overwriting the Richardson Number for the '//TRIM(p%met%TurbModel)//' model.', ErrStat, ErrMsg, RoutineName) - p%met%Rich_No = 0.0 - ENDIF - ELSEIF ( p%met%TurbModel_ID == SpecModel_NWTCUP .OR. p%met%TurbModel_ID == SpecModel_GP_LLJ ) THEN - p%met%Rich_No = MIN( MAX( p%met%Rich_No, -1.0_ReKi ), 1.0_ReKi ) ! Ensure that: -1 <= RICH_NO <= 1 - ELSEIF (p%met%IsIECModel) THEN - p%met%Rich_No = 0.0 ! Richardson Number in neutral conditions - ENDIF - - ! now that we have Rich_No, we can calculate ZL and L - ! necessary for DefaultUStar(p) - CALL Calc_MO_zL(p%met%TurbModel_ID, p%met%Rich_No, p%grid%HubHt, p%met%ZL, p%met%L ) -!<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - - ! ------------ Read in the shear/friction velocity, Ustar ------------------------ - CALL ReadRVarDefault( UI, InFile, p%met%Ustar, "UStar", "Friction or shear velocity [m/s]", UnEc, UseDefault, ErrStat2, ErrMsg2, IGNORE=p%met%IsIECModel ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - !IF ( p%met%IsIECModel ) THEN - ! p%met%Ustar = 0.0 ! Shear or friction velocity - !ELSE - IF ( UseDefault ) THEN - IF ( getDefaultURef ) THEN ! This occurs if "default" was entered for both GP_LLJ wind speed and UStar - CALL SetErrStat( ErrID_Fatal, 'The reference wind speed and friction velocity cannot both be "default."', ErrStat, ErrMsg, RoutineName) - ELSE - CALL DefaultUStar(p) - END IF - END IF - !END IF - - -!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> - ! Calculate Coriolis parameter from latitude ( Used for default ZI ) - p%met%Fc = 2.0 * Omega * SIN( ABS(p%met%Latitude*D2R) ) - - - ! We need the hub-height wind speed to calculate default Reynold's Stresses. - ! We have a few steps to take before we can get that wind speed: - - ! ***** Calculate power law exponent, if needed ***** - IF ( getDefaultPLExp ) p%met%PLExp = DefaultPowerLawExp( p ) - - ! ***** Calculate parameters for Jet profile, if needed ***** - IF ( TRIM(p%met%WindProfileType) == 'JET' ) THEN - IF ( getDefaultZJetMax ) CALL DefaultZJetMax(p, OtherSt_RandNum) ! requires Rich_No, ZL, Ustar - CALL getJetCoeffs( p, getDefaultURef, OtherSt_RandNum, ErrStat2, ErrMsg2) ! getDefault - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END IF - - ! now that we know URef (in case getDefaultURef was true), set UstarDiab (used in ustar profile and default ZI): - p%met%UstarDiab = getUstarDiab(p%met%URef, p%met%RefHt, p%met%z0, p%met%ZL) - - IF (ErrStat >= AbortErrLev) THEN ! just in case we had a fatal error, let's check before calling getVelocity - CALL Cleanup() - RETURN - END IF - - CALL getVelocity(p, p%met%URef, p%met%RefHt, p%grid%HubHt, tmp, ErrStat2, ErrMsg2) - p%UHub = tmp - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - ! We need the (local) Ustar at the hub-height; while we're at it, we'll - ! calculate the UstarOffset and UstarSlope it uses: - - - ! Set up the heights for the zl- and ustar-profile averages across the rotor disk - RotorDiskHeights = (/ p%grid%HubHt-0.5*p%grid%RotorDiameter, p%grid%HubHt, p%grid%HubHt+0.5*p%grid%RotorDiameter /) - DO TmpIndex = 1,SIZE(RotorDiskHeights) ! set height limits so we don't extrapolate too far - RotorDiskHeights(TmpIndex) = MAX( MIN(RotorDiskHeights(TmpIndex), profileZmax), profileZmin) - ENDDO - - IF (p%met%TurbModel_ID == SpecModel_GP_LLJ ) THEN - p%met%UstarSlope = 1.0_ReKi - - CALL getVelocityProfile(p, p%met%URef, p%met%RefHt, RotorDiskHeights, TmpUary, ErrStat2, ErrMsg2) ! Set TmpUary - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - TmpUstar = getUStarProfile( P, TmpUary, RotorDiskHeights, 0.0_ReKi, p%met%UstarSlope ) ! set offset to 0 here <- - - p%met%UstarOffset = p%met%Ustar - SUM(TmpUstar) / SIZE(TmpUstar) ! Ustar minus the average of those 3 points - TmpUstar(:) = TmpUstar(:) + p%met%UstarOffset - ELSE - p%met%UstarSlope = 1.0_ReKi - - TmpUary = (/ 0.0_ReKi, 0.0_ReKi, 0.0_ReKi /) - TmpUstar = (/ 0.0_ReKi, 0.0_ReKi, 0.0_ReKi /) - - p%met%UstarOffset= 0.0_ReKi - ENDIF - - - ! Get the default mean spatial coherence models - CALL GetDefaultSCMod( p%met%TurbModel_ID, p%met%SCMod ) - - ! Get the default mean Reynolds stresses - ! (requires uHub, Ustar, Rich_No, ZL, TmpUStar) - CALL GetDefaultRS( p, OtherSt_RandNum, TmpUStar(2), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! Default coherence parameters and IEC scaling parameters - CALL CalcIECScalingParams(p%IEC, p%grid%HubHt, p%UHub, p%met%InCDec, p%met%InCohB, p%met%TurbModel_ID, p%met%IsIECModel, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - IF ( .NOT. p%met%IsIECModel ) THEN - CALL GetDefaultCoh( p%met%TurbModel_ID, p%met%RICH_NO, p%UHub, p%grid%HubHt, p%met%IncDec, p%met%InCohB ) - END IF - -!<<<<<<<<<<<<<<<<<<<<<<<<<<<< - - ! ------------- Read in the mixing layer depth, ZI --------------------------------------------- - IsUnusedParameter = p%met%ZL >= 0.0_ReKi .AND. p%met%TurbModel_ID /= SpecModel_GP_LLJ ! used for unstable flows; GP_LLJ model may have both stable and unstable flows in its ZL_Profile - CALL ReadRVarDefault( UI, InFile, p%met%ZI, "ZI", "Mixing layer depth [m]", UnEc, UseDefault, ErrStat2, ErrMsg2, IGNORE=IsUnusedParameter ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - IF ( IsUnusedParameter ) THEN - p%met%ZI = 999.9_ReKi ! set to a value > 0 that we don't care about - ELSE - IF ( UseDefault ) CALL DefaultMixingLayerDepth(p) - ENDIF - - - ! ----------- Read in the mean hub u'w' Reynolds stress, PC_UW --------------------------------------------- - CALL ReadRVarDefault( UI, InFile, p%met%PC_UW, "PC_UW", "Mean hub u'w' Reynolds stress", UnEc, UseDefault, & - ErrStat2, ErrMsg2, IGNORE=p%met%IsIECModel, IGNORESTR = p%met%UWskip ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read in the mean hub u'v' Reynolds stress, PC_UV --------------------------------------------- - CALL ReadRVarDefault( UI, InFile, p%met%PC_UV, "PC_UV", "Mean hub u'v' Reynolds stress", UnEc, UseDefault, & - ErrStat2, ErrMsg2, IGNORE=p%met%IsIECModel, IGNORESTR = p%met%UVskip ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read in the mean hub v'w' Reynolds stress, PC_VW --------------------------------------------- - CALL ReadRVarDefault( UI, InFile, p%met%PC_VW, "PC_VW", "Mean hub v'w' Reynolds stress", UnEc, UseDefault, & - ErrStat2, ErrMsg2, IGNORE=p%met%IsIECModel, IGNORESTR = p%met%VWskip ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - !=============================================================================================================================== - ! Read the spatial coherence model section. - !=============================================================================================================================== - - CALL ReadCom( UI, InFile, "Spatial Coherence Models Heading Line 1", ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL ReadCom( UI, InFile, "Spatial Coherence Models Heading Line 2", ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read in the spatial coherence models, SCMod(1), SCMod(2), SCMod(3). --------------------------------------------- - - DO I=1,3 - CALL ReadCVarDefault ( UI, InFile, Line, "SCMod"//TRIM(Num2LStr(I)), Comp(I)//"-component coherence model", UnEc, UseDefault, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF ( .NOT. UseDefault ) THEN - SELECT CASE ( TRIM(Line) ) - CASE("GENERAL") - p%met%SCMod(I) = CohMod_GENERAL - CASE ("IEC") - p%met%SCMod(I) = CohMod_IEC - CASE ("NONE") - p%met%SCMod(I) = CohMod_NONE - CASE ("API") - p%met%SCMOD(I) = CohMod_API - IF (I /= 1) CALL SetErrStat( ErrID_Fatal, "API coherence model is valid only for the u-component", ErrStat, ErrMsg, RoutineName) - CASE DEFAULT - p%met%SCMod(I) = CohMod_NONE - IF (I==1) THEN - CALL SetErrStat( ErrID_Fatal, 'Unknown value for SCMod'//TRIM(Num2LStr(I))//'. Valid entries are "GENERAL","IEC","API", or "NONE".', ErrStat, ErrMsg, RoutineName) - ELSE - CALL SetErrStat( ErrID_Fatal, 'Unknown value for SCMod'//TRIM(Num2LStr(I))//'. Valid entries are "GENERAL","IEC", or "NONE".', ErrStat, ErrMsg, RoutineName) - END IF - END SELECT - END IF - END DO - - ! ------------ Read in the u component coherence parameters, InCDec(1) and InCohB(1) ------------ - CALL ReadRAryDefault( UI, InFile, InCVar, "InCDec1", "u-component coherence parameters", UnEc, UseDefault, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF ( .NOT. UseDefault ) THEN - p%met%InCDec(1) = InCVar(1) - p%met%InCohB(1) = InCVar(2) - END IF - - ! ------------ Read in the v component coherence parameters, InCDec(2) and InCohB(2) ---------- - CALL ReadRAryDefault( UI, InFile, InCVar, "InCDec2", "v-component coherence parameters", UnEc, UseDefault, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF ( .NOT. UseDefault ) THEN ! these are the values we just read in - p%met%InCDec(2) = InCVar(1) - p%met%InCohB(2) = InCVar(2) - END IF - - ! ------------ Read in the w component coherence parameters, InCDec(3) and InCohB(3) ------- - CALL ReadRAryDefault( UI, InFile, InCVar, "InCDec3", "w-component coherence parameters", UnEc, UseDefault, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF ( .NOT. UseDefault ) THEN - p%met%InCDec(3) = InCVar(1) - p%met%InCohB(3) = InCVar(2) - END IF - - ! ------------ Read in the coherence exponent, COHEXP ----------------------------------- - CALL ReadRVarDefault( UI, InFile, p%met%CohExp, "CohExp", "Coherence exponent", UnEc, UseDefault, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - -!.................................................................................................................................. -! Do some error checking on the non-IEC meteorology data and coherence -!.................................................................................................................................. - - IF ( .NOT. p%met%IsIECModel ) THEN - IF ( ABS(p%met%Latitude) < 5.0 .OR. ABS(p%met%Latitude) > 90.0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'The latitude must be between -90 and 90 degrees but not between -5 and 5 degrees.', ErrStat, ErrMsg, RoutineName) - ENDIF - - IF (p%met%Ustar <= 0.0_ReKi) CALL SetErrStat( ErrID_Fatal, 'The friction velocity must be a positive number.', ErrStat, ErrMsg, RoutineName) - IF ( p%met%ZI <= 0.0_ReKi) CALL SetErrStat( ErrID_Fatal, 'The mixing layer depth must be a positive number for unstable flows.', ErrStat, ErrMsg, RoutineName) - END IF - - IF ( p%met%COHEXP < 0.0_ReKi) CALL SetErrStat( ErrID_Fatal, 'The coherence exponent must be non-negative.', ErrStat, ErrMsg, RoutineName) - - DO I = 1,3 - IF ( p%met%InCDec(I) <= 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'The '//Comp(I)//'-component coherence decrement must be a positive number.', ErrStat, ErrMsg, RoutineName) - END DO - -!.................................................................................................................................. -! Calculate zlOffset -! Adjust UstarSlope and UstarOffset based on entered PC_UW -!.................................................................................................................................. - TmpZLary = getZLProfile(TmpUary, RotorDiskHeights, p%met%Rich_No, p%met%ZL, p%met%L, 0.0_ReKi, p%met%WindProfileType) - p%met%zlOffset = p%met%ZL - SUM(TmpZLary) / SIZE(TmpZLary) - - ! Modify previously calculated UstarSlope and UstarOffset based on our input (target) Reynolds' stress values - IF (.NOT. p%met%UWskip) THEN - TmpUstarD = ( TmpUstar(1)- 2.0*TmpUstar(2) + TmpUstar(3) ) - - IF ( .NOT. EqualRealNos( TmpUstarD, 0.0_ReKi ) ) THEN - p%met%UstarSlope = 3.0*(p%met%Ustar - SQRT( ABS(p%met%PC_UW) ) ) / TmpUstarD - p%met%UstarOffset = SQRT( ABS(p%met%PC_UW) ) - p%met%UstarSlope*(TmpUstar(2) - p%met%UstarOffset) - ELSE - p%met%UstarSlope = 0.0 - p%met%UstarOffset = SQRT( ABS(p%met%PC_UW) ) - ENDIF - ENDIF - - - - !=============================================================================================================================== - ! Read the Coherent Turbulence Scaling Parameters, if necessary. - !=============================================================================================================================== -IF ( .NOT. p%met%IsIECModel ) THEN - - IF ( p%WrFile(FileExt_CTS) ) THEN - - CALL ReadCom( UI, InFile, "Coherent Turbulence Scaling Parameters Heading Line 1", ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL ReadCom( UI, InFile, "Coherent Turbulence Scaling Parameters Heading Line 2", ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - ! ------------ Read the name of the path containg event file definitions, CTEventPath -------------------------- - - CALL ReadVar( UI, InFile, p%CohStr%CTEventPath, "CTEventPath", "Coherence events path",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL ReadVar( UI, InFile, Line, "CTEventFile", "Event file type",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - IF ( p%met%KHtest ) THEN - - p%CohStr%CText = 'les' - p%CohStr%CTEventFile = TRIM(p%CohStr%CTEventPath)//PathSep//'Events.xtm' - - CALL WrScr( ' LES events will be used for the KH test.' ) - - ELSE - - p%CohStr%CText = Line !This will preserve the case formatting, in case it matters. - - CALL Conv2UC( Line ) - - IF (Line(1:6) == "RANDOM") THEN - CALL RndUnif( p%RNG, OtherSt_RandNum, tmp ) - - IF ( tmp <= 0.5 ) THEN - p%CohStr%CText = 'les' - ELSE - p%CohStr%CText = 'dns' - ENDIF - ENDIF - - p%CohStr%CTEventFile = TRIM(p%CohStr%CTEventPath)//PathSep//'Events.'//TRIM(p%CohStr%CText) - - ENDIF - - - ! ------------ Read the Randomization Flag, Randomize ----------------------------------- - CALL ReadVar( UI, InFile, Randomize, "Randomize", "Randomize CT Scaling",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read the Disturbance Scale, DistScl --------------------------------------------- - CALL ReadVar( UI, InFile, p%CohStr%DistScl, "DistScl", "Disturbance scale",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read the Lateral Fractional Location of tower centerline in wave, CTLy ---------- - CALL ReadVar( UI, InFile, p%CohStr%CTLy, "CTLy", "Location of tower centerline",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! ------------ Read the Vertical Fraction Location of hub in wave, CTLz ------------------------ - CALL ReadVar( UI, InFile, p%CohStr%CTLz, "CTLz", "Location of hub height",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - IF ( p%met%KHtest ) THEN - p%CohStr%DistScl = 1.0 - p%CohStr%CTLy = 0.5 - p%CohStr%CTLz = 0.5 - Randomize = .FALSE. - CALL SetErrStat( ErrID_Info, 'Billow will cover rotor disk for KH test.', ErrStat, ErrMsg, RoutineName) - - ELSEIF ( Randomize ) THEN - - CALL RndUnif( p%RNG, OtherSt_RandNum, tmp ) - - ! Assume a 75% chance of coherent turbulence being the size of the rotor - ! If the rotor is too small, assume a 100% chance. - ! If the turbulence is not the size of the rotor, assume it's half the size - ! of the disk, with equal probablilty of being in the lower or upper half. - - IF ( tmp > 0.25 .OR. p%grid%RotorDiameter <= 30.0 ) THEN - - p%CohStr%DistScl = 1.0 - p%CohStr%CTLy = 0.5 - p%CohStr%CTLz = 0.5 - - ELSE - - p%CohStr%DistScl = 0.5 - p%CohStr%CTLy = 0.5 - - IF ( tmp < 0.125 ) THEN - p%CohStr%CTLz = 0.0 ! The hub is on the bottom of the dataset (i.e. the billow is on the top of the disk) - ELSE - p%CohStr%CTLz = 1.0 ! The hub is on the top of the dataset - ENDIF - - ENDIF - - ELSE !Don't randomize: - - IF ( p%CohStr%DistScl < 0.0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'The disturbance scale must be a positive.', ErrStat, ErrMsg, RoutineName) - ELSEIF ( p%grid%RotorDiameter <= 30.0 .AND. p%CohStr%DistScl < 1.0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'The disturbance scale must be at least 1.0 for rotor diameters less than 30.', ErrStat, ErrMsg, RoutineName) - ELSEIF ( p%grid%RotorDiameter*p%CohStr%DistScl <= 15.0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'The coherent turbulence must be greater than 15 meters in height. '//& - 'Increase the rotor diameter or the disturbance scale. ', ErrStat, ErrMsg, RoutineName) - ENDIF - - ENDIF - - - ! ---------- Read the Minimum event start time, CTStartTime -------------------------------------------- - CALL ReadVar( UI, InFile, p%CohStr%CTStartTime, "CTStartTime", "CTS Start Time",ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - p%CohStr%CTStartTime = MAX( p%CohStr%CTStartTime, 0.0_ReKi ) ! A Negative start time doesn't really make sense... - - ENDIF ! WrFile(FileExt_CTS) - - -ELSE ! IECVKM, IECKAI, MODVKM, OR API models - - IF ( p%IEC%NumTurbInp .AND. EqualRealNos( p%IEC%PerTurbInt, 0.0_ReKi ) ) THEN ! This will produce constant winds, instead of an error when the transfer matrix is singular - p%met%TurbModel = 'NONE' - p%met%TurbModel_ID = SpecModel_NONE - ENDIF - -ENDIF - - - - - ! Done reading the input file. - -CALL Cleanup() - -RETURN -CONTAINS -!......................................... -SUBROUTINE Cleanup() - - IF ( UI > 0 ) CLOSE( UI) - IF ( UnEc > 0 ) CLOSE( UnEc ) - - END SUBROUTINE Cleanup -!......................................... -END SUBROUTINE ReadInputFile -!======================================================================= -SUBROUTINE OpenSummaryFile(RootName, US, DescStr, ErrStat, ErrMsg) - - ! This subroutine is used to open the summary output file. - -IMPLICIT NONE - - INTEGER(IntKi), INTENT(INOUT) :: US ! Unit specifier for summary file - CHARACTER(*), INTENT(IN ) :: RootName ! rootname of the primary TurbSim input file - CHARACTER(*), INTENT( OUT) :: DescStr ! string describing time TurbSim files were generated - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error level - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Message describing error - - - - - ! Open summary file. -CALL GetNewUnit( US, ErrStat, ErrMsg ) -CALL OpenFOutFile( US, TRIM( RootName )//'.sum', ErrStat, ErrMsg ) ! Formatted output file -if (ErrStat >= AbortErrLev) then - US = -1 - RETURN -end if - - - - - ! Let's make a string so that the binary file and the full-field file have the same date and time: -DescStr = 'generated by '//TRIM( GetNVD(TurbSim_Ver) )//' on '//CurDate()//' at '//CurTime()//'.' - - ! Write the program name and version, date and time into the summary file. -WRITE (US,"( / 'This summary file was ', A / )") TRIM(DescStr) - - ! Capitalize the first letter of the string and save it for the full-field files. -DescStr = 'This full-field file was '//TRIM(DescStr) - - -RETURN -END SUBROUTINE OpenSummaryFile -!======================================================================= -SUBROUTINE GetUSRProfiles(FileName, p_met, UnEc, ErrStat, ErrMsg) - - IMPLICIT NONE - - TYPE(Meteorology_ParameterType), INTENT(INOUT) :: p_met - INTEGER(IntKi), INTENT(IN ) :: UnEc ! echo file unit number - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error level - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Message describing error - CHARACTER(*), INTENT(IN ) :: FileName ! Name of the input file - - - ! local variables - - INTEGER :: U_in ! Input unit. - INTEGER(IntKi) :: ErrStat2 ! Error level (local) - CHARACTER(MaxMsgLen) :: ErrMsg2 ! Message describing error (local) - -! CHARACTER(200) :: LINE - - REAL(ReKi) :: L_Usr_Tmp - REAL(ReKi) :: Sigma_USR_Tmp - REAL(ReKi) :: U_USR_Tmp - REAL(ReKi) :: WindDir_USR_Tmp - REAL(ReKi) :: Z_USR_Tmp - - INTEGER :: I - INTEGER :: Indx - INTEGER :: J - - LOGICAL :: ReadSigL ! Whether or not to read the last 2 columns - - - ErrStat = ErrID_None - ErrMsg = "" - - U_in = -1 - CALL GetNewUnit( U_in, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'GetUSRProfiles') - CALL OpenFInpFile( U_in, FileName, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'GetUSRProfiles') - - IF (ErrStat >= AbortErrLev) THEN - CLOSE(U_in) - RETURN - END IF - - DO I=1,3 - CALL ReadCom( U_in, FileName, "Header line "//trim(num2lstr(I))//" for user-defined profiles", ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'GetUSRProfiles') - END DO - - - ! ---------- Read the size of the arrays -------------------------------------------- - CALL ReadVar( U_in, FileName, p_met%NumUSRz, "NumUSRz", "Number of heights in the user-defined profiles", ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'GetUSRProfiles') - - IF ( p_met%NumUSRz < 1 ) THEN - CALL SetErrStat( ErrID_Fatal, 'The number of heights specified in the user-defined profiles must be at least 1.', ErrStat, ErrMsg, 'GetUSRProfiles') - ENDIF - - DO I=1,3 - ! ---------- Read the scaling for the standard deviations -------------------------------------------- - CALL ReadVar( U_in, FileName, p_met%USR_StdScale(I), "USR_StdScale", "Scaling value for user-defined standard deviation profile", ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'GetUSRProfiles') - - - IF ( p_met%USR_StdScale(I) <= 0. ) THEN - CALL SetErrStat( ErrID_Fatal, 'The scaling value for the user-defined standard deviation profile must be positive.', ErrStat, ErrMsg, 'GetUSRProfiles') - ENDIF - ENDDO - - ! Allocate the data arrays - CALL AllocAry(p_met%USR_Z, p_met%NumUSRz, 'USR_Z (user-defined height)', ErrStat2, ErrMsg2); CALL SetErrStat(ErrSTat2, ErrMsg2, ErrStat, ErrMsg, 'GetUSRProfiles') - CALL AllocAry(p_met%USR_U, p_met%NumUSRz, 'USR_U (user-defined wind speed)', ErrStat2, ErrMsg2); CALL SetErrStat(ErrSTat2, ErrMsg2, ErrStat, ErrMsg, 'GetUSRProfiles') - CALL AllocAry(p_met%USR_WindDir, p_met%NumUSRz, 'USR_WindDir (user-defined wind direction)', ErrStat2, ErrMsg2); CALL SetErrStat(ErrSTat2, ErrMsg2, ErrStat, ErrMsg, 'GetUSRProfiles') - - - IF ( p_met%TurbModel_ID == SpecModel_USRVKM ) THEN - ReadSigL = .TRUE. - - CALL AllocAry(p_met%USR_Sigma, p_met%NumUSRz, 'USR_Sigma (user-defined sigma)', ErrStat2, ErrMsg2); CALL SetErrStat(ErrSTat2, ErrMsg2, ErrStat, ErrMsg, 'GetUSRProfiles') - CALL AllocAry(p_met%USR_L, p_met%NumUSRz, 'USR_L (user-defined length scale)', ErrStat2, ErrMsg2); CALL SetErrStat(ErrSTat2, ErrMsg2, ErrStat, ErrMsg, 'GetUSRProfiles') - - ELSE - ReadSigL = .FALSE. - ENDIF - - IF (ErrStat >= AbortErrLev) THEN - CLOSE(U_in) - RETURN - END IF - - ! ---------- Skip 4 lines -------------------------------------------- - DO I=1,4 - CALL ReadCom( U_in, FileName, "Headers for user-defined variables", ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'GetUSRProfiles') - - ENDDO - - DO I=1,p_met%NumUSRz - - IF ( ReadSigL ) THEN - READ( U_in, *, IOSTAT=ErrStat2 ) p_met%USR_Z(I), p_met%USR_U(I), p_met%USR_WindDir(I), p_met%USR_Sigma(I), p_met%USR_L(I) - ELSE - READ( U_in, *, IOSTAT=ErrStat2 ) p_met%USR_Z(I), p_met%USR_U(I), p_met%USR_WindDir(I) - ENDIF - - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Could not read entire user-defined variable list on line '//Int2LStr(I)//'.', ErrStat, ErrMsg, 'GetUSRProfiles') - CLOSE(U_in) - RETURN - ENDIF - - IF ( ReadSigL ) THEN - IF ( p_met%USR_Sigma(I) <= REAL( 0., ReKi ) ) THEN - CALL SetErrStat( ErrID_Fatal, 'The standard deviation must be a positive number.', ErrStat, ErrMsg, 'GetUSRProfiles') - ELSEIF ( p_met%USR_L(I) <= REAL( 0., ReKi ) ) THEN - CALL SetErrStat( ErrID_Fatal, 'The length scale must be a positive number.', ErrStat, ErrMsg, 'GetUSRProfiles') - ENDIF - ENDIF - - IF ( p_met%USR_WindDir(I) > 360. ) THEN - J = INT ( p_met%USR_WindDir(I) / 360. ) - p_met%USR_WindDir(I) = p_met%USR_WindDir(I) - J * 360. - ELSEIF ( p_met%USR_WindDir(I) < 0. ) THEN - J = INT ( -p_met%USR_WindDir(I) / 360. ) +1 - p_met%USR_WindDir(I) = p_met%USR_WindDir(I) + J * 360. - ENDIF - ENDDO - - ! Sort the arrays - DO I=2,p_met%NumUSRz - IF ( p_met%USR_Z(I) < p_met%USR_Z(I-1) ) THEN - - Indx = 1 - DO J=I-2,1,-1 - IF ( p_met%USR_Z(I) > p_met%USR_Z(J) ) THEN - Indx = J+1 - EXIT - ELSEIF ( p_met%USR_Z(I) == p_met%USR_Z(J) ) THEN - CALL SetErrStat( ErrID_Fatal, 'User-defined values must contain unique heights.', ErrStat, ErrMsg, 'GetUSRProfiles') - CLOSE(U_in) - RETURN - ENDIF - ENDDO - - Z_USR_Tmp = p_met%USR_Z(I) - U_USR_Tmp = p_met%USR_U(I) - WindDir_USR_Tmp = p_met%USR_WindDir(I) - - DO J=I,Indx+1,-1 - p_met%USR_Z(J) = p_met%USR_Z(J-1) - p_met%USR_U(J) = p_met%USR_U(J-1) - p_met%USR_WindDir(J) = p_met%USR_WindDir(J-1) - ENDDO - - p_met%USR_Z(Indx) = Z_USR_Tmp - p_met%USR_U(Indx) = U_USR_Tmp - p_met%USR_WindDir(Indx) = WindDir_USR_Tmp - - IF ( ReadSigL ) THEN - Sigma_USR_Tmp = p_met%USR_Sigma(I) - L_USR_Tmp = p_met%USR_L(I) - - DO J=I,Indx+1,-1 - p_met%USR_Sigma(J) = p_met%USR_Sigma(J-1) - p_met%USR_L(J) = p_met%USR_L(J-1) - ENDDO - - p_met%USR_Sigma(Indx) = Sigma_USR_Tmp - p_met%USR_L(Indx) = L_USR_Tmp - ENDIF ! ReadSigL - - ENDIF - ENDDO - - CLOSE(U_in) - -END SUBROUTINE GetUSRProfiles -!======================================================================= -!> Read the input file for user-defined spectra. -SUBROUTINE GetUSRSpec(FileName, p, UnEc, ErrStat, ErrMsg) - - IMPLICIT NONE - - TYPE(TurbSim_ParameterType), INTENT(INOUT) :: p !< Simulation parameters - INTEGER(IntKi), INTENT(IN ) :: UnEc !< Echo file unit number - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error level - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Message describing error - CHARACTER(*), INTENT(IN) :: FileName !< Name of the input file - - ! local variables - REAL(ReKi) :: Freq_USR_Tmp - REAL(ReKi) :: U_USR_Tmp - REAL(ReKi) :: V_USR_Tmp - REAL(ReKi) :: W_USR_Tmp - REAL(ReKi) :: SpecScale (3) - - INTEGER :: I - INTEGER, PARAMETER :: iPoint = 1 ! spectra are input for only one point - INTEGER :: Indx - INTEGER :: J - INTEGER :: USpec ! I/O unit for user-defined spectra - - - INTEGER(IntKi) :: ErrStat2 ! Error level (local) - CHARACTER(MaxMsgLen) :: ErrMsg2 ! Message describing error (local) - - ErrStat = ErrID_None - ErrMSg = "" - - ! --------- Open the file --------------- - - CALL GetNewUnit( USpec, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2 , ErrStat, ErrMsg, 'GetUSRSpec') - - CALL OpenFInpFile( USpec, FileName, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2 , ErrStat, ErrMsg, 'GetUSRSpec') - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - ENDIF - - - CALL WrScr1(' Reading the user-defined spectra input file "'//TRIM(FileName)//'".' ) - - - ! --------- Read the comment lines at the beginning of the file --------------- - DO I=1,3 - CALL ReadCom( USpec, FileName, "user-spectra header line #"//TRIM(Num2LStr(I)), ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'GetUSRSpec') - ENDDO - - - ! ---------- Read the size of the arrays -------------------------------------------- - CALL ReadVar( USpec, FileName, p%usr%nFreq, "nFreq", "Number of frequencies in the user-defined spectra", ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'GetUSRSpec') - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - ENDIF - - - DO I=1,3 - ! ---------- Read the scaling for the arrays -------------------------------------------- - CALL ReadVar( USpec, FileName, SpecScale(I), "SpecScale", "Scaling value for user-defined standard deviation profile", ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'GetUSRSpec') - - ENDDO - - IF ( p%usr%nFreq < 3 ) CALL SetErrStat(ErrID_Fatal, 'The number of frequencies specified in the user-defined spectra must be at least 3.' , ErrStat, ErrMsg, 'GetUSRSpec') - IF ( ANY(SpecScale <= 0.) ) CALL SetErrStat(ErrID_Fatal, 'The scaling value for the user-defined spectra must be positive.' , ErrStat, ErrMsg, 'GetUSRSpec') - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - ENDIF - - ! Allocate the data arrays - CALL AllocAry( p%usr%f, p%usr%nFreq, 'f (user-defined frequencies)' ,ErrStat2,ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'GetUSRSpec') - CALL AllocAry( p%usr%S, p%usr%nFreq,1,3,'S (user-defined spectra)' ,ErrStat2,ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'GetUSRSpec') - CALL AllocAry( p%usr%pointzi, iPoint , 'pointzi (user-defined spectra',ErrStat2,ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'GetUSRSpec') - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - p%usr%pointzi = 0.0_ReKi ! we don't care what this is; it's only potentially used so we can use the same interpolation routine as the user time-series input - - ! ---------- Skip 4 lines -------------------------------------------- - DO I=1,4 - CALL ReadCom( USpec, FileName, "Headers for user-defined variables", ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'GetUSRSpec') - ENDDO - - ! ---------- Read the data lines -------------------------------------- - DO I=1,p%usr%nFreq - - READ( USpec, *, IOSTAT=ErrStat2 ) p%usr%f(I), p%usr%S(I,iPoint,1), p%usr%S(I,iPoint,2), p%usr%S(I,iPoint,3) - - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat(ErrID_Fatal, 'Could not read entire user-defined spectra on line '//Int2LStr(I)//'.' , ErrStat, ErrMsg, 'GetUSRSpec') - CALL Cleanup() - RETURN - ENDIF - - IF ( ANY( p%usr%S(I,iPoint,:) <= 0._ReKi ) ) THEN - - CALL SetErrStat(ErrID_Fatal, 'The spectra must contain positive numbers.' , ErrStat, ErrMsg, 'GetUSRSpec') - CALL Cleanup() - RETURN - -! ELSEIF ( p%usr%f(I) <= 0.0_ReKi ) THEN -! CALL SetErrStat(ErrID_Fatal, 'The frequencies must be positive numbers.' , ErrStat, ErrMsg, 'GetUSRSpec') -! CALL Cleanup() -! RETURN - ENDIF - - ! Scale by the factors earlier in the input file - - p%usr%S(I,iPoint,1) = p%usr%S(I,iPoint,1)*SpecScale(1) - p%usr%S(I,iPoint,2) = p%usr%S(I,iPoint,2)*SpecScale(2) - p%usr%S(I,iPoint,3) = p%usr%S(I,iPoint,3)*SpecScale(3) - - ENDDO - - ! ------- Sort the arrays by frequency ----------------------------------- - DO I=2,p%usr%nFreq - IF ( p%usr%f(I) < p%usr%f(I-1) ) THEN - - Indx = 1 - DO J=I-2,1,-1 - IF ( p%usr%f(I) > p%usr%f(J) ) THEN - Indx = J+1 - EXIT - ELSEIF ( EqualRealNos( p%usr%f(I), p%usr%f(J) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 'Error: user-defined spectra must contain unique frequencies.' , ErrStat, ErrMsg, 'GetUSRSpec') - CALL Cleanup() - RETURN - ENDIF - ENDDO - - Freq_USR_Tmp = p%usr%f(I) - U_USR_Tmp = p%usr%S(I,iPoint,1) - V_USR_Tmp = p%usr%S(I,iPoint,2) - W_USR_Tmp = p%usr%S(I,iPoint,3) - - DO J=I,Indx+1,-1 - p%usr%f(J) = p%usr%f(J-1) - p%usr%S(J,iPoint,1) = p%usr%S(J-1,iPoint,1) - p%usr%S(J,iPoint,2) = p%usr%S(J-1,iPoint,2) - p%usr%S(J,iPoint,3) = p%usr%S(J-1,iPoint,3) - ENDDO - - p%usr%f(Indx) = Freq_USR_Tmp - p%usr%S(I,iPoint,1) = U_USR_Tmp - p%usr%S(I,iPoint,2) = V_USR_Tmp - p%usr%S(I,iPoint,3) = W_USR_Tmp - - ENDIF - ENDDO - - ! --------- Close the file --------------------------------------- - - CALL Cleanup() - RETURN - -CONTAINS - SUBROUTINE Cleanup() - - CLOSE( USpec ) - - - END SUBROUTINE Cleanup - -END SUBROUTINE GetUSRSpec - -!======================================================================= -!> Read the input file for user-defined time series -SUBROUTINE GetUSRTimeSeries(FileName, p, UnEc, ErrStat, ErrMsg) - - IMPLICIT NONE - - TYPE(TurbSim_ParameterType), INTENT(INOUT) :: p !< Simulation parameters - INTEGER(IntKi), INTENT(IN ) :: UnEc !< Echo file unit number - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error level - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Message describing error - CHARACTER(*), INTENT(IN) :: FileName !< Name of the input file - - ! local variables - real(reKi) :: tmpAry(2) - real(ReKi) :: dt ! difference between consecutive times entered in the file (must be constant) - INTEGER(IntKi), PARAMETER :: NumLinesBeforeTS = 11 ! Number of lines in the input file before the time series start (need to add nPoint lines). IMPORTANT: any changes to the number of lines in the header must be reflected here - - INTEGER(IntKi) :: UnIn ! unit number for reading input file - INTEGER(IntKi) :: I, J ! loop counters - INTEGER(IntKi) :: IPoint ! loop counter on number of points - INTEGER(IntKi) :: IVec ! loop counter on velocity components being read - INTEGER(IntKi) :: ErrStat2 ! Error level (local) - CHARACTER(MaxMsgLen) :: ErrMsg2 ! Message describing error (local) - CHARACTER(*), parameter :: RoutineName = 'GetUSRTimeSeries' - - CHARACTER(200) :: FormStr - CHARACTER(1) :: tmpChar - - ErrStat = ErrID_None - ErrMsg = "" - - ! --------- Open the file --------------- - - CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2 , ErrStat, ErrMsg, RoutineName) - - CALL OpenFInpFile( UnIn, FileName, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2 , ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - ENDIF - - - CALL WrScr1(' Reading the user-defined time-series input file "'//TRIM(FileName)//'".' ) - - IF ( UnEc > 0 ) WRITE (UnEc,'(/,A,/)') 'Data from '//TRIM(TurbSim_Ver%Name)//' user time-series input file "'//TRIM( FileName )//'":' - - - do i=1,3 - CALL ReadCom( UnIn, FileName, "Header #"//TRIM(Num2Lstr(i))//"for user time-series input", ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2 , ErrStat, ErrMsg, RoutineName) - end do - - CALL ReadVar( UnIn, FileName, p%usr%nComp, 'nComp', 'How many velocity components will be input? (1=u component only; 2=u&v components; 3=u,v,and w)', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2 , ErrStat, ErrMsg, RoutineName) - - CALL ReadVar( UnIn, FileName, p%usr%nPoints, 'nPoints', 'Number of time series points contained in this file', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2 , ErrStat, ErrMsg, RoutineName) - - CALL ReadVar( UnIn, FileName, p%usr%RefPtID, 'RefPtID', 'Index of the reference point (1-nPoints)', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2 , ErrStat, ErrMsg, RoutineName) - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - IF ( p%usr%RefPtID < 1 .OR. p%usr%RefPtID > p%usr%nPoints ) THEN - CALL SetErrStat(ErrID_Fatal, 'RefPtID must be between 1 and nPoints (inclusive).', ErrStat, ErrMsg, RoutineName) - CALL Cleanup() - RETURN - END IF - - - CALL AllocAry(p%usr%Pointyi, p%usr%nPoints, 'Pointyi', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2 , ErrStat, ErrMsg, RoutineName) - CALL AllocAry(p%usr%Pointzi, p%usr%nPoints, 'Pointzi', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2 , ErrStat, ErrMsg, RoutineName) - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - do i=1,2 - CALL ReadCom( UnIn, FileName, "Point location header #"//TRIM(Num2Lstr(i)), ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2 , ErrStat, ErrMsg, RoutineName) - end do - - do iPoint=1,p%usr%nPoints - CALL ReadAry( UnIn, FileName, TmpAry, 2, "point"//trim(Num2Lstr(iPoint)), "locations of points", ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2 , ErrStat, ErrMsg, RoutineName) - - p%usr%Pointyi(iPoint) = TmpAry(1) - p%usr%Pointzi(iPoint) = TmpAry(2) - end do - - - do i=1,3 - CALL ReadCom( UnIn, FileName, "Time Series header #"//TRIM(Num2Lstr(i)), ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2 , ErrStat, ErrMsg, RoutineName) - end do - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - - !....... - ! find out how many rows there are to the end of the file - p%usr%NTimes = -1 - ErrStat2 = 0 - - - DO WHILE ( ErrStat2 == 0 ) - - p%usr%NTimes = p%usr%NTimes + 1 - READ(UnIn, *, IOSTAT=ErrStat2) tmpAry(1) - - END DO - - CALL WrScr( ' Found '//TRIM(Num2LStr(p%usr%NTimes))//' lines of time-series data.' ) - - IF (p%usr%NTimes < 2) THEN - CALL SetErrStat(ErrID_Fatal, 'The user time-series input file must contain at least 2 rows of time data.', ErrStat, ErrMsg, RoutineName) - CALL Cleanup() - RETURN - END IF - - ! now rewind and skip the first few lines. - REWIND( UnIn, IOSTAT=ErrStat2 ) - IF (ErrStat2 /= 0_IntKi ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error rewinding file "'//TRIM(FileName)//'".', ErrStat, ErrMsg, RoutineName) - CALL Cleanup() - END IF - - !IMPORTANT: any changes to the number of lines in the header must be reflected in NumLinesBeforeTS - DO I=1,NumLinesBeforeTS + p%usr%nPoints - READ( UnIn, '(A)', IOSTAT=ErrStat2 ) TmpChar ! I'm going to ignore this error because we should have caught any issues the first time we read the file. - END DO - - !....... - - if (p%usr%nComp < 1 .OR. p%usr%nComp > 3) then - CALL SetErrStat( ErrID_Fatal, 'Number of velocity components in file must be 1, 2 or 3.', ErrStat, ErrMsg, RoutineName) - CALL Cleanup() - END IF - - - - CALL AllocAry(p%usr%t, p%usr%nTimes, 't', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2 , ErrStat, ErrMsg, RoutineName) - CALL AllocAry(p%usr%v, p%usr%nTimes, p%usr%nPoints, p%usr%nComp, 'v', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2 , ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - - DO i=1,p%usr%nTimes - READ( UnIn, *, IOSTAT=ErrStat2 ) p%usr%t(i), ( (p%usr%v(i,iPoint,iVec), iVec=1,p%usr%nComp), iPoint=1,p%usr%nPoints ) - IF (ErrStat2 /=0) THEN - CALL SetErrStat( ErrID_Fatal, 'Error reading from time series line '//trim(num2lstr(i))//'.', ErrStat, ErrMsg, RoutineName) - CALL Cleanup() - RETURN - END IF - END DO - - IF (UnEc > 0 ) THEN - FormStr = '('//trim(num2lstr(1+p%usr%nComp*p%usr%nPoints))//'(F13.4," "))' - DO i=1,p%usr%nTimes - WRITE( UnEc, FormStr) p%usr%t(i), ( (p%usr%v(i,iPoint,iVec), iVec=1,p%usr%nComp), iPoint=1,p%usr%nPoints ) - END DO - END IF - - - !......................................................... - ! a little bit of error checking: - !......................................................... - - !bjj: verify that the locations are okay; for now, we're going to make sure they are unique and that the z values are in increasing order. - do i=2,p%usr%nPoints - do j=1,i-1 - IF ( EqualRealNos( p%usr%Pointyi(i), p%usr%Pointyi(j) ) .AND. EqualRealNos( p%usr%Pointzi(i), p%usr%Pointzi(j) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 'Locations of points specified in the user time-series input file must be unique.', ErrStat, ErrMsg, RoutineName) - CALL Cleanup() - RETURN - END IF - end do - - !bjj: fix this in the future. Currently the interpolation routine won't work if z is not ordered properly. Also, interpolation doesn't take y into account, so we may want to fix that. - IF ( p%usr%Pointzi(i) < p%usr%Pointzi(i-1) ) THEN - CALL SetErrStat(ErrID_Fatal, 'The current implementation of user time-series input requires that the points be entered in the order of increasing height.', ErrStat, ErrMsg, RoutineName) - CALL Cleanup() - RETURN - END IF - end do - - - - !DO i = 2,p%usr%nTimes - ! IF (.NOT. EqualRealNos( p%usr%t(i-1) + p%grid%TimeStep, p%usr%t(i) ) ) THEN - ! call SetErrStat(ErrID_Fatal, 'the delta time in the file must be constant and must be equal to input file variable TimeStep.', ErrStat, ErrMsg, RoutineName) - ! EXIT - ! END IF - !END DO - - ! check for constant delta t: - - dt = p%usr%t(2) - p%usr%t(1) - - DO i = 3,p%usr%nTimes - IF (.NOT. EqualRealNos( p%usr%t(i-1) + dt, p%usr%t(i) ) ) THEN - call SetErrStat(ErrID_Fatal, 'The time between each row in the file must be constant.', ErrStat, ErrMsg, RoutineName) - EXIT - END IF - END DO - - - if ( .NOT. EqualRealNos( dt, p%grid%TimeStep ) ) THEN - call SetErrStat(ErrID_Fatal, 'In this version of TurbSim, TimeStep must be the same as the delta time in the user-input time series file.', ErrStat, ErrMsg, RoutineName) - end if - - - - CALL Cleanup() - RETURN - -CONTAINS -!............................................... - SUBROUTINE Cleanup() - - CLOSE( UnIn ) - - - END SUBROUTINE Cleanup -!............................................... -END SUBROUTINE GetUSRTimeSeries -!======================================================================= -SUBROUTINE ReadCVarDefault ( UnIn, Fil, CharVar, VarName, VarDescr, UnEc, Def, ErrStat, ErrMsg, IGNORE ) - - - ! This routine reads a single character variable from the next line of the input file. - ! The input is allowed to be "default" - - ! Argument declarations: - - - INTEGER, INTENT(IN) :: UnIn ! I/O unit for input file. - INTEGER, INTENT(IN) :: UnEc ! I/O unit for echo/summary file. - INTEGER(IntKi), INTENT(OUT) :: ErrStat ! Error status; if present, program does not abort on error - CHARACTER(*), INTENT(OUT) :: ErrMsg ! Error message - - LOGICAL, INTENT(INOUT) :: Def ! - on input whether or not to use the default - on output, whether a default was used - LOGICAL, INTENT(IN), OPTIONAL:: IGNORE ! whether to ignore this input - - CHARACTER(250) :: CharLine ! Character string being read. - CHARACTER(*), INTENT(INOUT) :: CharVar ! Character variable being read. - CHARACTER( *), INTENT(IN) :: Fil ! Name of the input file. - CHARACTER( *), INTENT(IN) :: VarDescr ! Text string describing the variable. - CHARACTER( *), INTENT(IN) :: VarName ! Text string containing the variable name. - - ! Local declarations: - - - CALL ReadVar( UnIn, Fil, CharLine, VarName, VarDescr, ErrStat, ErrMsg, UnEc) - - IF ( PRESENT(IGNORE) ) THEN - IF ( IGNORE ) THEN - Def = .TRUE. - RETURN - ENDIF - - ENDIF - - CALL Conv2UC( CharLine ) - - IF ( TRIM(CharLine) == 'DEFAULT' ) THEN - -! CALL WrScr ( ' A default value will be used for '//TRIM(VarName)//'.' ) - Def = .TRUE. - - ELSE - - CharVar = CharLine - Def = .FALSE. - - ENDIF - - RETURN -END SUBROUTINE ReadCVarDefault ! ( UnIn, Fil, RealVar, VarName, VarDescr ) -!======================================================================= -SUBROUTINE ReadRAryDefault ( UnIn, Fil, RealAry, VarName, VarDescr, UnEc, Def, ErrStat, ErrMsg, IGNORE ) - - ! This routine reads a real array from the next line of the input file. - ! The input is allowed to be "default" - - ! Argument declarations: - - REAL(ReKi), INTENT(INOUT) :: RealAry (:) ! Real variable being read. - - INTEGER, INTENT(IN) :: UnIn ! I/O unit for input file. - INTEGER, INTENT(IN) :: UnEc ! I/O unit for echo/summary file. - INTEGER(IntKi), INTENT(OUT) :: ErrStat ! Error status; if present, program does not abort on error - CHARACTER(*), INTENT(OUT) :: ErrMsg ! Error message - - LOGICAL, INTENT(INOUT) :: Def ! - on input whether or not to use the default - on output, whether a default was used - LOGICAL, INTENT(IN), OPTIONAL:: IGNORE ! whether or not to ignore this input - - CHARACTER(250) :: CharLine ! Character string being read. - CHARACTER( *), INTENT(IN) :: Fil ! Name of the input file. - CHARACTER( *), INTENT(IN) :: VarDescr ! Text string describing the variable. - CHARACTER( *), INTENT(IN) :: VarName ! Text string containing the variable name. - - ! Local declarations: - - INTEGER :: IOS ! I/O status returned from the read statement. - - - CALL ReadVar( UnIn, Fil, CharLine, VarName, VarDescr, ErrStat, ErrMsg, UnEc) !Maybe I should read this in explicitly... - - IF ( PRESENT(IGNORE) ) THEN - IF ( IGNORE ) THEN - Def = .TRUE. - RETURN - ENDIF - - ENDIF - - CALL Conv2UC( CharLine ) - - IF ( TRIM(CharLine) == 'DEFAULT' ) THEN - -! CALL WrScr ( ' A default value will be used for '//TRIM(VarName)//'.' ) - Def = .TRUE. - - ELSE - - IF ( INDEX( CharLine(1:1), 'TF') > 0 ) THEN ! We don't want 'T' or 'F' read as -1 or 0. - CALL WrScr1 ( ' Invalid numerical input for "'//TRIM( VarName )//'".' ) - ENDIF - - READ (CharLine,*,IOSTAT=IOS) RealAry - - IF (IOS /=0) THEN - RealAry = 0.0_ReKi ! set these all to 0 - READ (CharLine,*,IOSTAT=IOS) RealAry(1) ! Try reading only the first element - ENDIF - - CALL CheckIOS ( IOS, Fil, VarName, NumType ) - Def = .FALSE. - - ENDIF - - - RETURN - -END SUBROUTINE ReadRAryDefault -!======================================================================= -SUBROUTINE ReadRVarDefault ( UnIn, Fil, RealVar, VarName, VarDescr, UnEc, Def, ErrStat, ErrMsg, IGNORE, IGNORESTR ) - - ! This routine reads a single real variable from the next line of the input file. - ! The input is allowed to be "default" - - ! Argument declarations: - - REAL(ReKi), INTENT(INOUT) :: RealVar ! Real variable being read. - - INTEGER, INTENT(IN) :: UnIn ! I/O unit for input file. - INTEGER, INTENT(IN) :: UnEc ! I/O unit for echo/summary file. - - INTEGER(IntKi), INTENT(OUT) :: ErrStat ! Error status; if present, program does not abort on error - CHARACTER(*), INTENT(OUT) :: ErrMsg ! Error message - - LOGICAL, INTENT( OUT) :: Def ! - on input whether or not to use the default - on output, whether a default was used - LOGICAL, INTENT(IN), OPTIONAL:: IGNORE ! whether or not to ignore this input - LOGICAL, INTENT(INOUT),OPTIONAL:: IGNORESTR ! whether or not user requested to ignore this input - - CHARACTER(250) :: CharLine ! Character string being read. - CHARACTER( *), INTENT(IN) :: Fil ! Name of the input file. - CHARACTER( *), INTENT(IN) :: VarDescr ! Text string describing the variable. - CHARACTER( *), INTENT(IN) :: VarName ! Text string containing the variable name. - - ! Local declarations: - - INTEGER :: IOS ! I/O status returned from the read statement. - - - CALL ReadVar( UnIn, Fil, CharLine, VarName, VarDescr, ErrStat, ErrMsg, UnEc ) - - IF ( PRESENT(IGNORE) ) THEN - - IF ( IGNORE ) THEN - Def = .TRUE. - RETURN - ENDIF - - ENDIF - - - CALL Conv2UC( CharLine ) - - IF ( PRESENT(IGNORESTR) ) THEN - IF ( TRIM( CharLine ) == 'NONE' ) THEN - IGNORESTR = .TRUE. - Def = .TRUE. - RETURN - ENDIF - ENDIF - - IF ( TRIM(CharLine) == 'DEFAULT' ) THEN - -! CALL WrScr ( ' A default value will be used for '//TRIM(VarName)//'.' ) - Def = .TRUE. - RETURN - - ELSE - - IF ( INDEX( CharLine(1:1), 'TF') > 0 ) THEN ! We don't want 'T' or 'F' read as -1 or 0. - CALL WrScr1 ( ' Invalid numerical input for "'//TRIM( VarName )//'".' ) - ENDIF - - READ (CharLine,*,IOSTAT=IOS) RealVar - - CALL CheckIOS ( IOS, Fil, VarName, NumType ) - - Def = .FALSE. - - IF ( PRESENT(IGNORESTR) ) IGNORESTR = .FALSE. - - ENDIF - - - RETURN -END SUBROUTINE ReadRVarDefault -!======================================================================= -!> This routine writes the velocity grid to a binary file. -!! The file has a .wnd extension; scaling information is written in a summary -!! file. A tower file with extension .twr is generated if requested, too. -SUBROUTINE WrBinBLADED(p, V, USig, VSig, WSig, ErrStat, ErrMsg) - - IMPLICIT NONE - - TYPE(TurbSim_ParameterType), INTENT(IN) :: p !< TurbSim's parameters - REAL(ReKi), INTENT(IN) :: V (:,:,:) !< An array containing the summations of the rows of H (NumSteps,NPoints,3). - REAL(ReKi), INTENT(IN) :: USig !< Standard deviation of U - REAL(ReKi), INTENT(IN) :: VSig !< Standard deviation of V - REAL(ReKi), INTENT(IN) :: WSig !< Standard deviation of W - INTEGER(IntKi), intent( out) :: ErrStat !< Error level - CHARACTER(*), intent( out) :: ErrMsg !< Message describing error - - - REAL(ReKi) :: NewUSig ! Value of USig that will be used to scale values in the file - - REAL(ReKi) :: U_C1 ! Scale for converting BLADED U data - REAL(ReKi) :: U_C2 ! Offset for converting BLADED U data - REAL(ReKi) :: V_C ! Scale for converting BLADED V data - REAL(ReKi) :: W_C ! Scale for converting BLADED W data - REAL(ReKi) :: TI(3) ! Turbulence intensity for scaling data - REAL(ReKi) :: TmpU ! Max value of |V(:,:,1)-UHub| - - INTEGER(B4Ki) :: CFirst - INTEGER(B4Ki) :: CLast - INTEGER(B4Ki) :: CStep - INTEGER(B4Ki) :: II - INTEGER(B4Ki) :: IT - INTEGER(B4Ki) :: IY - INTEGER(B4Ki) :: IZ - - INTEGER(B4Ki) :: IP - INTEGER(B2Ki) :: TmpVarray(3*p%grid%NumGrid_Y*p%grid%NumGrid_Z) ! This array holds the normalized velocities before being written to the binary file - INTEGER(B2Ki), ALLOCATABLE :: TmpTWRarray(:) ! This array holds the normalized tower velocities - - INTEGER :: AllocStat - INTEGER :: UBFFW ! I/O unit for BLADED FF data (*.wnd file). - INTEGER :: UATWR ! I/O unit for AeroDyn tower data (*.twr file). - - CHARACTER(200) :: FormStr ! String used to store format specifiers. - - - ErrStat = ErrID_None - ErrMsg = "" - - - - ! We need to take into account the shear across the grid in the sigma calculations for scaling the data, - ! and ensure that 32.767*Usig >= |V-UHub| so that we don't get values out of the range of our scaling values - ! in this BLADED-style binary output. TmpU is |V-UHub| - TmpU = MAX( ABS(MAXVAL(V(:,:,1))-p%UHub), ABS(MINVAL(V(:,:,1))-p%UHub) ) !Get the range of wind speed values for scaling in BLADED-format .wnd files - NewUSig = MAX(USig,0.05*TmpU) - - - ! Put normalizing factors into the summary file. The user can use them to - ! tell a simulation program how to rescale the data. - - TI(1) = MAX(100.0*Tolerance, NewUSig) / p%UHub - TI(2) = MAX(100.0*Tolerance, VSig) / p%UHub - TI(3) = MAX(100.0*Tolerance, WSig) / p%UHub - - WRITE (p%US,"(//,'Normalizing Parameters for Binary Data (approximate statistics):',/)") - - FormStr = "(3X,A,' =',F9.4,A)" - WRITE (p%US,FormStr) 'UBar ', p%UHub, ' m/s' - WRITE (p%US,FormStr) 'TI(u)', 100.0*TI(1), ' %' - WRITE (p%US,FormStr) 'TI(v)', 100.0*TI(2), ' %' - WRITE (p%US,FormStr) 'TI(w)', 100.0*TI(3), ' %' - - WRITE (p%US,'()') - WRITE (p%US,FormStr) 'Height Offset', ( p%grid%HubHt - p%grid%GridHeight / 2.0 - p%grid%Zbottom ), ' m' - WRITE (p%US,FormStr) 'Grid Base ', p%grid%Zbottom, ' m' - - WRITE (p%US,'()' ) - IF ( p%grid%Periodic ) THEN - WRITE (p%US,'( A)' ) 'Creating a PERIODIC output file.' - END IF - - ! Calculate some numbers for normalizing the data. - - U_C1 = 1000.0/( p%UHub*TI(1) ) - U_C2 = 1000.0/TI(1) - V_C = 1000.0/( p%UHub*TI(2) ) - W_C = 1000.0/( p%UHub*TI(3) ) - - - IF ( p%WrFile(FileExt_WND) ) THEN - - CALL GetNewUnit( UBFFW ) - CALL OpenBOutFile ( UBFFW, TRIM(p%RootName)//'.wnd', ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN - - CALL WrScr ( ' Generating BLADED binary time-series file "'//TRIM( p%RootName )//'.wnd"' ) - - ! Put header information into the binary data file. - - WRITE (UBFFW) INT( -99 , B2Ki ) ! -99 = New Bladed format - WRITE (UBFFW) INT( 4 , B2Ki ) ! 4 = improved von karman (but needed for next 7 inputs) - WRITE (UBFFW) INT( 3 , B4Ki ) ! 3 = number of wind components - WRITE (UBFFW) REAL( p%met%Latitude , SiKi ) ! Latitude (degrees) - WRITE (UBFFW) REAL( p%met%Z0 , SiKi ) ! Roughness length (m) - WRITE (UBFFW) REAL( p%grid%Zbottom + p%grid%GridHeight/2.0 , SiKi ) ! Reference Height (m) ( Z(1) + GridHeight / 2.0 ) !This is the vertical center of the grid - WRITE (UBFFW) REAL( 100.0*TI(1) , SiKi ) ! Longitudinal turbulence intensity (%) - WRITE (UBFFW) REAL( 100.0*TI(2) , SiKi ) ! Lateral turbulence intensity (%) - WRITE (UBFFW) REAL( 100.0*TI(3) , SiKi ) ! Vertical turbulence intensity (%) - - WRITE (UBFFW) REAL( p%grid%GridRes_Z , SiKi ) ! grid spacing in vertical direction, in m - WRITE (UBFFW) REAL( p%grid%GridRes_Y , SiKi ) ! grid spacing in lateral direction, in m - WRITE (UBFFW) REAL( p%grid%TimeStep*p%UHub , SiKi ) ! grid spacing in longitudinal direciton, in m - WRITE (UBFFW) INT( p%grid%NumOutSteps/2 , B4Ki ) ! half the number of points in alongwind direction - WRITE (UBFFW) REAL( p%UHub , SiKi ) ! the mean wind speed in m/s - WRITE (UBFFW) REAL( 0 , SiKi ) ! the vertical length scale of the longitudinal component in m - WRITE (UBFFW) REAL( 0 , SiKi ) ! the lateral length scale of the longitudinal component in m - WRITE (UBFFW) REAL( 0 , SiKi ) ! the longitudinal length scale of the longitudinal component in m - WRITE (UBFFW) INT( 0 , B4Ki ) ! an unused integer - WRITE (UBFFW) INT( p%RNG%RandSeed(1) , B4Ki ) ! the random number seed - WRITE (UBFFW) INT( p%grid%NumGrid_Z , B4Ki ) ! the number of grid points vertically - WRITE (UBFFW) INT( p%grid%NumGrid_Y , B4Ki ) ! the number of grid points laterally - WRITE (UBFFW) INT( 0 , B4Ki ) ! the vertical length scale of the lateral component, not used - WRITE (UBFFW) INT( 0 , B4Ki ) ! the lateral length scale of the lateral component, not used - WRITE (UBFFW) INT( 0 , B4Ki ) ! the longitudinal length scale of the lateral component, not used - WRITE (UBFFW) INT( 0 , B4Ki ) ! the vertical length scale of the vertical component, not used - WRITE (UBFFW) INT( 0 , B4Ki ) ! the lateral length scale of the vertical component, not used - WRITE (UBFFW) INT( 0 , B4Ki ) ! the longitudinal length scale of the vertical component, not used - - - ! Compute parameters for ordering output for FF AeroDyn files. (This is for BLADED compatibility.) - - IF ( p%grid%Clockwise ) THEN - CFirst = p%grid%NumGrid_Y - CLast = 1 - CStep = -1 - ELSE - CFirst = 1 - CLast = p%grid%NumGrid_Y - CStep = 1 - ENDIF - - - ! Loop through time. - - DO IT=1,p%grid%NumOutSteps !Use only the number of timesteps requested originally - - ! Write out grid data in binary form. - IP = 1 - DO IZ=1,p%grid%NumGrid_Z - DO IY=CFirst,CLast,CStep - - II = ( IZ - 1 )*p%grid%NumGrid_Y + IY - - TmpVarray(IP) = NINT( U_C1*V(IT,p%grid%GridPtIndx(II),1) - U_C2, B2Ki ) ! Put the data into a temp array so that the WRITE() command works faster - TmpVarray(IP+1) = NINT( V_C *V(IT,p%grid%GridPtIndx(II),2) , B2Ki ) - TmpVarray(IP+2) = NINT( W_C *V(IT,p%grid%GridPtIndx(II),3) , B2Ki ) - - IP = IP + 3; - ENDDO ! IY - ENDDO ! IZ - - WRITE ( UBFFW ) TmpVarray ! bjj: We cannot write the array including time because of stack overflow errors.. otherwise use compile option to put this on the heap instead of the stack? - - ENDDO ! IT - - CLOSE ( UBFFW ) - - !....................................................... - ! Now write tower data file if necessary: - !....................................................... - - IF ( p%WrFile(FileExt_TWR) ) THEN - - CALL GetNewUnit( UATWR, ErrStat, ErrMsg ) - CALL OpenBOutFile ( UATWR, TRIM( p%RootName )//'.twr', ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN - - - !IF ( ALLOCATED(p%grid%TwrPtIndx) ) THEN - ALLOCATE( TmpTwrarray( 3*SIZE(p%grid%TwrPtIndx) ), STAT=AllocStat ) - IF ( AllocStat /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = "WrBinBLADED: Error allocating space for temporary tower output array." - RETURN - END IF - !END IF - - - CALL WrScr ( ' Generating tower binary time-series file "'//TRIM( p%RootName )//'.twr"' ) - - - WRITE (UATWR) REAL( p%grid%GridRes_Z , SiKi ) ! grid spacing in vertical direction, in m - WRITE (UATWR) REAL( p%grid%TimeStep*p%UHub , SiKi ) ! grid spacing in longitudinal direciton, in m - WRITE (UATWR) REAL( p%grid%ZBottom , SiKi ) ! The vertical location of the highest tower grid point in m - WRITE (UATWR) INT( p%grid%NumOutSteps , B4Ki ) ! The number of points in alongwind direction - WRITE (UATWR) INT( SIZE(p%grid%TwrPtIndx) , B4Ki ) ! the number of grid points vertically - WRITE (UATWR) REAL( p%UHub , SiKi ) ! the mean wind speed in m/s - WRITE (UATWR) REAL( 100.0*TI(1), SiKi ) ! Longitudinal turbulence intensity - WRITE (UATWR) REAL( 100.0*TI(2), SiKi ) ! Lateral turbulence intensity - WRITE (UATWR) REAL( 100.0*TI(3), SiKi ) ! Vertical turbulence intensity - - - DO IT=1,p%grid%NumOutSteps - - IP = 1 - DO II = 1,SIZE(p%grid%TwrPtIndx) - TmpTWRarray(IP ) = NINT( U_C1*V(IT,p%grid%TwrPtIndx(II),1) - U_C2 , B2Ki ) - TmpTWRarray(IP+1) = NINT( V_C *V(IT,p%grid%TwrPtIndx(II),2) , B2Ki ) - TmpTWRarray(IP+2) = NINT( W_C *V(IT,p%grid%TwrPtIndx(II),3) , B2Ki ) - - IP = IP + 3 - ENDDO ! II - - WRITE (UATWR) TmpTWRarray(:) - - ENDDO ! IT - - CLOSE ( UATWR ) - - - ENDIF !WrADWTR - - ENDIF ! p%WrFile(FileExt_WND) - - -END SUBROUTINE WrBinBLADED -!======================================================================= -!> This routine writes the velocity grid to a binary file. -!! The file has a .bts extension. -!======================================================================= -SUBROUTINE WrBinTURBSIM(p, V, ErrStat, ErrMsg) - - IMPLICIT NONE - - ! passed variables - TYPE(TurbSim_ParameterType), INTENT(IN) :: p !< TurbSim's parameters - REAL(ReKi), INTENT(IN) :: V (:,:,:) !< 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 - REAL(SiKi), PARAMETER :: IntMax = 32767.0 - REAL(SiKi), PARAMETER :: IntMin = -32768.0 - REAL(SiKi), PARAMETER :: IntRng = IntMax - IntMin ! Max Range of 2-byte integer - - REAL(SiKi) :: UOff ! Offset for the U component - REAL(SiKi) :: UScl ! Slope for the U component - REAL(ReKi) :: VMax(3) ! Maximum value of the 3 wind components - REAL(ReKi) :: VMin(3) ! Minimum value of the 3 wind components - REAL(SiKi) :: VOff ! Offset for the V component - REAL(SiKi) :: VScl ! Slope for the V component - REAL(SiKi) :: WOff ! Offset for the W component - REAL(SiKi) :: WScl ! Slope for the W component - - INTEGER, PARAMETER :: DecRound = 3 ! Number of decimal places to round to - INTEGER(B2Ki) :: FileID ! File ID, determines specific output format (if periodic or not) - INTEGER :: IC ! counter for the velocity component of V - INTEGER :: II ! counter for the point on the grid/tower - INTEGER :: IT ! counter for the timestep - INTEGER(B4Ki) :: LenDesc ! Length of the description string - INTEGER(B4Ki) :: NumGrid ! Number of points on the grid - INTEGER(B4Ki) :: NumTower ! Number of points on the tower - - INTEGER(B4Ki) :: IP - INTEGER(B2Ki),ALLOCATABLE :: TmpVarray(:) ! This array holds the normalized velocities before being written to the binary file - - INTEGER :: AllocStat - INTEGER :: UAFFW ! I/O unit for AeroDyn FF data (*.bts file). - - - - ! Set the file format ID - - IF ( p%grid%Periodic ) THEN - FileID = 8 - ELSE - FileID = 7 - END IF - - - ! Find the range of our velocity - - DO IC=1,3 - - ! Initialize the Min/Max values - - VMin(IC) = V(1,1,IC) - VMax(IC) = V(1,1,IC) - - DO II=1,p%grid%NPoints ! Let's check all of the points - DO IT=1,p%grid%NumOutSteps ! Use only the number of timesteps requested originally - - IF ( V(IT,II,IC) > VMax(IC) ) THEN - - VMax(IC) = V(IT,II,IC) - - ELSEIF ( V(IT,II,IC) < VMin(IC) ) THEN - - VMin(IC) = V(IT,II,IC) - - ENDIF - - ENDDO !IT - ENDDO !II - - ENDDO !IC - - - ! Calculate the scaling parameters for each component - - - IF ( VMax(1) == VMin(1) ) THEN - UScl = 1 - ELSE - UScl = IntRng/REAL( VMax(1) - VMin(1) , SiKi ) - ENDIF - - IF ( VMax(2) == VMin(2) ) THEN - VScl = 1 - ELSE - VScl = IntRng/REAL( VMax(2) - VMin(2) , SiKi ) - ENDIF - - IF ( VMax(3) == VMin(3) ) THEN - WScl = 1 - ELSE - WScl = IntRng/REAL( VMax(3) - VMin(3) , SiKi ) - ENDIF - - - UOff = IntMin - UScl*REAL( VMin(1) , SiKi ) - VOff = IntMin - VScl*REAL( VMin(2) , SiKi ) - WOff = IntMin - WScl*REAL( VMin(3) , SiKi ) - - - ! Find the first tower point - - NumGrid = SIZE(p%grid%GridPtIndx) !p%grid%NumGrid_Y*p%grid%NumGrid_Z - - IF ( p%WrFile(FileExt_TWR) ) THEN - - NumTower = SIZE(p%grid%TwrPtIndx) - - ELSE - - NumTower = 0 - - ENDIF - - - LenDesc = LEN_TRIM( p%DescStr ) ! Length of the string that contains program name, version, date, and time - - CALL WrScr ( ' Generating AeroDyn binary time-series file "'//TRIM( p%RootName )//'.bts"' ) - - CALL GetNewUnit(UAFFW, ErrStat, ErrMsg) - CALL OpenBOutFile ( UAFFW, TRIM(p%RootName)//'.bts', ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN - - - - ! Write the header - - WRITE (UAFFW) INT( FileID , B2Ki ) ! TurbSim format (7=not PERIODIC, 8=PERIODIC) - - WRITE (UAFFW) INT( p%grid%NumGrid_Z , B4Ki ) ! the number of grid points vertically - WRITE (UAFFW) INT( p%grid%NumGrid_Y , B4Ki ) ! the number of grid points laterally - WRITE (UAFFW) INT( NumTower , B4Ki ) ! the number of tower points - WRITE (UAFFW) INT( p%grid%NumOutSteps , B4Ki ) ! the number of time steps - - WRITE (UAFFW) REAL( p%grid%GridRes_Z , SiKi ) ! grid spacing in vertical direction, in m - WRITE (UAFFW) REAL( p%grid%GridRes_Y , SiKi ) ! grid spacing in lateral direction, in m - WRITE (UAFFW) REAL( p%grid%TimeStep , SiKi ) ! grid spacing in delta time, in m/s - WRITE (UAFFW) REAL( p%UHub , SiKi ) ! the mean wind speed in m/s at hub height - WRITE (UAFFW) REAL( p%grid%HubHt , SiKi ) ! the hub height, in m - WRITE (UAFFW) REAL( p%grid%Zbottom , SiKi ) ! the height of the grid bottom, in m - - WRITE (UAFFW) REAL( UScl , SiKi ) ! the U-component slope for scaling - WRITE (UAFFW) REAL( UOff , SiKi ) ! the U-component offset for scaling - WRITE (UAFFW) REAL( VScl , SiKi ) ! the V-component slope for scaling - WRITE (UAFFW) REAL( VOff , SiKi ) ! the V-component offset for scaling - WRITE (UAFFW) REAL( WScl , SiKi ) ! the W-component slope for scaling - WRITE (UAFFW) REAL( WOff , SiKi ) ! the W-component offset for scaling - - WRITE (UAFFW) INT( LenDesc , B4Ki ) ! the number of characters in the string, max 200 - - DO II=1,LenDesc - - WRITE (UAFFW) INT( IACHAR( p%DescStr(II:II) ), B1Ki ) ! converted ASCII characters - - ENDDO - - ALLOCATE ( TmpVarray( 3*(NumGrid + NumTower) ) , STAT=AllocStat ) - - IF ( AllocStat /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = 'WrBinTURBSIM:Error allocating memory for temporary wind speed array.' - RETURN - ENDIF - - ! Loop through time. - - DO IT=1,p%grid%NumOutSteps !Use only the number of timesteps requested originally - - ! Write out grid data in binary form. II = (IZ - 1)*NumGrid_Y + IY, IY varies most rapidly - - IP = 1 - - DO II=1,NumGrid - - TmpVarray(IP) = NINT( Max( Min( REAL(UScl*V(IT,p%grid%GridPtIndx(II),1) + UOff, SiKi), IntMax ),IntMin) , B2Ki ) - TmpVarray(IP+1) = NINT( Max( Min( REAL(VScl*V(IT,p%grid%GridPtIndx(II),2) + VOff, SiKi), IntMax ),IntMin) , B2Ki ) - TmpVarray(IP+2) = NINT( Max( Min( REAL(WScl*V(IT,p%grid%GridPtIndx(II),3) + Woff, SiKi), IntMax ),IntMin) , B2Ki ) - - IP = IP + 3 - ENDDO ! II - - - IF ( p%WrFile(FileExt_TWR) ) THEN - - ! Write out the tower data in binary form - - DO II=1,SIZE(p%grid%TwrPtIndx) - ! Values of tower data - TmpVarray(IP) = NINT( Max( Min( REAL(UScl*V(IT,p%grid%TwrPtIndx(II),1) + UOff, SiKi), IntMax ),IntMin) , B2Ki ) - TmpVarray(IP+1) = NINT( Max( Min( REAL(VScl*V(IT,p%grid%TwrPtIndx(II),2) + VOff, SiKi), IntMax ),IntMin) , B2Ki ) - TmpVarray(IP+2) = NINT( Max( Min( REAL(WScl*V(IT,p%grid%TwrPtIndx(II),3) + Woff, SiKi), IntMax ),IntMin) , B2Ki ) - - IP = IP + 3 - ENDDO ! II - - ENDIF - - WRITE ( UAFFW ) TmpVarray(:) - ENDDO ! IT - - CLOSE ( UAFFW ) - - IF ( ALLOCATED( TmpVarray ) ) DEALLOCATE( TmpVarray ) - - -END SUBROUTINE WrBinTURBSIM -!======================================================================= -SUBROUTINE WrFormattedFF(RootName, p_grid, UHub, V ) - - IMPLICIT NONE - - CHARACTER(*), intent(in ) :: RootName ! Rootname of output file - TYPE(Grid_ParameterType), INTENT(IN) :: p_grid - REAL(ReKi), INTENT(IN) :: UHub ! The steady hub-height velocity - REAL(ReKi), INTENT(IN) :: V (:,:,:) ! The Velocities to write to a file - - - -REAL(ReKi), ALLOCATABLE :: ZRow (:) ! The horizontal locations of the grid points (NumGrid_Y) at each height. - -INTEGER :: II -INTEGER :: IT -INTEGER :: IVec -INTEGER :: IY -INTEGER :: IZ - -CHARACTER(200) :: FormStr5 ! String used to store format specifiers. - -INTEGER :: UFFF ! I/O unit for formatted FF data. -INTEGER(IntKi) :: ErrStat -CHARACTER(ErrMsgLen) :: ErrMsg - - FormStr5 = "(1X,"//trim(num2lstr(max(p_grid%NumGrid_Z,p_grid%NumGrid_Y)))//"(F8.3),:)" - - ! Allocate the array of wind speeds. - - - CALL GetNewUnit(UFFF) - - DO IVec=1,3 - - CALL WrScr ( ' Generating full-field formatted file "'//TRIM(RootName)//'.'//Comp(IVec)//'".' ) - CALL OpenFOutFile ( UFFF, TRIM( RootName )//'.'//Comp(IVec), ErrStat, ErrMsg ) - IF (ErrStat /= ErrID_None) then - call WrScr(Trim(ErrMsg)) - if (ErrStat >= AbortErrLev) cycle - end if - - - ! Create file header. - - WRITE (UFFF,"( / 'This full-field turbulence file was generated by ' , A , ' on ' , A , ' at ' , A , '.' / )" ) TRIM(GetNVD(TurbSim_Ver)), CurDate(), CurTime() - - WRITE (UFFF,"( ' | ', A,'-comp | Y x Z | Grid Resolution (Y x Z) | Time-step | Hub Elev | Mean U |')") Comp(IVec) - - WRITE (UFFF,"(I14,I6,F11.3,F11.3,F15.3,F11.2,F10.2)") p_grid%NumGrid_Y, p_grid%NumGrid_Z, p_grid%GridRes_Y, p_grid%GridRes_Z, p_grid%TimeStep, p_grid%HubHt, UHub - WRITE (UFFF,"(/,' Z Coordinates (m):')") - WRITE (UFFF,FormStr5) ( p_grid%Z(p_grid%GridPtIndx(IZ))-p_grid%HubHt, IZ=1,p_grid%NPoints,p_grid%NumGrid_Y ) - WRITE (UFFF,"(/,' Y Coordinates (m):')") - WRITE (UFFF,FormStr5) ( p_grid%Y(p_grid%GridPtIndx(IY)), IY=1,p_grid%NumGrid_Y ) - - ! Write out elapsed time & hub-level value before component grid. - - DO IT=1,p_grid%NumOutSteps - - WRITE(UFFF,"(/,1X,2(F8.3))") p_grid%TimeStep*( IT - 1 ), V(IT,p_grid%HubIndx,IVec) - - DO IZ=1,p_grid%NumGrid_Z ! From the top to the bottom - - II = ( p_grid%NumGrid_Z - IZ )*p_grid%NumGrid_Y - - WRITE (UFFF,FormStr5) ( V(IT, p_grid%GridPtIndx(II+IY) ,IVec), IY=1,p_grid%NumGrid_Y ) ! From the left to the right - - ENDDO ! IZ - - ENDDO ! IT - - CLOSE ( UFFF ) - - ENDDO ! IVec - - ! Deallocate the array of wind speeds. - - IF ( ALLOCATED( ZRow ) ) DEALLOCATE( ZRow ) - -END SUBROUTINE WrFormattedFF -!======================================================================= - -SUBROUTINE WrSum_UserInput( p_met, p_usr, US ) - - - TYPE(Meteorology_ParameterType), INTENT(IN) :: p_met ! meteorology parameters for TurbSim - TYPE(UserTSSpec_ParameterType), INTENT(IN) :: p_usr ! user-defined parameters for TurbSim - - INTEGER, INTENT(IN) :: US - integer :: i - - - IF ( p_met%NumUSRz > 0 ) THEN - WRITE (US,"( // 'User-Defined Profiles:' / )") - - IF ( ALLOCATED( p_met%USR_L ) ) THEN - WRITE (US,"(A)") ' Height Wind Speed Horizontal Angle u Std. Dev. v Std. Dev. w Std. Dev. Length Scale' - WRITE (US,"(A)") ' (m) (m/s) (deg) (m/s) (m/s) (m/s) (m) ' - WRITE (US,"(A)") ' ------ ---------- ---------------- ----------- ----------- ----------- ------------' - - DO I=p_met%NumUSRz,1,-1 - WRITE (US,"( 1X,F7.2, 2X,F9.2,2X, 3X,F10.2,6X, 3(4X,F7.2,3X), 3X,F10.2 )") & - p_met%USR_Z(I), p_met%USR_U(I), p_met%USR_WindDir(I), & - p_met%USR_Sigma(I)*p_met%USR_StdScale(1), p_met%USR_Sigma(I)*p_met%USR_StdScale(2), & - p_met%USR_Sigma(I)*p_met%USR_StdScale(3), p_met%USR_L(I) - ENDDO - ELSE - WRITE (US,"(A)") ' Height Wind Speed Horizontal Angle' - WRITE (US,"(A)") ' (m) (m/s) (deg) ' - WRITE (US,"(A)") ' ------ ---------- ----------------' - - DO I=p_met%NumUSRz,1,-1 - WRITE (US,"( 1X,F7.2, 2X,F9.2,2X, 3X,F10.2)") p_met%USR_Z(I), p_met%USR_U(I), p_met%USR_WindDir(I) - ENDDO - ENDIF - - ENDIF - - IF ( p_usr%nPoints > 0 ) THEN - WRITE (US,"( // 'Profiles from User-Defined Time-Series Input:' / )") - - WRITE (US,"(A)") ' Height Wind Speed Horizontal Angle Vertical Angle' - WRITE (US,"(A)") ' (m) (m/s) (deg) (deg) ' - WRITE (US,"(A)") ' ------ ---------- ---------------- --------------' - - DO I=p_usr%nPoints,1,-1 - WRITE (US,"( 1X,F7.2, 2X,F9.2,2X, 3X,F10.2,10x,F10.2)") p_usr%pointzi(I), p_usr%meanU(I,1), p_usr%meanDir(I), p_usr%meanVAng(I) - END DO - - END IF - - -END SUBROUTINE WrSum_UserInput -!======================================================================= -SUBROUTINE WrSum_SpecModel(p, U, HWindDir, VWindDir, ErrStat, ErrMsg ) - - TYPE(TurbSim_ParameterType), INTENT(INout) :: p ! parameters for TurbSim !BJJ: FIX THIS!!! TODO: create equivalent plExp elsewhere - REAL(ReKi), INTENT(IN) :: HWindDir(:) ! profile of horizontal wind direction - REAL(ReKi), INTENT(IN) :: VWindDir(:) ! profile of vertical wind direction - REAL(ReKi), INTENT(IN) :: U (:) ! profile of steady wind speed - - INTEGER(IntKi), intent( out) :: ErrStat ! Error level - CHARACTER(*), intent( out) :: ErrMsg ! Message describing error - - - ! local variables: - - REAL(ReKi) :: HalfRotDiam ! Half of the rotor diameter - - - - REAL(ReKi) :: UTmp ! The best fit of observed peak Uh at het height vs jet height - REAL(ReKi) :: U_zb ! The velocity at the bottom of the rotor disk (for estimating log fit) - REAL(ReKi) :: U_zt ! The velocity at the top of the rotor disk (for estimating log fit) - - INTEGER :: iz, jz ! loop counter/indices of points - LOGICAL :: HubPr ! Flag to indicate if the hub height is to be printed separately in the summary file - - CHARACTER(200) :: FormStr ! String used to store format specifiers. - CHARACTER(*),PARAMETER :: FormStr1 = "(' ',A,' =' ,I9 ,A)" ! String used to store format specifiers. - CHARACTER(*),PARAMETER :: FormStr2 = "(' ',A,' = ',A)" ! String used to store format specifiers. - - - ! write to the summary file: - ErrStat = ErrID_None - ErrMsg = "" - - - WRITE (p%US,"( // 'Turbulence Simulation Scaling Parameter Summary:' / )") - WRITE (p%US, "(' Turbulence model used = ' , A )") TRIM(p%met%TMName) - - FormStr = "(' ',A,' =' ,F9.3,A)" - - - - ! Write out a parameter summary to the summary file. - -IF ( ( p%met%TurbModel_ID == SpecModel_IECKAI ) .OR. & - ( p%met%TurbModel_ID == SpecModel_IECVKM ) .OR. & - ( p%met%TurbModel_ID == SpecModel_MODVKM ) .OR. & - ( p%met%TurbModel_ID == SpecModel_API ) ) THEN ! ADDED BY YGUO on April 19, 2013 snow day!!! - - - IF ( p%IEC%NumTurbInp ) THEN - WRITE (p%US,FormStr2) "Turbulence characteristic ", "User-specified" - ELSE - WRITE (p%US,FormStr2) "Turbulence characteristic ", TRIM(p%IEC%IECTurbE)//p%IEC%IECTurbC - WRITE (p%US,FormStr2) "IEC turbulence type ", TRIM(p%IEC%IEC_WindDesc) - - IF ( p%IEC%IEC_WindType /= IEC_NTM ) THEN - WRITE (p%US,FormStr) "Reference wind speed average over 10 minutes ", p%IEC%Vref, " m/s" - WRITE (p%US,FormStr) "Annual wind speed average at hub height ", p%IEC%Vave, " m/s" - ENDIF - ENDIF - - WRITE (p%US,FormStr2) "IEC standard ", TRIM(p%IEC%IECeditionSTR) - - IF ( p%met%TurbModel_ID /= SpecModel_MODVKM ) THEN - ! Write out a parameter summary to the summary file. - - WRITE (p%US,FormStr) "Mean wind speed at hub height ", p%UHub, " m/s" - - IF (.NOT. p%IEC%NumTurbInp) THEN ! "A", "B", or "C" turbulence: - IF ( p%IEC%IECedition == 2 ) THEN - WRITE (p%US,FormStr) "Char value of turbulence intensity at 15 m/s ", 100.0*p%IEC%TurbInt15, "%" - WRITE (p%US,FormStr) "Standard deviation slope ", p%IEC%SigmaSlope, "" - ELSE - ! This is supposed to be the expected value of what is measured at a site. - ! We actually calculate the 90th percentile value to use in the code as the - ! "Characteristic Value". - WRITE (p%US,FormStr) "Expected value of turbulence intensity at 15 m/s", 100.0*p%IEC%TurbInt15, "%" - ENDIF - - ENDIF - - WRITE (p%US,FormStr) "Characteristic value of standard deviation ", p%IEC%SigmaIEC(1), " m/s" - WRITE (p%US,FormStr) "Turbulence scale ", p%IEC%Lambda(1), " m" - - IF ( p%met%TurbModel_ID == SpecModel_IECKAI ) THEN - WRITE (p%US,FormStr) "u-component integral scale ", p%IEC%IntegralScale(1), " m" - WRITE (p%US,FormStr) "Coherency scale ", p%IEC%LC, " m" - ELSEIF ( p%met%TurbModel_ID == SpecModel_IECVKM ) THEN - WRITE (p%US,FormStr) "Isotropic integral scale ", p%IEC%IntegralScale(1), " m" - ENDIF - - WRITE (p%US,FormStr) "Characteristic value of hub turbulence intensity", 100.0*p%IEC%TurbInt, "%" - - ELSE ! ModVKM -!bjj this is never set in TurbSim: WRITE (p%US,FormStr1) "Boundary layer depth ", NINT(h), " m" - WRITE (p%US,FormStr) "Site Latitude ", p%met%Latitude, " degs" - WRITE (p%US,FormStr) "Hub mean streamwise velocity ", p%UHub, " m/s" - WRITE (p%US,FormStr) "Hub local u* ", p%met%Ustar, " m/s" !BONNIE: is this LOCAL? of Disk-avg - WRITE (p%US,FormStr) "Target IEC Turbulence Intensity ", 100.0*p%IEC%TurbInt, "%" - WRITE (p%US,FormStr) "Target IEC u-component standard deviation ", p%IEC%SigmaIEC(1), " m/s" - WRITE (p%US,FormStr) "u-component integral scale ", p%IEC%Lambda(1), " m" - WRITE (p%US,FormStr) "v-component integral scale ", p%IEC%Lambda(2), " m" - WRITE (p%US,FormStr) "w-component integral scale ", p%IEC%Lambda(3), " m" - WRITE (p%US,FormStr) "Isotropic integral scale ", p%IEC%LC, " m" - ENDIF - WRITE (p%US,FormStr) "Gradient Richardson number ", 0.0, "" - -! p%met%Ustar = SigmaIEC/2.15 ! Value based on equating original Kaimal spectrum with IEC formulation - -ELSEIF ( p%met%TurbModel_ID == SpecModel_TIDAL ) THEN - WRITE (p%US,FormStr2) "Gradient Richardson number ", "N/A" - WRITE (p%US,FormStr) "Mean velocity at hub height ", p%UHub, " m/s" - -ELSE - - WRITE (p%US,FormStr) "Gradient Richardson number ", p%met%Rich_No, "" - WRITE (p%US,FormStr) "Monin-Obukhov (M-O) z/L parameter ", p%met%ZL, "" - - IF ( .not. EqualRealNos( p%met%ZL, 0.0_ReKi ) ) THEN - WRITE (p%US,FormStr) "Monin-Obukhov (M-O) length scale ", p%met%L, " m" - ELSE - WRITE (p%US,FormStr2) "Monin-Obukhov (M-O) length scale ", "Infinite" - ENDIF - WRITE (p%US,FormStr) "Mean wind speed at hub height ", p%UHub, " m/s" - -ENDIF ! TurbModel == 'IECKAI', 'IECVKM', or 'MODVKM' - - -HalfRotDiam = 0.5*p%grid%RotorDiameter -CALL getVelocity(p, p%UHub,p%grid%HubHt, p%grid%HubHt+HalfRotDiam, U_zt, ErrStat, ErrMsg) !Velocity at the top of rotor -CALL getVelocity(p, p%UHub,p%grid%HubHt, p%grid%HubHt-HalfRotDiam, U_zb, ErrStat, ErrMsg) !Velocity at the bottom of the rotor - -IF ( TRIM(p%met%WindProfileType) /= 'PL' .AND. TRIM(p%met%WindProfileType) /= 'IEC' ) THEN -!SELECT CASE ( TRIM(p%met%WindProfileType) ) -! CASE ('JET','LOG','H2L','USR','API', 'TS') !i.e., not PL or IEC - p%met%PLexp = LOG( U_zt/U_zb ) / LOG( (p%grid%HubHt+HalfRotDiam)/(p%grid%HubHt-HalfRotDiam) ) -!END SELECT -END IF - - -WRITE(p%US,'()') ! A BLANK LINE - -SELECT CASE ( TRIM(p%met%WindProfileType) ) - CASE ('JET') - UTmp = 0.0422*p%met%ZJetMax+10.1979 ! Best fit of observed peak Uh at jet height vs jet height - - WRITE (p%US,FormStr2) "Wind profile type ", "Low-level jet" - WRITE (p%US,FormStr) "Jet height ", p%met%ZJetMax, " m" - WRITE (p%US,FormStr) "Jet wind speed ", p%met%UJetMax, " m/s" - WRITE (p%US,FormStr) "Upper limit of observed jet wind speed ", UTmp, " m/s" - WRITE (p%US,FormStr) "Equivalent power law exponent across rotor disk ", p%met%PLexp, "" - - IF ( UTmp < p%met%UJetMax ) THEN - CALL SetErrStat( ErrID_Warn, 'The computed jet wind speed is larger than the ' & - //'maximum observed jet wind speed at this height.', ErrStat, ErrMsg, 'WrSum_SpecModel') - ENDIF - - CASE ('LOG') - WRITE (p%US,FormStr2) "Wind profile type ", "Logarithmic" - WRITE (p%US,FormStr) "Equivalent power law exponent across rotor disk ", p%met%PLexp, "" - - CASE ('H2L') - WRITE (p%US,FormStr2) "Velocity profile type ", "Logarithmic (H2L)" - WRITE (p%US,FormStr) "Equivalent power law exponent across rotor disk ", p%met%PLexp, "" - - CASE ('PL') - WRITE (p%US,FormStr2) "Wind profile type ", "Power law" - WRITE (p%US,FormStr) "Power law exponent ", p%met%PLExp, "" - - CASE ('USR') - WRITE (p%US,FormStr2) "Wind profile type ", "Linear interpolation of user-defined profile" - WRITE (p%US,FormStr) "Equivalent power law exponent across rotor disk ", p%met%PLexp, "" - - CASE ('TS') - WRITE (p%US,FormStr2) "Wind profile type ", "Linear interpolation of user-defined profile generated by time-series data" - WRITE (p%US,FormStr) "Equivalent power law exponent across rotor disk ", p%met%PLexp, "" - - CASE ('API') -!bjj : fix me:!!! - WRITE (p%US,FormStr2) "Wind profile type ", "API" - WRITE (p%US,FormStr) "Equivalent power law exponent across rotor disk ", p%met%PLexp, "" - - CASE DEFAULT - WRITE (p%US,FormStr2) "Wind profile type ", "Power law on rotor disk, logarithmic elsewhere" - WRITE (p%US,FormStr) "Power law exponent ", p%met%PLExp, "" - -END SELECT - -WRITE(p%US,FormStr) "Mean shear across rotor disk ", (U_zt-U_zb)/p%grid%RotorDiameter, " (m/s)/m" -WRITE(p%US,FormStr) "Assumed rotor diameter ", p%grid%RotorDiameter, " m" -WRITE(p%US,FormStr) "Surface roughness length ", p%met%Z0, " m" -WRITE(p%US,'()') ! A BLANK LINE -WRITE(p%US,FormStr ) "Nyquist frequency of turbulent wind field ", 0.5_ReKi / p%grid%TimeStep," Hz" -WRITE(p%US,'()') ! A BLANK LINE -WRITE(p%US,FormStr1) "Number of time steps in the FFT ", p%grid%NumSteps, "" -WRITE(p%US,FormStr1) "Number of time steps output ", p%grid%NumOutSteps, "" -WRITE(p%US,FormStr1) "Number of points simulated ", p%grid%NPoints, "" - - -IF (p%met%KHtest) THEN - WRITE(p%US,"(/'KH Billow Test Parameters:' / )") ! HEADER - WRITE(p%US,FormStr) "Gradient Richardson number ", p%met%Rich_No, "" - WRITE(p%US,FormStr) "Power law exponent ", p%met%PLexp, "" - WRITE(p%US,FormStr) "Length of coherent structures ", p%grid%UsableTime / 2.0, " s" - WRITE(p%US,FormStr) "Minimum coherent TKE ", 30.0, " (m/s)^2" -ENDIF - - - ! Write mean flow angles and wind speed profile to the summary file. - -WRITE(p%US,"(//,'Mean Flow Angles:',/)") - -FormStr = "(3X,A,F6.1,' degrees')" -WRITE(p%US,FormStr) 'Vertical =', p%met%VFlowAng -WRITE(p%US,FormStr) 'Horizontal =', p%met%HFlowAng - - -WRITE(p%US,"(/'Mean Wind Speed Profile:')") - -IF ( ALLOCATED( p%met%ZL_profile ) .AND. ALLOCATED( p%met%Ustar_profile ) ) THEN - WRITE(p%US,"(/,' Height Wind Speed Horizontal Angle Vertical Angle U-comp (X) V-comp (Y) W-comp (Z) z/L(z) u*(z)')") - WRITE(p%US,"( ' (m) (m/s) (degrees) (degrees) (m/s) (m/s) (m/s) (-) (m/s)')") - WRITE(p%US,"( ' ------ ---------- ---------------- -------------- ---------- ---------- ---------- ------ ------')") - - FormStr = '(1X,F8.1,1X,F11.2,2(5x,F11.2),4x,3(2X,F8.2,3X),2(1X,F8.3))' -ELSE - WRITE(p%US,"(/,' Height Wind Speed Horizontal Angle Vertical Angle U-comp (X) V-comp (Y) W-comp (Z)')") - WRITE(p%US,"( ' (m) (m/s) (degrees) (degrees) (m/s) (m/s) (m/s) ')") - WRITE(p%US,"( ' ------ ---------- ---------------- -------------- ---------- ---------- ----------')") - - FormStr = '(1X,F8.1,1X,F11.2,2(5x,F11.2),4x,3(2X,F8.2,3X))' -ENDIF - - - - ! Get the angles to rotate the wind components from streamwise orientation to the X-Y-Z grid at the Hub - -HubPr = .NOT. p%grid%HubOnGrid !If the hub height is not on the z-grid, print it, too. - - - ! Write out the grid points & the hub - -DO JZ = p%grid%NumGrid_Z,1, -1 - - IZ = p%grid%GridPtIndx( (JZ-1)*p%grid%NumGrid_Y+1 ) - - IF ( HubPr .AND. ( p%grid%Z(IZ) < p%grid%HubHt ) ) THEN - - CALL writeLine( p%grid%HubIndx ) - - HubPr = .FALSE. ! we've printed the hub values, so we don't need to check this anymore - ENDIF - - CALL writeLine( IZ ) - -ENDDO ! JZ - - ! Write out the tower points -DO JZ = 2, SIZE(p%grid%TwrPtIndx) - CALL writeLine( p%grid%TwrPtIndx(JZ) ) -ENDDO ! JZ - -!.................................................. -CONTAINS - SUBROUTINE writeLine(Indx) - - INTEGER(IntKi), INTENT(IN) :: Indx - - REAL(ReKi) :: CVFA ! Cosine of the vertical flow angle - REAL(ReKi) :: SVFA ! Sine of the vertical flow angle - REAL(ReKi) :: CHFA ! Cosine of the horizontal flow angle - REAL(ReKi) :: SHFA ! Sine of the horizontal flow angle - - CHFA = COS( HWindDir(Indx)*D2R ) - SHFA = SIN( HWindDir(Indx)*D2R ) - - CVFA = COS( VWindDir(Indx)*D2R ) - SVFA = SIN( VWindDir(Indx)*D2R ) - - - IF ( ALLOCATED( p%met%ZL_profile ) ) THEN - WRITE(p%US,FormStr) p%grid%Z(Indx), U(Indx), HWindDir(Indx), VWindDir(Indx), U(Indx)*CHFA*CVFA, U(Indx)*SHFA*CVFA, U(Indx)*SVFA, & - p%met%ZL_profile(Indx), p%met%Ustar_profile(Indx) - ELSE - WRITE(p%US,FormStr) p%grid%Z(Indx), U(Indx), HWindDir(Indx), VWindDir(Indx), U(Indx)*CHFA*CVFA, U(Indx)*SHFA*CVFA, U(Indx)*SVFA - ENDIF - END SUBROUTINE writeLine - -END SUBROUTINE WrSum_SpecModel -!======================================================================= -SUBROUTINE WrHH_ADtxtfile(p, V, TurbInt, ErrStat, ErrMsg) - - TYPE(TurbSim_ParameterType), INTENT(IN) :: p !< parameters - REAL(ReKi), INTENT(IN) :: V (:,:,:) !< An array containing the summations of the rows of H (NumSteps,NPoints,3). - REAL(ReKi), INTENT(IN) :: TurbInt !< IEC target Turbulence Intensity - INTEGER(IntKi), intent( out) :: ErrStat !< Error level - CHARACTER(*), intent( out) :: ErrMsg !< Message describing error - - - REAL(ReKi) :: V_Inertial(3) ! U,V,W components (inertial) - REAL(ReKi) :: UH ! horizontal wind speed (U+V components) - - REAL(ReKi) :: Time ! The instantaneous Time (s) - INTEGER(IntKi) :: IT ! loop counter (time step) - INTEGER :: UAHH ! I/O unit for AeroDyn HH data (*.hh file). - - - - - CALL GetNewUnit( UAHH, ErrStat, ErrMsg) - CALL OpenFOutFile ( UAHH, TRIM( p%RootName)//'.hh', ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN - - CALL WrScr ( ' Hub-height AeroDyn data were written to "'//TRIM( p%RootName )//'.hh"' ) - - WRITE (UAHH,"( '! This hub-height wind-speed file was generated by ' , A , ' on ' , A , ' at ' , A , '.' )") TRIM(GetNVD(TurbSim_Ver)), CurDate(), CurTime() - WRITE (UAHH,"( '!' )") - WRITE (UAHH,"( '! The requested statistics for this data were:' )") - WRITE (UAHH,"( '! Mean Total Wind Speed = ' , F8.3 , ' m/s' )") p%UHub -IF ( p%met%TurbModel_ID == SpecModel_IECKAI .OR. p%met%TurbModel_ID == SpecModel_IECVKM .OR. p%met%TurbModel_ID == SpecModel_MODVKM ) THEN - WRITE (UAHH,"( '! Turbulence Intensity = ' , F8.3 , '%' )") 100.0*TurbInt -ELSE - WRITE (UAHH,"( '!' )") -ENDIF - WRITE (UAHH,"( '!' )") - WRITE (UAHH,"( '! Time HorSpd WndDir VerSpd HorShr VerShr LnVShr GstSpd' )") - WRITE (UAHH,"( '! (sec) (m/s) (deg) (m/s) (-) (-) (-) (m/s)' )") - - DO IT = 1, p%grid%NumOutSteps - - Time = p%grid%TimeStep*( IT - 1 ) - - CALL CalculateWindComponents(V(IT,p%grid%HubIndx,:), p%UHub, p%met%HH_HFlowAng, p%met%HH_VFlowAng, V_Inertial, UH) - - WRITE (UAHH,'(F8.3,3F8.2,3F8.3,F8.2)') Time, UH, -1.0*R2D*ATAN2( V_Inertial(2) , V_Inertial(1) ), & - V_Inertial(3), 0.0, p%met%PLExp, 0.0, 0.0 -!bjj: Should we output instantaneous horizontal shear, instead of 0? -! Should the power law exponent be an instantaneous value, too? -! - END DO - - CLOSE(UAHH) - - -END SUBROUTINE WrHH_ADtxtfile -!======================================================================= -SUBROUTINE WrHH_binary(p, V, ErrStat, ErrMsg) - - ! Output HH binary turbulence parameters for GenPro analysis. - ! Output order: Time,U,Uh,Ut,V,W,u',v',w',u'w',u'v',v'w',TKE,CTKE. - - - TYPE(TurbSim_ParameterType), INTENT(IN) :: p !< parameters - REAL(ReKi), INTENT(IN) :: V (:,:,:) !< 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 - - REAL(ReKi) :: V_Inertial(3) ! U,V,W components (inertial) - REAL(ReKi) :: UH ! horizontal wind speed (U+V components) - REAL(ReKi) :: UT ! total wind speed (U+V+W components) - REAL(ReKi) :: uv ! The instantaneous u'v' Reynolds stress at the hub - REAL(ReKi) :: uw ! The instantaneous u'w' Reynolds stress at the hub - REAL(ReKi) :: vw ! The instantaneous v'w' Reynolds stress at the hub - REAL(ReKi) :: TKE ! The instantaneous TKE at the hub - REAL(ReKi) :: CTKE ! The instantaneous CTKE the hub - - REAL(ReKi) :: Time ! The instantaneous Time (s) - INTEGER(IntKi) :: IT ! loop counter (time step) - INTEGER :: UGTP ! I/O unit for GenPro HH turbulence properties. - - - - CALL GetNewUnit(UGTP, ErrStat, ErrMsg) - - CALL OpenUOutfile ( UGTP , TRIM( p%RootName)//'.bin', ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN - - CALL WrScr ( ' Hub-height binary turbulence parameters were written to "'//TRIM( p%RootName )//'.bin"' ) - - DO IT = 1, p%grid%NumOutSteps - - Time = p%grid%TimeStep*( IT - 1 ) - - CALL CalculateWindComponents(V(IT,p%grid%HubIndx,:), p%UHub, p%met%HH_HFlowAng, p%met%HH_VFlowAng, V_Inertial, UH, UT) - CALL CalculateStresses( V(IT,p%grid%HubIndx,:), uv, uw, vw, TKE, CTKE ) - - WRITE (UGTP) REAL(Time,SiKi), REAL(V_Inertial(1),SiKi), REAL(UH,SiKi), REAL(UT,SiKi), & - REAL(V_Inertial(2),SiKi), REAL(V_Inertial(3),SiKi), & - REAL(V(IT,p%grid%HubIndx,1),SiKi), & - REAL(V(IT,p%grid%HubIndx,2),SiKi), & - REAL(V(IT,p%grid%HubIndx,3),SiKi), & - REAL(uw,SiKi), REAL(uv,SiKi), REAL(vw,SiKi), REAL(TKE,SiKi), REAL(CTKE,SiKi) - - END DO - - CLOSE(UGTP) -!p%WrFile(FileExt_BIN) - -END SUBROUTINE WrHH_binary -!======================================================================= -SUBROUTINE WrHH_text(p, V, ErrStat, ErrMsg) - - ! Output HH text turbulence parameters - ! Output order: Time,U,Uh,Ut,V,W,u',v',w',u'w',u'v',v'w',TKE,CTKE. - - TYPE(TurbSim_ParameterType), INTENT(IN) :: p !< parameters - REAL(ReKi), INTENT(IN) :: V (:,:,:) !< 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 - - REAL(ReKi) :: V_Inertial(3) ! U,V,W components (inertial) - REAL(ReKi) :: UH ! horizontal wind speed (U+V components) - REAL(ReKi) :: UT ! total wind speed (U+V+W components) - REAL(ReKi) :: uv ! The instantaneous u'v' Reynolds stress at the hub - REAL(ReKi) :: uw ! The instantaneous u'w' Reynolds stress at the hub - REAL(ReKi) :: vw ! The instantaneous v'w' Reynolds stress at the hub - REAL(ReKi) :: TKE ! The instantaneous TKE at the hub - REAL(ReKi) :: CTKE ! The instantaneous CTKE the hub - - REAL(ReKi) :: Time ! The instantaneous Time (s) - INTEGER(IntKi) :: IT ! loop counter (time step) - INTEGER(IntKi) :: UFTP ! I/O unit for formatted HH turbulence properties - - - ! p%WrFile(FileExt_DAT) - - CALL GetNewUnit( UFTP, ErrStat, ErrMsg ) - CALL OpenFOutFile ( UFTP, TRIM( p%RootName)//'.dat', ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN - - CALL WrScr ( ' Hub-height formatted turbulence parameters were written to "'//TRIM( p%RootName )//'.dat"' ) - - WRITE (UFTP,"( / 'This hub-height turbulence-parameter file was generated by ' , A , ' on ' , A , ' at ' , A , '.' / )") & - TRIM(GetNVD(TurbSim_Ver)), CurDate(), CurTime() - - WRITE (UFTP,"(' Time',6X,'U',7X,'Uh',7X,'Ut',8X,'V',8X,'W',8X,'u''',7X,'v''',7X,'w'''," & - //"6X,'u''w''',5X,'u''v''',5X,'v''w''',5X,'TKE',6X,'CTKE')") - - - DO IT = 1, p%grid%NumOutSteps - - Time = p%grid%TimeStep*( IT - 1 ) - - CALL CalculateWindComponents(V(IT,p%grid%HubIndx,:), p%UHub, p%met%HH_HFlowAng, p%met%HH_VFlowAng, V_Inertial, UH, UT) - CALL CalculateStresses( V(IT,p%grid%HubIndx,:), uv, uw, vw, TKE, CTKE ) - - - WRITE(UFTP,'(F7.2,13F9.3)') Time,V_Inertial(1),UH,UT,V_Inertial(2),V_Inertial(3), & - V(IT,p%grid%HubIndx,1), V(IT,p%grid%HubIndx,2), V(IT,p%grid%HubIndx,3), & - uw, uv, vw, TKE, CTKE - - - END DO - - CLOSE(UFTP) - -END SUBROUTINE WrHH_text -!======================================================================= -SUBROUTINE WrSum_Stats(p, V, USig, VSig, WSig, ErrStat, ErrMsg) - - -TYPE(TurbSim_ParameterType), INTENT(IN ) :: p ! parameters -REAL(ReKi), INTENT(IN ) :: V (:,:,:) ! An array containing the summations of the rows of H (NumSteps,NPoints,3). -REAL(ReKi), INTENT( OUT) :: USig ! Standard deviation of the u-component wind speed at the hub -REAL(ReKi), INTENT( OUT) :: VSig ! Standard deviation of the v-component wind speed at the hub -REAL(ReKi), INTENT( OUT) :: WSig ! Standard deviation of the w-component wind speed at the hub - -INTEGER(IntKi), intent( out) :: ErrStat ! Error level -CHARACTER(*), intent( out) :: ErrMsg ! Message describing error - - -REAL(DbKi) :: denom ! denominator of equation -REAL(DbKi) :: SumS ! Sum of the velocity-squared, used for calculating standard deviations in the summary file -REAL(DbKi) :: UBar ! The mean u-component wind speed at the hub -REAL(DbKi) :: UHBar ! The mean horizontal wind speed at the hub -REAL(DbKi) :: UHSum2 ! The sum of the squared horizontal wind speed at the hub -REAL(DbKi) :: UHTmp ! The instantaneous horizontal wind speed at the hub -REAL(DbKi) :: UHTmp2 ! The instantaneous squared horizontal wind speed at the hub -REAL(DbKi) :: USum2 ! The sum of the squared u-component wind speed at the hub -REAL(DbKi) :: UTBar ! The mean total wind speed at the hub -REAL(DbKi) :: UTmp ! The instantaneous u-component wind speed at the hub -REAL(DbKi) :: UTmp2 ! The instantaneous squared u-component wind speed at the hub -REAL(DbKi) :: UTSum2 ! The sum of the squared total wind speed at the hub -REAL(DbKi) :: UTTmp ! The instantaneous total wind speed at the hub -REAL(DbKi) :: UTTmp2 ! The instantaneous squared total wind speed at the hub -REAL(DbKi) :: UXBar ! The mean U-component (u rotated; x-direction) wind speed at the hub -REAL(DbKi) :: UXSum ! The sum of the U-component (u rotated) wind speed at the hub -REAL(DbKi) :: UXSum2 ! The sum of the squared U-component (u rotated) wind speed at the hub -REAL(DbKi) :: UXTmp ! The instantaneous U-component (u rotated) wind speed at the hub -REAL(DbKi) :: UXTmp2 ! The instantaneous squared U-component (u rotated) wind speed at the hub -REAL(DbKi) :: UYBar ! The mean V-component (v rotated; y-direction) wind speed at the hub -REAL(DbKi) :: UYSum ! The sum of the V-component (v rotated) wind speed at the hub -REAL(DbKi) :: UYSum2 ! The sum of the squared V-component (v rotated) wind speed at the hub -REAL(DbKi) :: UYTmp ! The instantaneous V-component (v rotated) wind speed at the hub -REAL(DbKi) :: UYTmp2 ! The instantaneous squared V-component (v rotated) wind speed at the hub -REAL(DbKi) :: UZBar ! The mean W-component (w rotated; z-direction) wind speed at the hub -REAL(DbKi) :: UZSum ! The sum of the W-component (w rotated) wind speed at the hub -REAL(DbKi) :: UZSum2 ! The sum of the squared W-component (w rotated) wind speed at the hub -REAL(DbKi) :: UZTmp ! The instantaneous W-component (w rotated) wind speed at the hub -REAL(DbKi) :: UZTmp2 ! The instantaneous squared W-component (w rotated) wind speed at the hub -REAL(DbKi) :: VBar ! The mean v-component wind speed at the hub -REAL(DbKi) :: VSum2 ! The sum of the squared v-component wind speed at the hub -REAL(DbKi) :: VTmp ! The instantaneous v-component wind speed at the hub -REAL(DbKi) :: VTmp2 ! The instantaneous squared v-component wind speed at the hub -REAL(DbKi) :: WBar ! The mean w-component wind speed at the hub -REAL(DbKi) :: WSum2 ! The sum of the squared w-component wind speed at the hub -REAL(DbKi) :: WTmp ! The instantaneous w-component wind speed at the hub -REAL(DbKi) :: WTmp2 ! The instantaneous squared w-component wind speed at the hub - -REAL(ReKi) :: CHFA ! Cosine of the Horizontal Flow Angle -REAL(ReKi) :: CVFA ! Cosine of the Vertical Flow Angle -REAL(ReKi) :: SVFA ! Sine of the Vertical Flow Angle -REAL(ReKi) :: SHFA ! Sine of the Horizontal Flow Angle -REAL(ReKi) :: CTKEmax ! Maximum instantaneous Coherent Turbulent Kenetic Energy at the hub -REAL(ReKi) :: TKEmax ! Maximum instantaneous Turbulent Kenetic Energy at the hub - - -REAL(ReKi) :: UHmax ! Maximum horizontal wind speed at the hub -REAL(ReKi) :: UHmin ! Minimum horizontal wind speed at the hub -REAL(ReKi) :: Umax ! Maximum u-component wind speed at the hub -REAL(ReKi) :: Umin ! Minimum u-component wind speed at the hub -REAL(ReKi) :: UTSig ! Standard deviation of the total wind speed at the hub -REAL(ReKi) :: UT_TI ! Turbulent Intensity of the total wind speed at the hub -REAL(ReKi) :: UTmax ! Maximum total wind speed at the hub -REAL(ReKi) :: UTmin ! Minimum total wind speed at the hub -REAL(ReKi) :: UVMax ! Maximum u'v' Reynolds Stress at the hub -REAL(ReKi) :: UVMin ! Minimum u'v' Reynolds Stress at the hub -REAL(ReKi) :: UVTmp ! The instantaneous u'v' Reynolds stress at the hub -REAL(ReKi) :: UV_RS ! The average u'v' Reynolds stress at the hub -REAL(ReKi) :: UVcor ! The u-v cross component correlation coefficient at the hub -REAL(ReKi) :: UVsum ! The sum of the u'v' Reynolds stress component at the hub -REAL(ReKi) :: UWMax ! Maximum u'w' Reynolds Stress at the hub -REAL(ReKi) :: UWMin ! Minimum u'w' Reynolds Stress at the hub -REAL(ReKi) :: UWTmp ! The instantaneous u'w' Reynolds stress at the hub -REAL(ReKi) :: UW_RS ! The average u'w' Reynolds stress at the hub -REAL(ReKi) :: UWcor ! The u-w cross component correlation coefficient at the hub -REAL(ReKi) :: UWsum ! The sum of the u'w' Reynolds stress component at the hub -REAL(ReKi) :: UXmax ! Maximum U-component (X-direction) wind speed at the hub -REAL(ReKi) :: UXmin ! Minimum U-component wind speed at the hub -REAL(ReKi) :: UXSig ! Standard deviation of the U-component wind speed at the hub -REAL(ReKi) :: UYmax ! Maximum V-component (Y-direction) wind speed at the hub -REAL(ReKi) :: UYmin ! Minimum V-component wind speed at the hub -REAL(ReKi) :: UYSig ! Standard deviation of the V-component wind speed at the hub -REAL(ReKi) :: UZmax ! Maximum W-component (Z-direction) wind speed at the hub -REAL(ReKi) :: UZmin ! Minimum W-component wind speed at the hub -REAL(ReKi) :: UZSig ! Standard deviation of the W-component wind speed at the hub -REAL(ReKi) :: U_TI ! The u-component turbulence intensity at the hub -REAL(ReKi) :: Vmax ! Maximum v-component wind speed at the hub -REAL(ReKi) :: Vmin ! Minimum v-component wind speed at the hub -REAL(ReKi) :: VWMax ! Maximum v'w' Reynolds Stress at the hub -REAL(ReKi) :: VWMin ! Minimum v'w' Reynolds Stress at the hub -REAL(ReKi) :: VWTmp ! The instantaneous v'w' Reynolds stress at the hub -REAL(ReKi) :: VW_RS ! The average v'w' Reynolds stress at the hub -REAL(ReKi) :: VWcor ! The v-w cross component correlation coefficient at the hub -REAL(ReKi) :: VWsum ! The sum of the v'w' Reynolds stress component at the hub -REAL(ReKi) :: V_TI ! The v-component turbulence intensity at the hub -REAL(ReKi) :: Wmax ! Maximum w-component wind speed at the hub -REAL(ReKi) :: Wmin ! Minimum w-component wind speed at the hub -REAL(ReKi) :: W_TI ! The w-component turbulence intensity at the hub - -REAL(ReKi) :: CTKE ! Coherent Turbulent Kenetic Energy at the hub -REAL(ReKi) :: TKE ! Turbulent Kenetic Energy at the hub -REAL(ReKi) :: INumSteps ! Multiplicative Inverse of the Number of time Steps -REAL(ReKi) :: UHSig ! Approximate sigma of the horizontal wind speed at the hub point -REAL(ReKi) :: SUstar ! Simulated U-star at the hub -REAL(ReKi), ALLOCATABLE :: SDary (:) ! The array of standard deviations (NumGrid_Z,NumGrid_Y). - -REAL(ReKi) :: UH_TI ! TI of the horizontal wind speed at the hub point - - -INTEGER(IntKi) :: IT, IVec, IY, IZ, II - - CHARACTER(200) :: FormStr ! String used to store format specifiers. - CHARACTER(*),PARAMETER :: FormStr2 = "(6X,A,' component: ',F8.3,' m/s')" ! String used to store format specifiers. - - - ! Initialize statistical quantities for hub-height turbulence parameters. - - CALL WrScr ( ' Computing hub-height statistics' ) - - INumSteps = 1.0/p%grid%NumSteps - - CTKEmax = -HUGE( CTKEmax ) - TKEmax = -HUGE( TKEmax ) - UBar = 0.0 - UHBar = 0.0 - UHmax = -HUGE( UHmax ) - UHmin = HUGE( UHmin ) - UHSum2 = 0.0 - Umax = -HUGE( Umax ) - Umin = HUGE( Umin ) - USum2 = 0.0 - UTBar = 0.0 - UTmax = -HUGE( UTmax ) - UTmin = HUGE( UTmin ) - UTSum2 = 0.0 - UV_RS = 0.0 - UVMax = V(1,p%grid%HubIndx,1)*V(1,p%grid%HubIndx,2) - UVMin = HUGE( UVMin ) - UVsum = 0.0 - UW_RS = 0.0 - UWMax = V(1,p%grid%HubIndx,1)*V(1,p%grid%HubIndx,3) - UWMin = HUGE( UWMin ) - UWsum = 0.0 - VBar = 0.0 - Vmax = -HUGE( Vmax ) - Vmin = HUGE( Vmin ) - VSum2 = 0.0 - VW_RS = 0.0 - VWMax = V(1,p%grid%HubIndx,2)*V(1,p%grid%HubIndx,3) - VWMin = HUGE( VWMin ) - VWsum = 0.0 - WBar = 0.0 - Wmax = -HUGE( Wmax ) - Wmin = HUGE( Wmin ) - WSum2 = 0.0 - UXBar = 0.0 - UXmax = -HUGE( UXmax ) - UXmin = HUGE( UXmin ) - UXSum = 0.0 - UXSum2 = 0.0 - UXTmp = 0.0 - UXTmp2 = 0.0 - UYBar = 0.0 - UYmax = -HUGE( UYmax ) - UYmin = HUGE( UYmin ) - UYSum = 0.0 - UYSum2 = 0.0 - UYTmp = 0.0 - UYTmp2 = 0.0 - UZBar = 0.0 - UZmax = -HUGE( UZmax ) - UZmin = HUGE( UZmin ) - UZSum = 0.0 - UZSum2 = 0.0 - UZTmp = 0.0 - UZTmp2 = 0.0 - - CHFA = COS( p%met%HH_HFlowAng*D2R ) - SHFA = SIN( p%met%HH_HFlowAng*D2R ) - - CVFA = COS( p%met%HH_VFlowAng*D2R ) - SVFA = SIN( p%met%HH_VFlowAng*D2R ) - - DO IT=1,p%grid%NumSteps - - ! Calculate longitudinal (UTmp), lateral (VTmp), and upward (WTmp) - ! values for hub station, as well as rotated (UXTmp, UYTmp, UZTmp) - ! components applying specified flow angles. - - ! Add mean wind speed to the streamwise component - UTmp = V(IT,p%grid%HubIndx,1) + p%UHub - VTmp = V(IT,p%grid%HubIndx,2) - WTmp = V(IT,p%grid%HubIndx,3) - - ! Rotate the wind components from streamwise orientation to the X-Y-Z grid at the Hub - UXTmp = UTmp*CHFA*CVFA - VTmp*SHFA - WTmp*CHFA*SVFA - UYTmp = UTmp*SHFA*CVFA + VTmp*CHFA - WTmp*SHFA*SVFA - UZTmp = UTmp*SVFA + WTmp*CVFA - - ! Calculate hub horizontal wind speed (UHTmp) and Total wind speed (UTTmp) - UTmp2 = UTmp*UTmp !flow coordinates - VTmp2 = VTmp*VTmp - WTmp2 = WTmp*WTmp - - UXTmp2 = UXTmp*UXTmp !inertial frame coordinates - UYTmp2 = UYTmp*UYTmp - UZTmp2 = UZTmp*UZTmp - - UHTmp2 = UXTmp2 + UYTmp2 !inertial frame coordinates - UTTmp2 = UHTmp2 + UZTmp2 - - UHTmp = SQRT( UHTmp2 ) !inertial frame coordinates - UTTmp = SQRT( UTTmp2 ) - - ! Form running sums for hub standard deviations - - UBar = UBar + UTmp !flow coordinates - VBar = VBar + VTmp !flow coordinates - WBar = WBar + WTmp !flow coordinates - - USum2 = USum2 + UTmp2 !flow coordinates - VSum2 = VSum2 + VTmp2 !flow coordinates - WSum2 = WSum2 + WTmp2 !flow coordinates - - UXBar = UXBar + UXTmp - UYBar = UYBar + UYTmp - UZBar = UZBar + UZTmp - - UXSum2 = UXSum2 + UXTmp2 - UYSum2 = UYSum2 + UYTmp2 - UZSum2 = UZSum2 + UZTmp2 - - UHBar = UHBar + UHTmp - UTBar = UTBar + UTTmp - - UHSum2 = UHSum2 + UHTmp2 - UTSum2 = UTSum2 + UTTmp2 - - - ! Determine hub extremes. - - IF ( UTmp > Umax ) Umax = UTmp !flow coordinates, - IF ( UTmp < Umin ) Umin = UTmp !flow coordinates, - - IF ( VTmp > Vmax ) Vmax = VTmp !flow coordinates, - IF ( VTmp < Vmin ) Vmin = VTmp !flow coordinates, - - IF ( WTmp > Wmax ) Wmax = WTmp !flow coordinates, - IF ( WTmp < Wmin ) Wmin = WTmp !flow coordinates, - - IF ( UXTmp > UXmax ) UXmax = UXTmp - IF ( UXTmp < UXmin ) UXmin = UXTmp - - IF ( UYTmp > UYmax ) UYmax = UYTmp - IF ( UYTmp < UYmin ) UYmin = UYTmp - - IF ( UZTmp > UZmax ) UZmax = UZTmp - IF ( UZTmp < UZmin ) UZmin = UZTmp - - IF ( UHTmp > UHmax ) UHmax = UHTmp - IF ( UHTmp < UHmin ) UHmin = UHTmp - - IF ( UTTmp > UTmax ) UTmax = UTTmp - IF ( UTTmp < UTmin ) UTmin = UTTmp - - ! Find maxes and mins of instantaneous hub Reynolds stresses u'w', u'v', and v'w' - - UVTmp = V(IT,p%grid%HubIndx,1)*V(IT,p%grid%HubIndx,2) - UWTmp = V(IT,p%grid%HubIndx,1)*V(IT,p%grid%HubIndx,3) - VWTmp = V(IT,p%grid%HubIndx,2)*V(IT,p%grid%HubIndx,3) - - IF ( UVTmp < UVMin ) THEN - UVMin = UVTmp - ELSEIF ( UVTmp > UVMax ) THEN - UVMax = UVTmp - ENDIF - - IF ( UWTmp < UWMin ) THEN - UWMin = UWTmp - ELSEIF ( UWTmp > UWMax ) THEN - UWMax = UWTmp - ENDIF - - IF ( VWTmp < VWMin ) THEN - VWMin = VWTmp - ELSEIF ( VWTmp > VWMax ) THEN - VWMax = VWTmp - ENDIF - - ! Find maximum of instantaneous TKE and CTKE. - - TKE = 0.5*(V(IT,p%grid%HubIndx,1)*V(IT,p%grid%HubIndx,1) + V(IT,p%grid%HubIndx,2)*V(IT,p%grid%HubIndx,2) + V(IT,p%grid%HubIndx,3)*V(IT,p%grid%HubIndx,3)) - CTKE = 0.5*SQRT(UVTmp*UVTmp + UWTmp*UWTmp + VWTmp*VWTmp) - - IF (CTKE > CTKEmax) CTKEmax = CTKE - IF ( TKE > TKEmax) TKEmax = TKE - - ! Find sums for mean and square Reynolds stresses for hub-level simulation. - UVsum = UVsum + UVTmp - UWsum = UWsum + UWTmp - VWsum = VWsum + VWTmp - - ENDDO ! IT - - - - ! Calculate mean hub-height Reynolds stresses. - UW_RS = UWsum*INumSteps - UV_RS = UVsum*INumSteps - VW_RS = VWsum*INumSteps - - ! Simulated Hub UStar. - SUstar = SQRT( ABS( UW_RS ) ) - - ! Calculate mean values for hub station. - - UBar = UBar*INumSteps - VBar = VBar*INumSteps - WBar = WBar*INumSteps - - UXBar = UXBar*INumSteps - UYBar = UYBar*INumSteps - UZBar = UZBar*INumSteps - - UHBar = UHBar*INumSteps - UTBar = UTBar*INumSteps - - - ! Calculate the standard deviations for hub station. - ! (SNWind/SNLwind-3D) NOTE: This algorithm is the approximate algorithm. - ! bjj: do the algebra and you'll find that it's std() using the 1/n definition - - USig = SQRT( MAX( USum2 *INumSteps-UBar *UBar , 0.0_DbKi ) ) - VSig = SQRT( MAX( VSum2 *INumSteps-VBar *VBar , 0.0_DbKi ) ) - WSig = SQRT( MAX( WSum2 *INumSteps-WBar *WBar , 0.0_DbKi ) ) - - UXSig = SQRT( MAX( UXSum2*INumSteps-UXBar*UXBar, 0.0_DbKi ) ) - UYSig = SQRT( MAX( UYSum2*INumSteps-UYBar*UYBar, 0.0_DbKi ) ) - UZSig = SQRT( MAX( UZSum2*INumSteps-UZBar*UZBar, 0.0_DbKi ) ) - - UHSig = SQRT( MAX( UHSum2*INumSteps-UHBar*UHBar, 0.0_DbKi ) ) - UTSig = SQRT( MAX( UTSum2*INumSteps-UTBar*UTBar, 0.0_DbKi ) ) - - - ! Calculate Cross-component correlation coefficients - denom = USig * WSig - if ( EqualRealNos( denom, 0.0_DbKi ) ) then - UWcor = 0.0 - else - UWcor = UW_RS / denom ! this definition assumes u' and w' have zero mean - end if - - denom = USig * VSig - if ( EqualRealNos( denom, 0.0_DbKi ) ) then - UVcor = 0.0 - else - UVcor = UV_RS / denom - end if - - denom = VSig * WSig - if ( EqualRealNos( denom, 0.0_DbKi ) ) then - VWcor = 0.0 - else - VWcor = VW_RS / denom - end if - - - ! Calculate turbulence intensities. - U_TI = USig/UBar - V_TI = VSig/UBar - W_TI = WSig/UBar - - UH_TI = UHSig/UHBar - UT_TI = UTSig/UTBar - - - ! Write out the hub-level stats to the summary file. - - CALL WrScr ( ' Writing statistics to summary file' ) - - WRITE(p%US,"(//,'Hub-Height Simulated Turbulence Statistical Summary:')") - WRITE(p%US,"(/,3X,'Type of Wind Min (m/s) Mean (m/s) Max (m/s) Sigma (m/s) TI (%)')") - WRITE(p%US,"( 3X,'---------------- --------- ---------- --------- ----------- ------')") - - FormStr = "(3X,A,F13.2,2F13.2,2F13.3)" - !bjj for analysis, extra precision: FormStr = "(3X,A,F13.2,2F13.2,2F13.6)" - - WRITE (p%US,FormStr) 'Longitudinal (u)', Umin, UBar, Umax, USig, 100.0* U_TI - WRITE (p%US,FormStr) 'Lateral (v) ', Vmin, VBar, Vmax, VSig, 100.0* V_TI - WRITE (p%US,FormStr) 'Vertical (w) ', Wmin, WBar, Wmax, WSig, 100.0* W_TI - WRITE (p%US,FormStr) 'U component ', UXmin, UXBar, UXmax, UXSig, 100.0*UXSig/UXBar - WRITE (p%US,FormStr) 'V component ', UYmin, UYBar, UYmax, UYSig, 100.0*UYSig/UXBar - WRITE (p%US,FormStr) 'W component ', UZmin, UZBar, UZmax, UZSig, 100.0*UZSig/UXBar - WRITE (p%US,FormStr) 'Horizontal (U&V)', UHmin, UHBar, UHmax, UHSig, 100.0*UH_TI - WRITE (p%US,FormStr) 'Total ', UTmin, UTBar, UTmax, UTSig, 100.0*UT_TI - - WRITE(p%US,"(/,3X,' Min Reynolds Mean Reynolds Max Reynolds Correlation')") - WRITE(p%US,"( 3X,'Product Stress (m/s)^2 Stress (m/s)^2 Stress (m/s)^2 Coefficient')") - WRITE(p%US,"( 3X,'---------------- -------------- -------------- -------------- -----------')") - - FormStr = "(3X,A,3(3X,F12.3,3X),F11.3)" - WRITE (p%US,FormStr) "u'w' ", UWMin, UW_RS, UWMax, UWcor - WRITE (p%US,FormStr) "u'v' ", UVMin, UV_RS, UVMax, UVcor - WRITE (p%US,FormStr) "v'w' ", VWMin, VW_RS, VWMax, VWcor - - FormStr = "(3X,A,' = ',F10.3,A)" - WRITE(p%US,"(/)") ! blank line - WRITE(p%US,FormStr) "Friction Velocity (Ustar) ", SUstar, " m/s" - WRITE(p%US,FormStr) "Maximum Instantaneous TKE ", TKEmax, " (m/s)^2" - WRITE(p%US,FormStr) "Maximum Instantaneous CTKE", CTKEmax, " (m/s)^2" - - ! Allocate the array of standard deviations. - - CALL AllocAry( SDary, p%grid%NumGrid_Y, 'SDary (standard deviations)', ErrStat, ErrMsg) - IF (ErrStat >= AbortErrLev) RETURN - - - ! Calculate standard deviations for each grid point. Write them to summary file. - - WRITE(p%US,"(//,'Grid Point Variance Summary:',/)") - WRITE(p%US,"(3X,'Y-coord',"//TRIM(Num2LStr(p%grid%NumGrid_Y))//"F8.2)") p%grid%Y( p%grid%GridPtIndx(1:p%grid%NumGrid_Y) ) - - - UTmp = 0 - VTmp = 0 - WTmp = 0 - - DO IVec=1,3 - - WRITE(p%US,"(/,3X,'Height Standard deviation at grid points for the ',A,' component:')") Comp(IVec) - - DO IZ=p%grid%NumGrid_Z,1,-1 - - DO IY=1,p%grid%NumGrid_Y - - II = (IZ-1)*p%grid%NumGrid_Y+IY - II = p%grid%GridPtIndx(II) - - SumS = 0.0 - - DO IT=1,p%grid%NumSteps - SumS = SumS + V(IT,II,IVec)**2 - ENDDO ! IT - - SDary(IY) = SQRT(SumS*INumSteps) ! Was: SDary(IZ,IY) = SQRT(SumS*INumSteps)/U(IZ,NumGrid/2) - - ENDDO ! IY - - WRITE(p%US,"(F9.2,1X,"//TRIM(Num2LStr(p%grid%NumGrid_Y))//"F8.3)") p%grid%Z( p%grid%GridPtIndx( (IZ-1)*p%grid%NumGrid_Y+1 ) ), SDary(1:p%grid%NumGrid_Y) - - IF ( IVec == 1 ) THEN - UTmp = UTmp + SUM( SDary ) - ELSEIF ( IVec == 2 ) THEN - VTmp = VTmp + SUM( SDary ) - ELSE - WTmp = WTmp + SUM( SDary ) - ENDIF - ENDDO ! IZ - - ENDDO ! Ivec - - - WRITE(p%US,"(/' Mean standard deviation across all grid points:')") - WRITE(p%US,FormStr2) Comp(1), UTmp / ( p%grid%NumGrid_Y*p%grid%NumGrid_Z ) - WRITE(p%US,FormStr2) Comp(2), VTmp / ( p%grid%NumGrid_Y*p%grid%NumGrid_Z ) - WRITE(p%US,FormStr2) Comp(3), WTmp / ( p%grid%NumGrid_Y*p%grid%NumGrid_Z ) - - - ! Deallocate the array of standard deviations. - - IF ( ALLOCATED( SDary ) ) DEALLOCATE( SDary ) - - - -END SUBROUTINE WrSum_Stats -!======================================================================= -!> Calculate the mean velocity and turbulence intensity of the U-component -!! of the interpolated hub point for comparison with InflowWind output. -SUBROUTINE WrSum_InterpolatedHubStats(p, V) - - ! passed variables: - TYPE(TurbSim_ParameterType), INTENT(IN) :: p !< TurbSim's parameters - REAL(ReKi), INTENT(INOUT) :: V(:,:,:) !< velocity, aligned along the streamwise direction without mean values added - - ! local variables: - REAL(DbKi) :: CGridSum ! The sums of the velocity components at the points surrounding the hub (or at the hub if it's on the grid) - REAL(DbKi) :: CGridSum2 ! The sums of the squared velocity components at the points surrouding the hub - - REAL(ReKi) :: TmpV ! Temporarily holds the value of the v component - REAL(ReKi) :: TmpY ! Temp variable for interpolated hub point - REAL(ReKi) :: TmpZ ! Temp variable for interpolated hub point - REAL(ReKi) :: Tmp_YL_Z ! Temp variable for interpolated hub point - REAL(ReKi) :: Tmp_YH_Z ! Temp variable for interpolated hub point - - REAL(ReKi) :: UGridMean ! Average wind speed at the points surrounding the hub - REAL(ReKi) :: UGridSig ! Standard deviation of the wind speed at the points surrounding the hub - REAL(ReKi) :: UGridTI ! Turbulent Intensity of the points surrounding the hub - - INTEGER :: ZHi_YHi ! Index for interpolation of hub point, if necessary - INTEGER :: ZHi_YLo ! Index for interpolation of hub point, if necessary - INTEGER :: ZLo_YHi ! Index for interpolation of hub point, if necessary - INTEGER :: ZLo_YLo ! Index for interpolation of hub point, if necessary - INTEGER :: IT ! Index for time step - - INTEGER :: IZ_Lo, IY_Lo ! Index for lower bound of box surrounding hub point - - - - ! Calculate mean value & turb intensity of U-component of the interpolated hub point (for comparison w/ AeroDyn output) - - ! Note that this uses the InflowWind interpolation scheme, which may be updated some day so that it doesn't - ! depend on which dimension we interpolate first. - - IY_Lo = INT( 0.5_ReKi * p%grid%GridWidth / p%grid%GridRes_Y ) + 1 - IZ_Lo = INT( ( p%grid%HubHt - p%grid%Zbottom ) / p%grid%GridRes_Z ) + 1 - - - ! Get points for bi-linear interpolation ( indx @ (iy,iz) is (iz-1)*numgrid_y + iy, assuming a full grid (needs to be modified for user-defined spectra) - ZLo_YLo = p%grid%GridPtIndx( ( IZ_Lo - 1 )*p%grid%NumGrid_Y + IY_Lo ) - ZHi_YLo = p%grid%GridPtIndx( ( IZ_Lo )*p%grid%NumGrid_Y + IY_Lo ) - ZLo_YHi = p%grid%GridPtIndx( ( IZ_Lo - 1 )*p%grid%NumGrid_Y + IY_Lo + 1 ) - ZHi_YHi = p%grid%GridPtIndx( ( IZ_Lo )*p%grid%NumGrid_Y + IY_Lo + 1 ) - - TmpZ = (p%grid%HubHt - p%grid%Z(p%grid%GridPtIndx((IZ_Lo-1)*p%grid%NumGrid_Y + 1)))/p%grid%GridRes_Z - TmpY = ( 0.0_ReKi - p%grid%Y(p%grid%GridPtIndx( IY_Lo )))/p%grid%GridRes_Y - CGridSum = 0.0 - CGridSum2 = 0.0 - - DO IT=1,p%grid%NumSteps - - ! Interpolate within the grid for this time step. - - Tmp_YL_Z = ( V( IT, ZHi_YLo, 1 ) - V( IT, ZLo_YLo, 1 ) )*TmpZ + V( IT, ZLo_YLo, 1 ) - Tmp_YH_Z = ( V( IT, ZHi_YHi, 1 ) - V( IT, ZLo_YHi, 1 ) )*TmpZ + V( IT, ZLo_YHi, 1 ) - TmpV = ( Tmp_YH_Z - Tmp_YL_Z )*TmpY + Tmp_YL_Z - - CGridSum = CGridSum + TmpV - CGridSum2 = CGridSum2 + TmpV*TmpV - ENDDO ! IT - - UGridMean = CGridSum/p%grid%NumSteps - UGridSig = SQRT( ABS( (CGridSum2/p%grid%NumSteps) - UGridMean*UGridMean ) ) - UGridTI = 100.0*UGridSig/UGridMean - - - ! Put the average statistics of the four center points in the summary file. - - WRITE(p%US,"(//,'U-component (X) statistics from the interpolated hub point:',/)") - WRITE(p%US,"(3X,A,' =',F9.4,A)") 'Mean' , UGridMean, ' m/s' - WRITE(p%US,"(3X,A,' =',F9.4,A)") 'TI ' , UGridTI , ' %' - - -END SUBROUTINE WrSum_InterpolatedHubStats -!======================================================================= -SUBROUTINE WrSum_EchoInputs(p ) - - ! passed variables: - TYPE(TurbSim_ParameterType), INTENT(IN) :: p !< TurbSim's parameters - - INTEGER :: I ! loop counter - CHARACTER(10) :: TmpStr ! temporary string used to write output to summary file - - - -!.................................................................................................................................. - WRITE (p%US,"( / 'Runtime Options:' / )") - WRITE (p%US,"( I10 , 2X , 'Random seed #1' )" ) p%RNG%RandSeed(1) - - IF (p%RNG%pRNG == pRNG_INTRINSIC) THEN - WRITE (p%US,"( I10 , 2X , 'Random seed #2' )" ) p%RNG%RandSeed(2) - ELSE - WRITE (p%US,"( 4X, A6, 2X, 'Type of random number generator' )" ) p%RNG%RNG_type - ENDIF - - WRITE (p%US,"( L10 , 2X , 'Output binary HH turbulence parameters?' )" ) p%WrFile(FileExt_BIN) - WRITE (p%US,"( L10 , 2X , 'Output formatted turbulence parameters?' )" ) p%WrFile(FileExt_DAT) - WRITE (p%US,"( L10 , 2X , 'Output AeroDyn HH files?' )" ) p%WrFile(FileExt_HH) - WRITE (p%US,"( L10 , 2X , 'Output AeroDyn FF files?' )" ) p%WrFile(FileExt_BTS) - WRITE (p%US,"( L10 , 2X , 'Output BLADED FF files?' )" ) p%WrFile(FileExt_WND) - WRITE (p%US,"( L10 , 2X , 'Output tower data?' )" ) p%WrFile(FileExt_TWR) - WRITE (p%US,"( L10 , 2X , 'Output formatted FF files?' )" ) p%WrFile(FileExt_UVW) - WRITE (p%US,"( L10 , 2X , 'Output coherent turbulence time step file?' )") p%WrFile(FileExt_CTS) - WRITE (p%US,"( L10 , 2X , 'Clockwise rotation when looking downwind?' )" ) p%grid%Clockwise - - SELECT CASE ( p%IEC%ScaleIEC ) - CASE (0) - TmpStr= "NONE" - CASE (1, -1) ! included the -1 for reading t/f on other systems - TmpStr = "HUB" - CASE (2) - TmpStr = "ALL" - ENDSELECT - - WRITE (p%US,"( I2, ' - ', A5, 2X , 'IEC turbulence models scaled to exact specified standard deviation' )") p%IEC%ScaleIEC, TRIM(TmpStr) - - -!.................................................................................................................................. - WRITE (p%US,"( // 'Turbine/Model Specifications:' / )") - WRITE (p%US,"( I10 , 2X , 'Vertical grid-point matrix dimension' )" ) p%grid%NumGrid_Z - WRITE (p%US,"( I10 , 2X , 'Horizontal grid-point matrix dimension' )") p%grid%NumGrid_Y - WRITE (p%US,"( F10.3 , 2X , 'Time step [seconds]' )" ) p%grid%TimeStep - WRITE (p%US,"( F10.3 , 2X , 'Analysis time [seconds]' )" ) p%grid%AnalysisTime - WRITE (p%US,"( F10.3 , 2X , 'Usable output time [seconds]' )" ) p%grid%UsableTime - WRITE (p%US,"( F10.3 , 2X , 'Hub height [m]' )" ) p%grid%HubHt - WRITE (p%US,"( F10.3 , 2X , 'Grid height [m]' )" ) p%grid%GridHeight - WRITE (p%US,"( F10.3 , 2X , 'Grid width [m]' )" ) p%grid%GridWidth - WRITE (p%US,"( F10.3 , 2X , 'Vertical flow angle [degrees]' )" ) p%met%VFlowAng - WRITE (p%US,"( F10.3 , 2X , 'Horizontal flow angle [degrees]' )" ) p%met%HFlowAng - - -!.................................................................................................................................. - WRITE (p%US,"( // 'Meteorological Boundary Conditions:' / )") - WRITE (p%US, "( 4X , A6 , 2X , '"//TRIM( p%met%TMName )//" spectral model' )") p%met%TurbModel - IF (p%IEC%IECstandard > 0) then - WRITE (p%US,"( 7X, I3, 2X, 'IEC standard: ', A )") p%IEC%IECstandard, TRIM(p%IEC%IECeditionSTR) - IF (p%IEC%NumTurbInp) THEN - WRITE (p%US,"( F10.3 , 2X , 'Percent turbulence intensity, ', A )") p%IEC%PerTurbInt, TRIM(p%IEC%IECeditionSTR) - ELSE - WRITE (p%US,"( 9X , A1 , 2X , 'IEC turbulence characteristic' )" ) p%IEC%IECTurbC - END IF - - SELECT CASE ( p%IEC%IEC_WindType ) - CASE (IEC_NTM) - TmpStr= "NTM" - CASE (IEC_ETM) - TmpStr = "ETM" - CASE (IEC_EWM1) - TmpStr = "EWM1" - CASE (IEC_EWM50) - TmpStr = "EWM50" - CASE (IEC_EWM100) - TmpStr = "EWM100" - ENDSELECT - - WRITE (p%US,"( 4X, A6 , 2X , 'IEC ', A )") TRIM(p%IEC%IECTurbE)//TRIM(TmpStr), TRIM(p%IEC%IEC_WindDesc) - - ELSE - WRITE (p%US,"( 7X, A3, 2X, 'IEC standard' )" ) 'N/A' - IF (p%met%KHtest) THEN - WRITE (p%US,"( 4X, A6, 2X, 'Kelvin-Helmholtz billow test case' )") 'KHTEST' - ELSE - WRITE (p%US,"( A10, 2X, 'IEC turbulence characteristic' )" ) 'N/A' - END IF - WRITE (p%US,"( A10 , 2X , 'IEC turbulence type' )" ) 'N/A' - - END IF - - IF ( p%IEC%IEC_WindType == IEC_ETM ) THEN - WRITE (p%US,"( F10.3, 2X, 'IEC Extreme Turbulence Model (ETM) ""c"" parameter [m/s]' )") p%IEC%ETMc - ELSE - WRITE (p%US,"( A10, 2X, 'IEC Extreme Turbulence Model (ETM) ""c"" parameter [m/s]' )") 'N/A' - END IF - - WRITE (p%US,"( A10 , 2X , 'Wind profile type' )" ) p%met%WindProfileType - WRITE (p%US,"( F10.3 , 2X , 'Reference height [m]' )" ) p%met%RefHt !BJJ: TODO: check if refht makes sense (or is used) for USR profile. - IF ( p%met%WindProfileType == 'USR' .OR. p%met%WindProfileType == 'TS' ) THEN - WRITE (p%US,"( A10, 2X, 'Reference wind speed [m/s]' )" ) 'N/A' - ELSE - WRITE (p%US,"( F10.3 , 2X , 'Reference wind speed [m/s]' )" ) p%met%URef - END IF - - - IF ( p%met%WindProfileType == 'JET' ) THEN - WRITE (p%US,"( F10.3, 2X, 'Jet height [m]' )" ) p%met%ZJetMax - ELSE - WRITE (p%US,"( A10, 2X, 'Jet height [m]' )" ) 'N/A' - END IF - - IF ( INDEX( 'JLUHAT', p%met%WindProfileType(1:1) ) > 0 ) THEN - WRITE (p%US,"( A10, 2X, 'Power law exponent' )" ) 'N/A' - ELSE - WRITE (p%US,"( F10.3 , 2X , 'Power law exponent' )" ) p%met%PLExp - END IF - - IF ( p%met%TurbModel_ID==SpecModel_TIDAL ) THEN - WRITE (p%US,"( A10, 2X, 'Surface roughness length [m]' )" ) 'N/A' - ELSE - WRITE (p%US,"( F10.3 , 2X , 'Surface roughness length [m]' )" ) p%met%Z0 - END IF - -!.................................................................................................................................. - -WRITE (p%US,"( // 'Non-IEC Meteorological Boundary Conditions:' / )") - - IF ( p%met%TurbModel_ID /= SpecModel_IECKAI .AND. p%met%TurbModel_ID /= SpecModel_IECVKM .AND. p%met%TurbModel_ID /= SpecModel_API ) THEN - WRITE (p%US,"( F10.3 , 2X , 'Site latitude [degrees]' )" ) p%met%Latitude - ELSE - WRITE (p%US,"( A10 , 2X , 'Site latitude [degrees]' )" ) 'N/A' - END IF - - - IF ( .NOT. p%met%IsIECModel .AND. p%met%TurbModel_ID /= SpecModel_TIDAL ) THEN - WRITE (p%US,"( F10.3 , 2X , 'Gradient Richardson number' )") p%met%Rich_No - ELSE - WRITE (p%US,"( a10 , 2X , 'Gradient Richardson number' )") 'N/A' - END IF - - IF ( .NOT. p%met%IsIECModel ) THEN - WRITE (p%US,"( F10.3 , 2X , 'Friction or shear velocity [m/s]' )") p%met%Ustar - - IF (p%met%ZL>=0. .AND. p%met%TurbModel_ID /= SpecModel_GP_LLJ) THEN - WRITE (p%US,'( A10 , 2X , "Mixing layer depth [m]" )' ) 'N/A' - ELSE - WRITE (p%US,"( F10.3 , 2X , 'Mixing layer depth [m]' )" ) p%met%ZI - END IF - - ELSE - WRITE (p%US,'( A10 , 2X , "Friction or shear velocity [m/s]" )') 'N/A' - WRITE (p%US,'( A10 , 2X , "Mixing layer depth [m]" )' ) 'N/A' - END IF - - IF (.NOT. p%met%UWskip) THEN - WRITE (p%US,'( F10.3 , 2X , "Mean hub u''w'' Reynolds stress" )' ) p%met%PC_UW - ELSE - WRITE (p%US,'( A10 , 2X , "Mean hub u''w'' Reynolds stress" )' ) 'N/A' - END IF - - IF (.NOT. p%met%UVskip) THEN - WRITE (p%US,'( F10.3 , 2X , "Mean hub u''v'' Reynolds stress" )' ) p%met%PC_UV - ELSE - WRITE (p%US,'( A10 , 2X , "Mean hub u''v'' Reynolds stress" )' ) 'N/A' - END IF - - IF (.NOT. p%met%VWskip) THEN - WRITE (p%US,'( F10.3 , 2X , "Mean hub v''w'' Reynolds stress" )' ) p%met%PC_VW - ELSE - WRITE (p%US,'( A10 , 2X , "Mean hub v''w'' Reynolds stress" )' ) 'N/A' - END IF - -!.................................................................................................................................. - -WRITE (p%US,"( // 'Spatial Coherence Models:' / )") - - do i=1,3 - SELECT CASE (p%met%SCMod(i)) - CASE (CohMod_GENERAL) - TmpStr = "GENERAL" - CASE (CohMod_IEC) - TmpStr = "IEC" - CASE (CohMod_NONE) - TmpStr = "NONE" - CASE (CohMod_API) - TmpStr = "API" - END SELECT - WRITE (p%US,'( A10 , 2X , A, "-component coherence model" )' ) TRIM(TmpStr), Comp(i) - end do - - do i=1,3 - IF ( p%met%SCMod(i) == CohMod_General .OR. p%met%SCMod(i) == CohMod_IEC ) THEN - WRITE (p%US,"( '(',F9.3,',',G10.3,')',2X , A,'-component coherence parameters' )") p%met%InCDec(i), p%met%InCohB(i), Comp(i) - ELSE - WRITE (p%US,"( A22,2X , A,'-component coherence parameters' )") 'N/A', Comp(i) - END IF - end do - - IF ( ANY(p%met%SCMod == CohMod_General) ) THEN - WRITE (p%US,'( F10.3 , 2X , "Coherence exponent" )' ) p%met%CohExp - ELSE - WRITE (p%US,'( A10 , 2X , "Coherence exponent" )' ) 'N/A' - END IF - - -!.................................................................................................................................. -!*** -IF ( .NOT. p%WrFile(FileExt_CTS) .OR. p%met%IsIECModel ) RETURN -!*** - WRITE (p%US,"( // 'Coherent Turbulence Scaling Parameters:' / )") - - - IF ( LEN( TRIM(p%CohStr%CTEventPath) ) <= 10 ) THEN - WRITE (p%US,"( A10 , 2X , 'Name of the path containing the coherent turbulence data files' )") TRIM(p%CohStr%CTEventPath) - ELSE - WRITE (p%US,"( A, /, 12X , 'Name of the path containing the coherent turbulence data files' )") TRIM(p%CohStr%CTEventPath) - ENDIF - WRITE (p%US,"( 7X, A3, 2X, 'Type of coherent turbulence data files' )") TRIM(p%CohStr%CText) -! WRITE (p%US,"( L10 , 2X , 'Randomize the disturbance scale and location?' )") Randomize - WRITE (p%US,"( F10.3 , 2X , 'Disturbance scale (ratio of wave height to rotor diameter)' )") p%CohStr%DistScl - WRITE (p%US,"( F10.3 , 2X , 'Fractional location of tower centerline from right' )") p%CohStr%CTLy - WRITE (p%US,"( F10.3 , 2X , 'Fractional location of hub height from the bottom of the dataset' )") p%CohStr%CTLz - WRITE (p%US,"( F10.3 , 2X , 'Minimum start time for coherent structures [seconds]' )") p%CohStr%CTStartTime - -!.................................................................................................................................. - -END SUBROUTINE WrSum_EchoInputs -!======================================================================= -!> This subroutine processes the user input from the IECstandard line -!! and splits it into the standard and edition being used -SUBROUTINE ProcessLine_IECstandard(Line, IsIECModel, TurbModel_ID, IECstandard, IECedition, IECeditionStr, ErrStat, ErrMsg ) - - CHARACTER(*), INTENT(INOUT) :: Line !< on entry, the line from the input file. may be modified in this routine - LOGICAL, INTENT(IN ) :: IsIECModel !< Flag to indicate if this is an IEC model - INTEGER(IntKi), INTENT(IN ) :: TurbModel_ID !< Turbulence model identifier - INTEGER(IntKi), INTENT( OUT) :: IECedition !< IEC edition - INTEGER(IntKi), INTENT( OUT) :: IECstandard !< IEC standard - CHARACTER(*), INTENT( OUT) :: IECeditionStr !< string describing the IEC standard/edition being used - - INTEGER(IntKi), intent( out) :: ErrStat !< Error level - CHARACTER(*), intent( out) :: ErrMsg !< Message describing error - - INTEGER(IntKi) :: IOS ! local error code - INTEGER(IntKi) :: TmpIndex ! index into string - CHARACTER(*), PARAMETER :: IECstandardErrMsg = 'The IECstandard input parameter must be either "1", "2", or "3"' & - // ' with an optional IEC 61400-1 edition number ("1-ED2"). If specified, the edition number must be "2" or "3".' - - CHARACTER( 23), PARAMETER :: IECeditionStr_p (3) = & ! strings for the - (/'IEC 61400-1 Ed. 1: 1993', & - 'IEC 61400-1 Ed. 2: 1999', & - 'IEC 61400-1 Ed. 3: 2005'/) ! The string description of the IEC 61400-1 standard being used - - - - ErrStat = ErrID_None - ErrMsg = "" - - IF ( .NOT. IsIECModel ) THEN !bjj: SpecModel==SpecModel_MODVKM is not in the IEC standard - IECstandard = 0 - IECedition = 0 - IECeditionStr = "" - RETURN - ENDIF ! IEC - - - ! Did the line contain "T" or "F", which could be interpreted by Fortran as a number? - CALL Conv2UC( LINE ) - IF ( (Line(1:1) == 'T') .OR. (Line(1:1) == 'F') ) THEN - CALL SetErrStat(ErrID_Fatal, IECstandardErrMsg, ErrStat, ErrMsg, 'ProcessLine_IECstandard') - RETURN - ENDIF - - - ! Did the user enter an edition number? - TmpIndex = INDEX(Line, "-ED") - IF ( TmpIndex > 0 ) THEN - READ ( Line(TmpIndex+3:),*,IOSTAT=IOS ) IECedition - - IF (IOS /= 0) THEN - CALL SetErrStat(ErrID_Fatal, IECstandardErrMsg, ErrStat, ErrMsg, 'ProcessLine_IECstandard') - RETURN - END IF - - IF ( IECedition < 1 .OR. IECedition > 3 ) THEN - CALL SetErrStat(ErrID_Fatal, IECstandardErrMsg, ErrStat, ErrMsg, 'ProcessLine_IECstandard') - RETURN - ENDIF - - Line = Line(1:TmpIndex-1) - ELSE - IECedition = 0 - ENDIF - - ! What standard did the user enter? - READ ( Line,*,IOSTAT=IOS ) IECstandard - - SELECT CASE ( IECstandard ) - - CASE ( 1 ) ! use the IEC 64100-1 standard, either edition 2 or 3 - IF (IECedition < 1 ) THEN ! Set up the default - IF ( TurbModel_ID == SpecModel_IECVKM .OR. TurbModel_ID == SpecModel_USRVKM ) THEN - IECedition = 2 ! The von Karman model is not specified in edition 3 of the -1 standard - ELSE - IECedition = 3 - ENDIF - ELSE - IF ( IECedition < 2 ) THEN - CALL SetErrStat(ErrID_Fatal, IECstandardErrMsg, ErrStat, ErrMsg, 'ProcessLine_IECstandard') - RETURN - ENDIF - ENDIF - IECeditionSTR = IECeditionStr_p(IECedition) - - CASE ( 2 ) ! use the IEC 64100-2 (small turbine) standard, which the same as 64100-1, Ed. 2 with "A" or user-specified turbulence - IF (IECedition < 1 ) THEN ! Set up the default - IECedition = 2 ! This is the edition of the -1 standard - ELSE - CALL SetErrStat(ErrID_Fatal, IECstandardErrMsg//' The edition number cannot be specified for the 61400-2 standard.', ErrStat, ErrMsg, 'ProcessLine_IECstandard') - RETURN - ENDIF - IECeditionSTR = 'IEC 61400-2 Ed. 2: 2005' - - CASE ( 3 ) ! Use the IEC 61400-3 (Offshore) standard, which is the same as 61400-1 except it has a different power law exponent - IF (IECedition < 1 ) THEN ! Set up the default - - IF ( TurbModel_ID /= SpecModel_IECKAI ) THEN - CALL SetErrStat(ErrID_Fatal, ' The Kaimal model (IECKAI) is the only turbulence model valid for the 61400-3 standard.', ErrStat, ErrMsg, 'ProcessLine_IECstandard') - RETURN - ENDIF - IECedition = 3 ! This is the edition of the -1 standard - - ELSE - CALL SetErrStat(ErrID_Fatal, IECstandardErrMsg//' The edition number cannot be specified for the 61400-3 standard.', ErrStat, ErrMsg, 'ProcessLine_IECstandard') - RETURN - ENDIF - IECeditionSTR = 'IEC 61400-3 Ed. 1: 2006' - - CASE DEFAULT - CALL SetErrStat(ErrID_Fatal, IECstandardErrMsg, ErrStat, ErrMsg, 'ProcessLine_IECstandard') - RETURN - - END SELECT -END SUBROUTINE ProcessLine_IECstandard -!======================================================================= -!> This subroutine processes the user input from the IECturbc line -!! and splits it into the NumTurbInp, IECTurbC, and KHtest variables. -SUBROUTINE ProcessLine_IECturbc(Line, IsIECModel, IECstandard, IECedition, IECeditionStr, NumTurbInp, IECTurbC, PerTurbInt, KHtest, ErrStat, ErrMsg) - REAL(ReKi) , INTENT( OUT) :: PerTurbInt !< Percent Turbulence Intensity - - INTEGER(IntKi), INTENT(IN ) :: IECedition !< IEC edition - INTEGER(IntKi), INTENT(IN ) :: IECstandard !< IEC standard - - LOGICAL, INTENT(IN ) :: IsIECModel !< Flag to indicate if this is an IEC model - LOGICAL, INTENT( OUT) :: NumTurbInp !< Flag to indicate if turbulence is user-specified (as opposed to IEC standard A, B, or C) - LOGICAL, INTENT( OUT) :: KHtest !< Flag to indicate that turbulence should be extreme, to demonstrate effect of KH billows - - CHARACTER(*), INTENT(IN ) :: IECeditionStr !< string describing the IEC standard/edition being used - CHARACTER(1), INTENT( OUT) :: IECTurbC !< IEC turbulence characteristic - CHARACTER(*), INTENT(INOUT) :: Line !< on entry, the line from the input file. may be modified in this routine - - !INTEGER(IntKi), INTENT(IN ) :: TurbModel_ID !< Turbulence model identifier - - INTEGER(IntKi), intent( out) :: ErrStat !< Error level - CHARACTER(*), intent( out) :: ErrMsg !< Message describing error - - INTEGER(IntKi) :: IOS ! local error code - CHARACTER(*), PARAMETER :: IECstandardErrMsg = 'The IECstandard input parameter must be either "1", "2", or "3"' & - // ' with an optional IEC 61400-1 edition number ("1-ED2"). If specified, the edition number must be "2" or "3".' - - ErrStat = ErrID_None - ErrMsg = "" - - IF ( IsIECModel ) THEN - KHtest = .FALSE. - - READ (Line,*,IOSTAT=IOS) IECTurbC - - CALL Conv2UC( IECTurbC ) - - IF ( (IECTurbC == 'T') .OR. (IECTurbC == 'F') ) THEN - CALL SetErrStat( ErrID_Fatal, 'The IEC turbulence characteristic must be either "A", "B", "C", or a real number.', ErrStat, ErrMsg, 'ProcessLine_IECturbc') - RETURN - ENDIF - - ! Check to see if the entry was a number. - - READ (Line,*,IOSTAT=IOS) PerTurbInt - - IF ( IOS == 0 ) THEN - - ! Let's use turbulence value. - - NumTurbInp = .TRUE. - IECTurbC = "" - - ELSE - - ! Let's use one of the standard turbulence values (A or B or C). - - NumTurbInp = .FALSE. - PerTurbInt = 0.0 ! will be set later if necessary - - IECTurbC = ADJUSTL( Line ) - CALL Conv2UC( IECTurbC ) - SELECT CASE ( IECTurbC ) - CASE ( 'A' ) - CASE ( 'B' ) - IF ( IECstandard == 2 ) THEN - CALL SetErrStat( ErrID_Fatal, 'The IEC 61400-2 turbulence characteristic must be either "A" or a real number.', ErrStat, ErrMsg, 'ProcessLine_IECturbc') - ENDIF - CASE ( 'C' ) - IF ( IECstandard == 2 ) THEN - CALL SetErrStat( ErrID_Fatal, 'The IEC 61400-2 turbulence characteristic must be either "A" or a real number.', ErrStat, ErrMsg, 'ProcessLine_IECturbc') - ELSEIF ( IECedition < 3 ) THEN - CALL SetErrStat( ErrID_Fatal, 'The turbulence characteristic for '//TRIM(IECeditionSTR )// & - ' must be either "A", "B", or a real number.', ErrStat, ErrMsg, 'ProcessLine_IECturbc') - ENDIF - CASE DEFAULT - CALL SetErrStat( ErrID_Fatal, 'The IEC turbulence characteristic must be either "A", "B", "C", or a real number.', ErrStat, ErrMsg, 'ProcessLine_IECturbc') - END SELECT ! IECTurbC - - ENDIF - - - - ELSE - - Line = ADJUSTL( Line ) - CALL Conv2UC( Line ) - - KHtest = ( Line(1:6) == 'KHTEST' ) - - ! These variables are not used for non-IEC turbulence - - NumTurbInp = .FALSE. - PerTurbInt = 0.0 - IECTurbC = "" - - ENDIF - - -END SUBROUTINE ProcessLine_IECturbc -!======================================================================= -!> This subroutine processes the user input from the IEC_WindType line -!! and initializes the variables p%IEC%IECTurbE, p%IEC%Vref, -!! p%IEC%IEC_WindType, and p%IEC%IEC_WindDesc. -SUBROUTINE ProcessLine_IEC_WindType(Line, p, ErrStat, ErrMsg) - - TYPE(TurbSim_ParameterType), INTENT(INOUT) :: p !< TurbSim parameters - CHARACTER(*), INTENT(INOUT) :: Line !< on entry, the line from the input file. may be modified in this routine - - INTEGER(IntKi), intent( out) :: ErrStat !< Error level - CHARACTER(*), intent( out) :: ErrMsg !< Message describing error - - - ErrStat = ErrID_None - ErrMsg = "" - - - IF ( p%met%IsIECModel .AND. p%met%TurbModel_ID /= SpecModel_MODVKM ) THEN - - CALL Conv2UC( Line ) - - p%IEC%IECTurbE = Line(1:1) - - ! Let's see if the first character is a number (for the ETM case) - SELECT CASE ( p%IEC%IECTurbE ) - CASE ('1') - p%IEC%Vref = 50.0_ReKi - Line = Line(2:) - CASE ('2') - p%IEC%Vref = 42.5_ReKi - Line = Line(2:) - CASE ('3') - p%IEC%Vref = 37.5_ReKi - Line = Line(2:) - CASE DEFAULT - ! There's no number at the start of the string so let's move on (it's NTM). - p%IEC%Vref = -999.9_ReKi - p%IEC%IECTurbE = ' ' - END SELECT - - SELECT CASE ( TRIM( Line ) ) - CASE ( 'NTM' ) - p%IEC%IEC_WindType = IEC_NTM - p%IEC%IEC_WindDesc = 'Normal Turbulence Model' - CASE ( 'ETM' ) - p%IEC%IEC_WindType = IEC_ETM - p%IEC%IEC_WindDesc = 'Extreme Turbulence Model' - CASE ( 'EWM1' ) - p%IEC%IEC_WindType = IEC_EWM1 - p%IEC%IEC_WindDesc = 'Extreme 1-Year Wind Speed Model' - CASE ( 'EWM50' ) - p%IEC%IEC_WindType = IEC_EWM50 - p%IEC%IEC_WindDesc = 'Extreme 50-Year Wind Speed Model' - !CASE ( 'EWM100' ) - ! p%IEC%IEC_WindType = IEC_EWM100 - ! p%IEC%IEC_WindDesc = 'Extreme 100-Year Wind Speed Model' - CASE DEFAULT - CALL SetErrStat( ErrID_Fatal, 'Valid entries for the IEC wind turbulence are "NTM", "xETM", "xEWM1", or "xEWM50", '// & - 'where x is the wind turbine class (1, 2, or 3).', ErrStat, ErrMsg, 'ProcessLine_IEC_WindType') - END SELECT - - IF ( p%IEC%IEC_WindType /= IEC_NTM ) THEN - - IF (p%IEC%IECedition /= 3 .OR. p%IEC%IECstandard == 2) THEN - CALL SetErrStat( ErrID_Fatal, 'The extreme turbulence and extreme wind speed models are available with '// & - 'the IEC 61400-1 Ed. 3 or 61400-3 scaling only.', ErrStat, ErrMsg, 'ProcessLine_IEC_WindType') - ENDIF - - IF (p%IEC%Vref < 0. ) THEN - CALL SetErrStat( ErrID_Fatal, 'A wind turbine class (1, 2, or 3) must be specified with the '// & - 'extreme turbulence and extreme wind types. (i.e. "1ETM")', ErrStat, ErrMsg, 'ProcessLine_IEC_WindType') - ENDIF - - IF ( p%IEC%NumTurbInp ) THEN - CALL SetErrStat( ErrID_Fatal, 'When the turbulence intensity is entered as a percent, '//& - 'the IEC wind type must be "NTM".', ErrStat, ErrMsg, 'ProcessLine_IEC_WindType') - ENDIF - - ELSE - - p%IEC%IECTurbE = ' ' - - ENDIF - - ELSE - p%IEC%IEC_WindType = IEC_NTM - p%IEC%IEC_WindDesc = 'Normal turbulence' - p%IEC%IECTurbE = ' ' ! unused for non-IEC models - p%IEC%Vref = -999.9_ReKi ! unused for non-IEC models - ENDIF - - - -END SUBROUTINE ProcessLine_IEC_WindType -!======================================================================= -SUBROUTINE GetDefaultSCMod( TurbModel_ID, SCMod ) - - INTEGER(IntKi), INTENT(IN ) :: TurbModel_ID ! turbulence model Identifier - INTEGER(IntKi), INTENT( OUT) :: SCMod(3) ! default spatial coherence model - - - - SELECT CASE (TurbModel_ID) - CASE ( SpecModel_IECKAI, SpecModel_IECVKM, SpecModel_MODVKM, SpecModel_USRVKM) - SCMod(1) = CohMod_IEC - SCMod(2:3) = CohMod_NONE - - CASE ( SpecModel_API ) - SCMod(1) = CohMod_API - SCMod(2:3) = CohMod_NONE - - CASE ( SpecModel_USER ) - SCMod(1) = CohMod_GENERAL - SCMod(2:3) = CohMod_NONE - - CASE ( SpecModel_None ) - SCMod = CohMod_NONE - - CASE DEFAULT - SCMod = CohMod_GENERAL - - END SELECT - - -END SUBROUTINE GetDefaultSCMod -!======================================================================= -SUBROUTINE GetDefaultCoh(TurbModel_ID, RICH_NO, WS, Ht, InCDec, InCohB ) -! This routine should NOT be called after CalcIECScalingParams() because it will -! incorrectly overwrite the InCDec and InCohB parameters for the IEC models. - - ! These numbers come from Neil's analysis - - INTEGER(IntKi), INTENT(IN) :: TurbModel_ID ! turbulence model Identifier - REAL(ReKi), INTENT(IN) :: RICH_NO ! Richardson Number (stability) - REAL(ReKi), INTENT(IN) :: Ht !Height, usually hub height - REAL(ReKi), INTENT(IN) :: WS !Wind speed, usually = UHub - REAL(ReKi), INTENT( OUT) :: InCDec(3) ! default coherence decrement - REAL(ReKi), INTENT( OUT) :: InCohB(3) ! default coherence parameter B - - -! REAL(ReKi), PARAMETER :: a = 0.007697495 !coeffs for WF_xxD best-fit equations -! REAL(ReKi), PARAMETER :: b = 0.451759656 !coeffs for WF_xxD best-fit equations -! REAL(ReKi), PARAMETER :: c = 6.559106387 !coeffs for WF_xxD best-fit equations -! REAL(ReKi), PARAMETER :: d = -0.10471942 !coeffs for WF_xxD best-fit equations -! REAL(ReKi), PARAMETER :: e = -1.19488521 !coeffs for WF_xxD best-fit equations -! REAL(ReKi), PARAMETER :: f = 0.005529328 !coeffs for WF_xxD best-fit equations -! REAL(ReKi), PARAMETER :: g = 0.059157163 !coeffs for WF_xxD best-fit equations - - - REAL(ReKi) :: Coeffs(10,3) ! coeffs for WS category coherence decrements - REAL(ReKi) :: Ht1 !Height, set to bounds of the individual models - REAL(ReKi) :: Ht2 !Height squared - REAL(ReKi) :: Ht3 !Height cubed - REAL(ReKi) :: WS1 !Wind speed, set to bounds of individual models - REAL(ReKi) :: RI1 !RICH_NO, set to bounds of individual models - REAL(ReKi) :: RI2 !RICH_NO squared - REAL(ReKi) :: RI3 !RICH_NO cubed - - INTEGER :: I - INTEGER :: Ri_Cat - - - IF (RICH_NO <= 0.00_ReKi ) THEN - IF ( RICH_NO <= - 1.0_ReKi ) THEN - Ri_Cat = 1 - ELSE - Ri_Cat = 2 - ENDIF - ELSEIF ( RICH_NO <= 0.25_ReKi ) THEN - IF ( RICH_NO <= 0.10_ReKi ) THEN - Ri_Cat = 3 - ELSE - Ri_Cat = 4 - ENDIF - ELSE - Ri_Cat = 5 - ENDIF - - SELECT CASE ( TurbModel_ID ) - - CASE ( SpecModel_GP_LLJ ) - HT1 = MAX( 60.0_ReKi, MIN( Ht, 100.0_ReKi ) ) - IF ( WS <= 14.0 ) THEN - IF ( WS <= 8.0 ) THEN - IF ( WS <= 6.0 ) THEN - coeffs(:,3) = (/ 3.1322E+00, 2.2819E-03, 2.9214E+00, -5.2203E-04, 1.1877E+00, & - -5.7605E-02, 3.7233E-06, -3.5021E-01, -1.7555E-03, 3.9712E-04 /) !W 5 - IF ( WS <= 4.0 ) THEN ! WS <= 4 - RI1 = MAX( 0.0_ReKi, MIN( RICH_NO, 1.0_ReKi ) ) - coeffs(:,1) = (/ 4.8350E+00, -4.0113E-02, 7.8134E+00, -2.0069E-05, -1.9518E-01, & - -1.4009E-01, 2.3195E-06, 8.2029E-02, -7.4979E-04, 6.1186E-04 /) !U 3 - coeffs(:,2) = (/ 3.2587E+00, -5.9086E-02, 9.7426E+00, 5.7360E-04, 2.1274E-01, & - -1.6398E-01, -8.3786E-07, 6.6896E-02, -3.5254E-03, 6.4833E-04 /) !V 3 - ELSE ! 4 < WS <= 6 - RI1 = MAX( -0.5_ReKi, MIN( RICH_NO, 1.0_ReKi ) ) - coeffs(:,1) = (/ 9.2474E+00, -4.9849E-02, 6.0887E+00, -5.9124E-04, 4.4312E-02, & - -1.1966E-01, 5.2652E-06, -1.0373E-01, 4.0480E-03, 5.5761E-04 /) !U 5 - coeffs(:,2) = (/ 3.6355E+00, 1.7701E-02, 4.2165E+00, -5.8828E-04, 9.5592E-02, & - -6.5313E-02, 3.3875E-06, -1.7981E-02, -1.6375E-03, 3.0423E-04 /) !V 5 - ENDIF - ELSE ! 6 < WS <= 8 - RI1 = MAX( -0.5_ReKi, MIN( RICH_NO, 1.0_ReKi ) ) - coeffs(:,1) = (/ 1.1795E+01, -7.5393E-02, 9.5279E+00, -3.4922E-04, -5.8973E-01, & - -1.6753E-01, 4.4267E-06, 2.1797E-01, 7.7887E-04, 7.4912E-04 /) !U 7 - coeffs(:,2) = (/ 1.7730E+00, 9.6577E-02, 8.1310E+00, -1.2028E-03, 3.0145E-02, & - -1.2282E-01, 4.6866E-06, 3.5748E-02, -2.9013E-03, 4.8368E-04 /) !V 7 - coeffs(:,3) = (/ 9.1695E-01, 9.1488E-02, 6.7163E+00, -1.2938E-03, 1.0315E+00, & - -1.1976E-01, 5.6039E-06, -2.0416E-01, -3.4698E-03, 6.0175E-04 /) !W 7 - ENDIF - ELSE ! 8.0 < WS <= 14.0 - IF (WS <= 10.0) THEN ! 8 < WS <= 10 - RI1 = MAX( -0.5_ReKi, MIN( RICH_NO, 1.0_ReKi ) ) - coeffs(:,1) = (/ 8.4674E+00, 1.2922E-01, 8.6170E+00, -3.3048E-03, -3.1928E-02, & - -1.2515E-01, 1.8209E-05, 2.9087E-01, -9.3031E-03, 5.0706E-04 /) !U 9 - coeffs(:,2) = (/ 2.8145E+00, 1.0257E-01, 4.2987E+00, -1.4901E-03, 4.9698E-02, & - -3.9964E-02, 6.7640E-06, 2.2980E-01, -1.0046E-02, 1.3037E-04 /) !V 9 - coeffs(:,3) = (/ 2.4952E+00, 5.8000E-02, 1.9851E+00, -9.4027E-04, -4.0135E-02, & - -1.8377E-02, 4.3320E-06, -1.0441E-01, 3.6831E-03, 8.6637E-05 /) !W 9 - ELSEIF (WS <= 12.0) THEN ! 10 < WS <= 12 - RI1 = MAX( -0.5_ReKi, MIN( RICH_NO, 1.0_ReKi ) ) - coeffs(:,1) = (/ 1.2473E+01, 3.2270E-02, 1.4508E+01, -2.2856E-03, -1.4652E+00, & - -2.4114E-01, 1.4919E-05, 5.5578E-01, -8.5528E-04, 1.0273E-03 /) !U 11 - coeffs(:,2) = (/ 1.0882E+00, 1.9425E-01, 8.1533E+00, -2.5574E-03, 4.3113E-01, & - -8.0465E-02, 1.0478E-05, 1.1640E-01, -1.1717E-02, 1.6476E-04 /) !V 11 - coeffs(:,3) = (/ 5.0280E-01, 1.1637E-01, 4.0130E+00, -1.2034E-03, -2.7592E-01, & - -3.8744E-02, 3.4213E-06, -1.5144E-02, 2.4042E-03, 4.7818E-05 /) !W 11 - ELSE ! 12 < WS <= 14.0 - RI1 = MAX( -1.0_ReKi, MIN( RICH_NO, 1.0_ReKi ) ) - coeffs(:,1) = (/ 8.6311E+00, 2.5614E-01, 1.1165E+01, -5.1685E-03, 3.0895E+00, & - -1.9190E-01, 2.7162E-05, -2.6513E-01, -3.6479E-02, 8.8431E-04 /) !U 13 - coeffs(:,2) = (/ 1.2842E+00, 2.4007E-01, 5.3653E+00, -3.2589E-03, 3.4715E+00, & - -6.8865E-02, 1.3756E-05, -4.8465E-01, -4.0608E-02, 3.8578E-04 /) !V 13 - coeffs(:,3) = (/ 4.3681E+00, 1.2251E-02, 1.3826E+00, -1.1592E-04, 3.3654E+00, & - -5.2367E-02, -4.4086E-08, -3.5254E-01, -1.6780E-02, 3.9048E-04 /) !W 13 - ENDIF - ENDIF - ELSE ! WS > 14 - IF (WS <= 20.0 ) THEN - IF (WS <= 16.0) THEN ! 14 < WS <= 16 - RI1 = MAX( -1.0_ReKi, MIN( RICH_NO, 1.0_ReKi ) ) - coeffs(:,1) = (/ 1.3972E-01, 6.3486E-01, 1.7576E+01, -1.0017E-02, 2.8458E+00, & - -2.5233E-01, 4.6539E-05, -1.8899E-01, -2.6717E-02, 9.5173E-04 /) !U 15 - coeffs(:,2) = (/ -7.1243E+00, 5.6768E-01, 1.2886E+01, -7.3277E-03, 3.7880E+00, & - -1.4733E-01, 3.0898E-05, -1.5056E-01, -2.9500E-02, 3.6703E-04 /) !V 15 - coeffs(:,3) = (/ -1.1004E+01, 5.3470E-01, 5.3118E+00, -5.8999E-03, 1.9009E+00, & - -2.4063E-02, 2.1755E-05, -4.5798E-01, 1.6885E-02, -3.9974E-04 /) !W 15 - ELSEIF (WS <= 18.0) THEN ! 16 < WS <= 18 - RI1 = MAX( -0.5_ReKi, MIN( RICH_NO, 1.0_ReKi ) ) - coeffs(:,1) = (/ -6.9650E+00, 8.8636E-01, 2.3467E+01, -1.1973E-02, -4.3750E+00, & - -3.5519E-01, 5.0414E-05, 9.1789E-01, 9.8340E-03, 1.5885E-03 /) !U 17 - coeffs(:,2) = (/ 5.5495E-03, 3.2906E-01, 1.4609E+01, -4.1635E-03, -2.1246E+00, & - -1.8887E-01, 1.6964E-05, 3.7805E-01, 1.1880E-03, 8.8265E-04 /) !V 17 - coeffs(:,3) = (/ -1.3195E+00, 2.0022E-01, 2.3490E+00, -2.1308E-03, 3.5582E+00, & - 1.4379E-02, 7.6830E-06, -7.6155E-01, -2.4660E-02, -2.0199E-04 /) !W 17 - ELSE ! 18 < WS <= 20 - RI1 = MAX( -0.5_ReKi, MIN( RICH_NO, 1.0_ReKi ) ) - coeffs(:,1) = (/ -1.3985E+01, 1.3161E+00, 3.4773E+01, -1.9237E-02, -1.9845E+00, & - -5.5817E-01, 8.8310E-05, 1.7142E+00, -4.2907E-02, 2.3932E-03 /) !U 19 - coeffs(:,2) = (/ -1.2400E+01, 8.6854E-01, 1.9923E+01, -1.1557E-02, -1.0441E+00, & - -2.4593E-01, 4.9813E-05, 2.7861E-01, -8.6189E-03, 9.4314E-04 /) !V 19 - coeffs(:,3) = (/ -9.3436E+00, 6.4950E-01, 1.5316E+01, -8.7208E-03, 1.7329E+00, & - -2.2411E-01, 3.6288E-05, -8.0006E-01, -2.6439E-03, 7.9293E-04 /) !W 19 - ENDIF - ELSE ! WS > 20 - IF (WS <= 22.0) THEN ! 20 < WS <= 22 - RI1 = MAX( -0.5_ReKi, MIN( RICH_NO, 1.0_ReKi ) ) - coeffs(:,1) = (/ -2.4317E+01, 1.8176E+00, 5.3359E+01, -2.5973E-02, 6.0349E+00, & - -7.9927E-01, 1.1558E-04, 1.5926E+00, -1.5005E-01, 3.1688E-03 /) !U 21 - coeffs(:,2) = (/ 8.0459E+00, 1.8058E-01, 1.9426E+01, -3.6730E-03, -9.9717E-01, & - -1.8249E-01, 1.9237E-05, 4.9173E-01, -1.8255E-02, 6.9371E-04 /) !V 21 - coeffs(:,3) = (/ -2.3544E+01, 1.1403E+00, 8.3526E+00, -1.4511E-02, 7.2014E+00, & - 5.0216E-02, 5.9947E-05, -1.0659E+00, -7.4769E-02, -9.8390E-04 /) !W 21 - ELSEIF (WS <= 24.0) THEN ! 22 < WS <= 24 - RI1 = MAX( 0.0_ReKi, MIN( RICH_NO, 1.0_ReKi ) ) - coeffs(:,1) = (/ -3.5790E+01, 1.5374E+00, 1.1322E+02, -1.6884E-02, -1.7767E+01, & - -1.8122E+00, 6.8247E-05, 7.2101E+00, 3.5536E-02, 7.9269E-03 /) !U 23 - coeffs(:,2) = (/ -7.2883E+01, 2.8210E+00, 8.6392E+01, -3.1084E-02, -2.4938E+01, & - -1.5898E+00, 1.0997E-04, 7.1972E+00, 1.2624E-01, 9.3084E-03 /) !V 23 - coeffs(:,3) = (/ -3.2844E+01, 1.2683E+00, 3.2032E+01, -1.3197E-02, -1.1129E+01, & - -3.6741E-01, 4.2852E-05, 4.1336E+00, 2.4775E-02, 1.8431E-03 /) !W 23 - ELSE ! 24 < WS - RI1 = MAX( -0.5_ReKi, MIN( RICH_NO, 1.0_ReKi ) ) - coeffs(:,1) = (/ 2.2906E+01, 9.3209E-02, 1.5448E+01, -5.7421E-03, -8.9114E+00, & - -3.1547E-02, 4.0144E-05, 5.4544E-01, 5.3557E-02, -3.1299E-04 /) !U 25 - coeffs(:,2) = (/ -1.1903E+01, 1.1104E+00, 1.7962E+01, -1.6045E-02, -9.2458E+00, & - -4.4526E-02, 6.9880E-05, 2.8017E+00, -2.7211E-02, -8.4099E-04 /) !V 25 - coeffs(:,3) = (/ 6.1054E-01, 7.1841E-03, 4.2996E+00, 2.9071E-04, -2.0002E+00, & - -7.0403E-02, -2.8931E-06, 2.3943E-02, 1.8395E-02, 5.0406E-04 /) !W 25 - ENDIF - ENDIF - ENDIF - - - HT2 = HT1*HT1 - HT3 = HT1*HT2 - RI2 = RI1*RI1 - RI3 = RI1*RI2 - - DO I = 1,3 - InCDec(I) = coeffs( 1,I) + coeffs(2,I)*Ht1 + coeffs(3,I)*RI1 & - + coeffs(4,I)*Ht2 + coeffs(5,I)*RI2 + coeffs( 6,I)*Ht1*RI1 & - + coeffs(7,I)*Ht3 + coeffs(8,I)*RI3 + coeffs( 9,I)*Ht1*RI2 & - + coeffs(10,I)*Ht2*RI1 - ENDDO - - WS1 = MAX( 2.0_ReKi, WS ) - SELECT CASE ( Ri_Cat ) - CASE ( 1, 2) -! InCDec = (/ 1.744591004*WS1**0.593219225, & -! -0.58750092+1.937230512*WS1**0.400548383, & -! -0.57833219+1.450654739*WS1**0.443191083 /) - InCohB = (/-0.00014115+0.006826264/WS1, & - 0.014025749/WS1, & - 0.000480386+0.020982336/WS1 /) - - CASE ( 3 ) -! InCDec = (/ 1.962126171*WS1**0.575523536, & -! -2.79495117+3.698342796*WS1**0.305415750, & -! 0.887573173*WS1**0.498317195 /) - InCohB = (/-0.00016838+0.009764148/WS1, & - 0.018582932/WS1, & - 0.001865953+0.061952454/WS1 /) - - CASE ( 4 ) -! InCDec = (/ 0.817085986*WS1**1.045777184, & -! 0.599696362*WS1**1.038373995, & -! 1.327586050*WS1**0.590370871 /) - InCohB = (/0.000175033+0.004195814/WS1, & - 0.008479460/WS1, & - 0.002318082+0.027820652/WS1 /) - - CASE ( 5 ) -! InCDec = (/ 0.959999473*WS1**0.972466847, & -! 0.082701643+0.867230846*WS1**0.925895412, & -! 1.524380209*WS1**0.548060899 /) - InCohB = (/0.000241808+0.004267702/WS1, & - 0.005408592/WS1, & - 0.001150319+0.010744459/WS1 /) - END SELECT - - - CASE ( SpecModel_NWTCUP, SpecModel_USRVKM ) - HT1 = MAX( 25.0_ReKi, MIN( Ht, 50.0_ReKi ) ) - - IF ( WS <= 14.0 ) THEN - RI1 = MAX( -1.0_ReKi, MIN( RICH_NO, 1.0_ReKi ) ) - IF ( WS <= 8.0 ) THEN - IF (WS <= 4.0 ) THEN ! WS <= 4 - coeffs(:,1) = (/ 8.1767E+00, -3.1018E-01, 3.3055E-01, 4.4232E-03, 4.6550E-01, & - -2.4582E-02, -5.8568E-06, -8.7873E-02, 1.3070E-02, 3.1871E-04 /) !U 3 - coeffs(:,2) = (/ 5.8003E+00, -2.0838E-01, 2.8727E-01, 2.8669E-03, 6.9669E-01, & - -8.2249E-03, -2.4732E-06, -1.0826E-01, 9.9973E-03, 1.8546E-05 /) !V 3 - coeffs(:,3) = (/ 5.9625E+00, -2.9247E-01, -9.3269E-01, 4.4089E-03, 1.3779E-01, & - 2.6993E-02, -6.1784E-06, -7.2920E-02, 1.7028E-02, -3.3753E-04 /) !W 3 - ELSEIF (WS <= 6.0 ) THEN ! 4 < WS <= 6 - coeffs(:,1) = (/ 1.2891E+01, -4.8265E-01, 3.5549E+00, 6.6099E-03, 8.2275E-01, & - -1.5913E-01, -7.9740E-06, -1.2357E-02, 3.2084E-03, 1.7145E-03 /) !U 5 - coeffs(:,2) = (/ 8.0267E+00, -2.5275E-01, 1.3801E+00, 3.2447E-03, 1.6004E+00, & - -3.2592E-02, -5.1265E-06, -9.8552E-02, -1.3513E-02, 2.8075E-04 /) !V 5 - coeffs(:,3) = (/ 7.9593E+00, -3.6336E-01, 1.4974E+00, 5.4012E-03, 9.5041E-01, & - -1.0152E-01, -1.0865E-05, 4.3121E-02, -3.2447E-03, 1.3797E-03 /) !W 5 - ELSE ! 6 < WS <= 8 - coeffs(:,1) = (/ 1.3702E+01, -4.4674E-01, 3.7943E+00, 5.9350E-03, 9.6026E-01, & - -1.7425E-01, -7.2917E-06, -8.8426E-02, 5.1530E-03, 2.0554E-03 /) !U 7 - coeffs(:,2) = (/ 9.2471E+00, -2.6247E-01, 1.4504E+00, 3.2436E-03, 1.8823E+00, & - -3.2180E-02, -5.9491E-06, -2.0100E-01, -1.7619E-02, 3.8519E-04 /) !V 7 - coeffs(:,3) = (/ 8.9439E+00, -3.8885E-01, 2.2175E+00, 5.6207E-03, 7.6040E-01, & - -1.3502E-01, -9.2514E-06, 1.9269E-02, 3.8862E-03, 1.7674E-03 /) !W 7 - ENDIF - ELSE ! 8.0 < WS <= 14.0 - IF (WS <= 10.0) THEN ! 8 < WS <= 10 - coeffs(:,1) = (/ 1.9061E+01, -4.5354E-01, 7.5961E+00, 5.2422E-03, 1.5158E+00, & - -2.4908E-01, -2.5277E-06, -1.6660E-01, 1.1369E-02, 3.0156E-03 /) !U 9 - coeffs(:,2) = (/ 1.3362E+01, -3.3806E-01, 7.0401E+00, 4.5349E-03, 2.6798E+00, & - -2.3637E-01, -9.9075E-06, -2.2373E-01, -1.6644E-03, 2.3879E-03 /) !V 9 - coeffs(:,3) = (/ 8.8401E+00, -2.9945E-01, 3.7883E+00, 4.4581E-03, 2.0417E+00, & - -2.7852E-01, -7.0750E-06, -6.2618E-02, 1.4646E-02, 3.8512E-03 /) !W 9 - ELSEIF (WS <= 12.0) THEN ! 10 < WS <= 12 - coeffs(:,1) = (/ 3.4011E+01, -1.2590E+00, 1.6320E+01, 1.9225E-02, 6.8346E+00, & - -8.8950E-01, -6.2453E-05, -2.4945E-01, -4.3892E-02, 1.2078E-02 /) !U 11 - coeffs(:,2) = (/ 1.7135E+01, -4.0754E-01, 1.0282E+01, 5.7832E-03, 6.3056E+00, & - -2.8536E-01, -3.0216E-05, -5.3170E-01, -5.7090E-02, 2.8463E-03 /) !V 11 - coeffs(:,3) = (/ 1.3002E+01, -4.8326E-01, 3.2819E+00, 7.8800E-03, 2.7094E+00, & - -2.5714E-01, -3.0117E-05, -2.1404E-01, -4.2711E-03, 4.1067E-03 /) !W 11 - ELSE ! 12 < WS <= 14 - coeffs(:,1) = (/ 2.6682E+01, -9.7229E-01, 1.3191E+01, 1.7604E-02, -1.3537E+00, & - -6.4082E-01, -7.8242E-05, 1.7548E-01, 9.7417E-02, 1.0259E-02 /) !U 13 - coeffs(:,2) = (/ 1.7083E+01, -4.7346E-01, 1.3515E+01, 7.7832E-03, 5.8633E-01, & - -6.1815E-01, -3.3752E-05, -1.7300E-01, 4.3584E-02, 8.9289E-03 /) !V 13 - coeffs(:,3) = (/ 1.6015E+01, -6.3912E-01, 1.3137E+01, 9.4757E-03, 2.5549E+00, & - -8.1438E-01, -1.5565E-05, 2.9244E-02, 2.2779E-02, 1.1982E-02 /) !W 13 - ENDIF - ENDIF - ELSE ! WS > 14 - IF (WS <= 20.0 ) THEN - IF (WS <= 16.0) THEN ! 14 < WS <= 16 - RI1 = MAX( -1.0_ReKi, MIN( RICH_NO, 1.0_ReKi ) ) - coeffs(:,1) = (/ 2.9459E+01, -7.3181E-01, 9.4613E+00, 9.2172E-03, 6.1086E+00, & - -4.9990E-01, -2.9994E-05, -6.9606E-01, -8.5076E-03, 8.1330E-03 /) !U 15 - coeffs(:,2) = (/ 1.7540E+01, -2.6071E-01, 9.3639E+00, 1.3341E-03, 9.4294E+00, & - -4.2565E-01, -2.7836E-06, -6.7708E-01, -6.9127E-02, 6.2290E-03 /) !V 15 - coeffs(:,3) = (/ 1.2792E+01, -4.6469E-01, 4.6350E+00, 1.0633E-02, 1.8523E+00, & - -3.2417E-01, -8.5038E-05, -2.2253E-01, -7.3351E-04, 5.4781E-03 /) !W 15 - ELSEIF (WS <= 18.0) THEN ! 16 < WS <= 18 - RI1 = MAX( -1.0_ReKi, MIN( RICH_NO, 1.0_ReKi ) ) - coeffs(:,1) = (/ 1.7775E+01, 4.5287E-01, 1.6417E+01, -2.3724E-02, 5.8998E+00, & - -5.3502E-01, 2.6202E-04, -9.9466E-02, 4.1386E-02, 4.5663E-03 /) !U 17 - coeffs(:,2) = (/ 1.2022E+01, 2.4246E-01, 1.3875E+01, -1.1725E-02, 5.1917E+00, & - -5.4329E-01, 1.1893E-04, -2.0308E-01, 6.5256E-02, 5.6597E-03 /) !V 17 - coeffs(:,3) = (/ 1.2680E+01, -1.4768E-01, 7.1498E+00, -3.0341E-03, 1.9747E+00, & - -3.8374E-01, 7.0412E-05, 2.2297E-01, 5.9943E-02, 5.3514E-03 /) !W 17 - ELSE ! 18 < WS <= 20 - RI1 = MAX( -0.5_ReKi, MIN( RICH_NO, 1.0_ReKi ) ) - coeffs(:,1) = (/ 3.1187E+01, -6.8540E-01, 7.1288E+00, 1.1923E-02, 8.8547E+00, & - 6.3133E-02, -9.4673E-05, -2.5710E+00, -5.4077E-02, -1.2797E-04 /) !U 19 - coeffs(:,2) = (/ 1.2664E+01, 9.1858E-02, 1.9050E+01, -2.8868E-03, 7.2969E+00, & - -4.4573E-01, -6.1033E-06, -2.0960E+00, -1.9913E-02, 4.9023E-03 /) !V 19 - coeffs(:,3) = (/ 2.2146E+01, -7.6940E-01, 1.1948E+01, 1.0400E-02, 5.0034E+00, & - -4.3958E-01, -2.5936E-05, -3.0848E-01, -6.3381E-02, 5.1204E-03 /) !W 19 - ENDIF - ELSE ! WS > 20 - RI1 = MAX( -0.5_ReKi, MIN( RICH_NO, 1.0_ReKi ) ) - IF (WS <= 22.0) THEN ! 20 < WS <= 22 - coeffs(:,1) = (/ 2.5165E+01, -7.7660E-02, 1.9692E+01, -1.1794E-02, 9.8635E+00, & - -2.5520E-01, 2.0573E-04, -4.9850E+00, 1.1272E-01, 1.3267E-03 /) !U 21 - coeffs(:,2) = (/ 2.1691E+01, -3.1787E-01, 3.2327E+01, -4.5546E-03, 1.1194E+01, & - -8.0823E-01, 1.4306E-04, -4.3418E+00, 7.3163E-02, 6.3637E-03 /) !V 21 - coeffs(:,3) = (/ 1.4634E+01, -3.9394E-01, 1.1617E+01, 5.6387E-03, 5.4799E+00, & - -3.9011E-01, -1.0420E-05, -2.4279E+00, 6.6452E-02, 4.9504E-03 /) !W 21 - ELSEIF (WS <= 24.0) THEN ! 22 < WS <= 24 - coeffs(:,1) = (/ 7.3816E+00, 1.0538E+00, 2.1578E+01, -3.3487E-02, -6.4986E+00, & - -8.6782E-01, 3.2397E-04, 1.1412E+00, 2.2982E-01, 1.4660E-02 /) !U 23 - coeffs(:,2) = (/ 6.5302E+00, 1.0524E+00, 2.4596E+01, -4.1648E-02, 4.0584E+00, & - -6.1130E-01, 4.5468E-04, -3.6547E+00, 2.3176E-01, 8.4385E-03 /) !V 23 - coeffs(:,3) = (/ 1.3424E+01, 2.6104E-02, 7.6014E+00, -1.2744E-02, 1.0735E+01, & - 2.2086E-01, 1.9309E-04, -5.9548E+00, 8.6483E-02, -3.9550E-03 /) !W 23 - ELSE ! 24 < WS - coeffs(:,1) = (/ -1.6629E+01, 1.3094E+00, -4.4183E+00, -8.4860E-03, -1.3800E+01, & - -5.5221E-01, -5.6659E-05, 8.1834E+00, -8.2497E-03, 1.8383E-02 /) !U 25 - coeffs(:,2) = (/ 3.4796E+00, 7.1144E-01, 1.2153E+01, -2.7309E-02, 1.0003E+00, & - -6.3570E-01, 3.4424E-04, -8.5038E-01, 1.2822E-01, 1.3181E-02 /) !V 25 - coeffs(:,3) = (/ 2.7014E+00, 1.1794E-01, 2.1378E+00, 4.5539E-03, 1.6899E+00, & - 1.2254E-01, -9.6940E-05, -2.3430E-01, -2.3826E-02, 5.5964E-05 /) !W 25 - ENDIF - ENDIF - ENDIF - - HT2 = HT1*HT1 - HT3 = HT1*HT2 - RI2 = RI1*RI1 - RI3 = RI1*RI2 - - DO I = 1,3 - InCDec(I) = coeffs( 1,I) + coeffs(2,I)*Ht1 + coeffs(3,I)*RI1 & - + coeffs(4,I)*Ht2 + coeffs(5,I)*RI2 + coeffs( 6,I)*Ht1*RI1 & - + coeffs(7,I)*Ht3 + coeffs(8,I)*RI3 + coeffs( 9,I)*Ht1*RI2 & - + coeffs(10,I)*Ht2*RI1 - ENDDO - - WS1 = MAX( 2.0_ReKi, WS ) - SELECT CASE ( Ri_Cat ) - CASE ( 1 ) -! InCDec = (/ 1.623224368*WS1**1.015099356, & -! 0.884720872*WS1**1.192553093, & -! 1.338245093*WS1**0.841757461 /) - InCohB = (/ -2.524e-05+0.002122544/WS1, & - 0.004367773*WS1**(-1.14945936), & - 0.031284497*WS1**(-0.72509517) /) - - CASE ( 2 ) -! InCDec = (/ 1.478475074*WS1**0.752442176, & -! 1.310684825*WS1**0.624122449, & -! 0.849106068*WS1**0.627688235 /) - InCohB = (/ 0.003320615*WS1**(-1.18592214), & - 0.005402681*WS1**(-0.98637053), & - 0.091649927*WS1**(-1.48835650) /) - - CASE ( 3 ) -! InCDec = (/ 1.596175944*WS1**0.674743966, & -! 1.114069218*WS1**0.638049141, & -! 0.473225245*WS1**0.784331891 /) - InCohB = (/ 0.002387997*WS1**(-0.85956868), & - 0.009481901*WS1**(-1.02518835), & - 0.052147706*WS1**(-0.88949864) /) - - CASE ( 4 ) -! InCDec = (/ 1.293345620*WS1**0.955639280, & -! 1.296399839*WS1**0.838281755, & -! 0.333750239*WS1**1.103784094 /) - InCohB = (/ 0.002870978*WS1**(-1.07398490), & - 0.002435238*WS1**(-0.68685045), & - 0.125356016*WS1**(-1.34791890) /) - - CASE ( 5 ) -! InCDec = (/ 1.325256941*WS1**1.039629269, & -! 1.014004299*WS1**1.082810576, & -! 0.206383058*WS1**1.435200799 /) - InCohB = (/ 0.003545043*WS1**(-1.03669585), & - 0.003996215*WS1**(-0.95313438), & - 0.125103070*WS1**(-1.02886635) /) - END SELECT - - CASE ( SpecModel_WF_UPW ) - HT1 = MAX( 5.0_ReKi, MIN( Ht, 35.0_ReKi ) ) - IF ( WS <= 14.0 ) THEN - IF ( WS <= 10 ) THEN - RI1 = MAX( -0.5_ReKi, MIN( RICH_NO, 0.15_ReKi ) ) - IF ( WS <= 8.0 ) THEN ! WS <= 8 - coeffs(:,1) = (/ 1.6715E+01, -3.8639E-01, 7.1817E+00, 1.5550E-03, -1.4293E+00, & - -2.0350E-01, 8.5532E-06, -3.4710E+00, -1.9743E-02, -3.9949E-04 /) !Upw_U 7 - coeffs(:,2) = (/ 8.4145E+00, -4.7610E-02, 3.9097E+00, -7.1412E-04, 1.8295E+01, & - 2.2583E-01, -1.6965E-05, 2.0769E+01, -9.1670E-02, -8.0300E-03 /) !Upw_V 7 - ELSE ! 8 < WS <= 10 - coeffs(:,1) = (/ 1.5432E+01, -2.1254E-01, 5.3075E+00, -2.9928E-03, 2.1647E+00, & - 1.1787E-02, 6.7458E-05, -9.0445E-01, -7.5941E-02, -4.7053E-03 /) !Upw_U 9 - coeffs(:,2) = (/ 7.5921E+00, 3.3520E-02, 1.2231E+01, -7.0018E-03, 6.0889E+01, & - 2.1810E-01, 1.1718E-04, 7.7287E+01, -1.3828E-01, -9.6568E-03 /) !Upw_V 9 - ENDIF - ELSE - RI1 = MAX( -0.5_ReKi, MIN( RICH_NO, 0.05_ReKi ) ) - IF ( WS <= 12.0 ) THEN ! 10 < WS <= 12 - coeffs(:,1) = (/ 1.3539E+01, -8.4892E-02, -1.9237E+00, -1.1485E-03, -4.0840E-01, & - 3.0956E-01, 2.4048E-05, -1.1523E+00, 9.6877E-03, -4.0606E-03 /) !Upw_U 11 - coeffs(:,2) = (/ 7.7451E+00, -1.3818E-01, -9.5197E-01, 3.9610E-03, 8.3255E-01, & - 7.2166E-02, -4.5012E-05, -2.0948E-01, -2.1400E-02, -2.9788E-04 /) !Upw_V 11 - ELSE ! 12 < WS <= 14 - coeffs(:,1) = (/ 1.2857E+01, -7.9408E-03, -1.5310E+00, -4.1077E-03, 1.0496E+00, & - 1.9473E-01, 7.2808E-05, 1.8380E-01, -1.6559E-02, -2.0872E-03 /) !Upw_U 13 - coeffs(:,2) = (/ 7.2452E+00, -6.2662E-02, -2.4865E+00, 3.2123E-03, -1.0281E-01, & - 1.9698E-01, -7.5745E-05, -1.1637E+00, -4.6458E-02, -2.7037E-03 /) !Upw_V 13 - ENDIF - ENDIF - ELSE - RI1 = MAX( -0.5_ReKi, MIN( RICH_NO, 0.05_ReKi ) ) - IF ( WS <= 18.0 ) THEN - IF ( WS <= 16.0 ) THEN ! 14 < WS <= 16 - coeffs(:,1) = (/ 1.4646E+01, -1.5023E-01, -9.7543E-01, -3.5607E-03, 4.8663E+00, & - -9.4360E-03, 1.4932E-04, 5.9503E+00, 7.4028E-02, 5.2698E-03 /) !Upw_U 15 - coeffs(:,2) = (/ 1.0133E+01, -3.1417E-01, 2.5400E+00, 6.6777E-03, 3.0790E+00, & - -2.5801E-01, -4.9501E-05, 2.8879E+00, -1.6722E-02, 4.8297E-03 /) !Upw_V 15 - ELSE ! 16 < WS <= 18 - coeffs(:,1) = (/ 1.5282E+01, -2.7642E-01, 2.5903E+00, 9.8716E-03, 5.9314E-01, & - -4.2790E-01, -1.6474E-04, -7.0065E-01, -3.2694E-02, 2.4583E-03 /) !Upw_U 17 - coeffs(:,2) = (/ 1.2464E+01, -3.4306E-01, 3.6261E+00, 5.8254E-03, 2.2592E+00, & - -1.1498E-01, -6.6196E-05, 1.3610E+00, -1.3345E-02, 1.0932E-03 /) !Upw_V 17 - ENDIF - ELSE - IF ( WS <= 20.0 ) THEN ! 18 < WS <= 20 - coeffs(:,1) = (/ 1.5059E+01, -8.0478E-02, 8.7088E+00, -1.7854E-03, 3.9922E+00, & - -6.0268E-01, 4.3906E-05, 3.3463E+00, -6.6490E-02, 1.2290E-02 /) !Upw_U 19 - coeffs(:,2) = (/ 1.0672E+01, -2.8104E-01, 7.8021E+00, 6.6360E-03, 2.4345E+00, & - -4.9103E-01, -8.3745E-05, 4.4084E-01, -9.2432E-02, 8.3096E-03 /) !Upw_V 19 - ELSE ! 20 < WS - coeffs(:,1) = (/ 1.8592E+01, 1.3888E-01, 1.6732E+01, -1.1880E-02, 2.3622E+01, & - 6.8199E-01, 7.3664E-05, 4.1289E+00, -3.8604E-01, -3.0381E-02 /) !Upw_U 21 - coeffs(:,2) = (/ 7.7137E+00, 1.2732E-01, 1.3477E+01, 1.9164E-03, 3.7133E+01, & - 3.8975E-01, -2.2818E-04, 1.8816E+01, -7.5304E-01, -2.1856E-02 /) !Upw_V 21 - ENDIF - ENDIF - ENDIF - - HT2 = HT1*HT1 - HT3 = HT1*HT2 - RI2 = RI1*RI1 - RI3 = RI1*RI2 - - DO I = 1,2 - InCDec(I) = coeffs( 1,I) + coeffs(2,I)*Ht1 + coeffs(3,I)*RI1 & - + coeffs(4,I)*Ht2 + coeffs(5,I)*RI2 + coeffs( 6,I)*Ht1*RI1 & - + coeffs(7,I)*Ht3 + coeffs(8,I)*RI3 + coeffs( 9,I)*Ht1*RI2 & - + coeffs(10,I)*Ht2*RI1 - ENDDO - - WS1 = MAX( 3.0_ReKi, WS ) -! InCDec(1:2) = (/ 5.640176786*WS1**0.269850341, & -! 6.059554513+18.44124731/WS1**1.5 /) - InCohB(1:2) = (/ 0.000448295+0.002502915/WS1, & - 0.001539069+0.005954785/WS1 /) - - - InCDec(3) = 0.4*InCDec(1) !cohA(w) = cohA(u)/2.5, number derived from histograms of u/w for NWTC and LLLJP data - InCohB(3) = 10.0*InCohB(1) !cohB(w) = cohB(u)*10, number derived from histograms of w/u for NWTC and LLLJP data - - CASE ( SpecModel_WF_07D, SpecModel_WF_14D ) - HT1 = MAX( 5.0_ReKi, MIN( Ht, 35.0_ReKi ) ) - IF ( WS <= 12.0 ) THEN - IF ( WS <= 8.0 ) THEN ! WS <= 8 - RI1 = MAX( -0.5_ReKi, MIN( RICH_NO, 0.15_ReKi ) ) - coeffs(:,1) = (/ 1.0310E+01, -6.4824E-03, -1.3258E+00, -2.7238E-03, -6.8515E+00, & - 3.1602E-02, 5.5982E-05, -8.4777E+00, 2.1506E-02, 4.9745E-04 /) !Dwn_U 7 - coeffs(:,2) = (/ 6.9491E+00, -1.3378E-01, 1.7961E-01, -4.9439E-04, -1.8140E+00, & - -4.2321E-02, 4.4962E-05, -3.6939E+00, -8.9465E-03, 4.7867E-04 /) !Dwn_V 7 - ELSEIF ( WS <= 10.0 ) THEN ! 8 < WS <= 10 - RI1 = MAX( -0.5_ReKi, MIN( RICH_NO, 0.05_ReKi ) ) - coeffs(:,1) = (/ 9.7420E+00, 6.1610E-02, 5.6636E-02, -5.5949E-03, -1.3014E+00, & - 2.0655E-01, 8.9989E-05, -1.9837E+00, 5.4957E-03, -3.5496E-03 /) !Dwn_U 9 - coeffs(:,2) = (/ 7.1063E+00, -1.7021E-01, 1.2560E+00, -4.2616E-04, 9.0937E-01, & - -1.3022E-01, 4.7976E-05, 2.1302E-01, -4.3159E-04, 1.5443E-03 /) !Dwn_V 9 - ELSE ! 10 < WS <= 12 - RI1 = MAX( -0.5_ReKi, MIN( RICH_NO, 0.05_ReKi ) ) - coeffs(:,1) = (/ 1.0869E+01, -9.1393E-03, -1.1695E+00, -3.3725E-03, 3.2199E-01, & - 7.2692E-02, 7.0565E-05, 6.9573E-01, 2.5360E-02, 1.0187E-03 /) !Dwn_U 11 - coeffs(:,2) = (/ 6.9882E+00, -1.3517E-01, -3.0492E-01, -4.6775E-04, 4.6897E-01, & - -2.0102E-03, 3.3908E-05, 1.4604E-02, 1.1729E-02, -6.2775E-05 /) !Dwn_V 11 - ENDIF - ELSE - RI1 = MAX( -0.5_ReKi, MIN( RICH_NO, 0.05_ReKi ) ) - IF ( WS <= 14.0 ) THEN ! 12 < WS <= 14 - coeffs(:,1) = (/ 1.1105E+01, 5.3789E-02, -9.4253E-02, -5.4203E-03, -1.0114E+00, & - 1.1421E-01, 7.6110E-05, -1.2654E+00, 1.5121E-02, -2.9055E-03 /) !Dwn_U 13 - coeffs(:,2) = (/ 7.5741E+00, -8.3945E-02, 3.7020E+00, -6.0317E-03, 3.1339E-01, & - -2.1921E-01, 1.5598E-04, 6.2478E-01, 5.9490E-02, 3.4785E-03 /) !Dwn_V 13 - ELSE ! 14 < WS - coeffs(:,1) = (/ 1.2256E+01, 2.0131E-02, 1.9465E+00, -7.6608E-03, 1.5031E+00, & - -1.0916E-01, 1.3634E-04, 1.3451E+00, -1.6458E-02, 3.8312E-03 /) !Dwn_U 15 - coeffs(:,2) = (/ 7.7749E+00, -2.2712E-01, 1.3675E+00, 6.7944E-03, 4.2033E-02, & - -6.8887E-02, -9.6117E-05, -1.5526E+00, -2.2357E-02, -1.5311E-03 /) !Dwn_V 15 - ENDIF - ENDIF - - HT2 = HT1*HT1 - HT3 = HT1*HT2 - RI2 = RI1*RI1 - RI3 = RI1*RI2 - - DO I = 1,2 - InCDec(I) = coeffs( 1,I) + coeffs(2,I)*Ht1 + coeffs(3,I)*RI1 & - + coeffs(4,I)*Ht2 + coeffs(5,I)*RI2 + coeffs( 6,I)*Ht1*RI1 & - + coeffs(7,I)*Ht3 + coeffs(8,I)*RI3 + coeffs( 9,I)*Ht1*RI2 & - + coeffs(10,I)*Ht2*RI1 - ENDDO - - WS1 = MAX( 3.0_ReKi, WS ) -! WS2 = WS1*WS1 -! WS3 = WS2*WS1 -! InCDec(1:2) = (/ (a+c*WS1+e*WS2+g*WS3)/(1+b*WS1+d*WS2+f*WS3), & -! 3.357892649*WS1**0.1198781 /) - InCohB(1:2) = (/ 4.49289e-05+0.004933460/WS1, & - 0.00158053+0.014268899/WS1 /) - InCDec(3) = 0.4_ReKi*InCDec(1) !cohA(w) = cohA(u)/2.5, number derived from histograms of u/w for NWTC and LLLJP data - InCohB(3) = 10.0_ReKi*InCohB(1) !cohB(w) = cohB(u)*10, number derived from histograms of w/u for NWTC and LLLJP data - - CASE ( SpecModel_USER ) - InCDec = (/ WS, HUGE(InCohB(1)), HUGE(InCohB(1)) /) - InCohB = 0.0_ReKi ! entire array is zero - - CASE DEFAULT ! includes CASE ( 'SMOOTH' ) - - InCDec = (/1.0_ReKi, 0.75_ReKi, 0.75_ReKi /)*WS ! The davenport exponential parameter indicates that coh(v) ~ coh(w) in NWTC and LLLJP data - InCohB = 0.0_ReKi ! entire array is zero - - END SELECT - - !note that the IEC models specify their coherence parameters elsewhere... in CalcIECScalingParams() - -! IF ( p%met%IsIECModel ) THEN we'll get the defaults from CalcIECScalingParams - - -END SUBROUTINE GetDefaultCoh -!======================================================================= -!> This subroutine is used to get the default values of the Reynolds stresses. -!! sets p%met%PC_UW, p%met%PC_UV, p%met%PC_VW and -!! p%met%UWskip, p%met%UVskip, p%met%VWskip -SUBROUTINE GetDefaultRS( p, OtherSt_RandNum, TmpUstarHub, ErrStat, ErrMsg ) - - ! Needs p%grid information; calls getVelocityProfile(), also - ! depends on uHub, ZL, Rich_No, UStar - - TYPE(TurbSim_ParameterType), INTENT(INOUT) :: p ! TurbSim parameters - TYPE(RandNum_OtherStateType), INTENT(INOUT) :: OtherSt_RandNum ! other states for random numbers (next seed, etc) - - REAL(ReKi), INTENT(IN) :: TmpUstarHub - INTEGER(IntKi), intent( out) :: ErrStat ! Error level - CHARACTER(*), intent( out) :: ErrMsg ! Message describing error - - - REAL(ReKi) :: rndSgn - REAL(ReKi) :: SignProb - REAL(ReKi) :: Shr - REAL(ReKi) :: Ustar2 - REAL(ReKi) :: V(2) - REAL(ReKi) :: Z(2) - REAL(ReKi) :: ZLtmp - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(MaxMsgLen) :: ErrMsg2 - - - ErrStat = ErrID_None - ErrMsg = "" - - - Z(2) = p%grid%HubHt + 0.5*p%grid%RotorDiameter ! top of the grid - Z(1) = Z(2) - p%grid%GridHeight ! bottom of the grid - CALL getVelocityProfile(p, p%UHub, p%grid%HubHt, Z, V, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'GetDefaultRS') - - Shr = ( V(2)-V(1) ) / p%grid%GridHeight ! dv/dz - -!BJJ: check the ranges of our best-fit parameters, using domains of measured values - - SELECT CASE ( p%met%TurbModel_ID ) - CASE ( SpecModel_GP_LLJ ) - ZLtmp = MIN( MAX( p%met%ZL, -1.00_ReKi ), 1.0_ReKi ) !Limit the observed values of z/L - UStar2 = MIN( MAX( p%met%Ustar, 0.15_ReKi ), 1.0_ReKi ) !Limit the observed values of u* - Ustar2 = Ustar2*Ustar2 - CASE ( SpecModel_NWTCUP ) - ZLtmp = MIN( MAX( p%met%ZL, -0.5_ReKi ), 3.5_ReKi ) !Limit the observed values of z/L - UStar2 = MIN( MAX( p%met%Ustar, 0.2_ReKi ), 1.4_ReKi ) !Limit the observed values of u* - Ustar2 = Ustar2*Ustar2 -! CASE ( 'WF_UPW' ) -! CASE ( 'WF_07D' ) -! CASE ( 'WF_14D' ) - - CASE DEFAULT - ZLtmp = p%met%ZL - Ustar2 = p%met%Ustar*p%met%Ustar - END SELECT - - !------------------------------------------------------------------------------------------------- - ! default UW Reynolds stress - !------------------------------------------------------------------------------------------------- - p%met%UWskip = .FALSE. - - CALL RndUnif( p%RNG, OtherSt_RandNum, rndSgn ) - SELECT CASE ( p%met%TurbModel_ID ) - - CASE ( SpecModel_GP_LLJ ) - - p%met%PC_UW = TmpUstarHub**2 - - IF (p%met%PC_UW <= 0) THEN !We don't have a local u* value to tie it to; otherwise, assume p%met%PC_UW contains magnitude of value we want - IF ( p%grid%HubHt >= 100.5 ) THEN ! 116m - p%met%PC_UW = 0.0399 - 0.00371*p%UHub - 0.00182*p%met%RICH_NO + 0.00251*ZLtmp - 0.402*Shr + 1.033*Ustar2 - ELSEIF ( p%grid%HubHt >= 76.0 ) THEN ! 85 m - p%met%PC_UW = 0.00668 - 0.00184*p%UHub + 0.000709*p%met%RICH_NO + 0.264*Shr + 1.065*Ustar2 !magnitude - ELSEIF ( p%grid%HubHt >= 60.5 ) THEN ! 67 m - p%met%PC_UW = -0.0216 + 0.00319*p%UHub - 0.00205*ZLtmp + 0.206*Shr + 0.963*Ustar2 !magnitude - ELSE ! 54 m - p%met%PC_UW = -0.0373 + 0.00675*p%UHub - 0.00277*ZLtmp + 0.851*Ustar2 !magnitude - ENDIF - p%met%PC_UW = MAX(p%met%PC_UW,0.0_ReKi) - - ENDIF - - IF (p%met%PC_UW > 0) THEN - SignProb = 0.765 + 0.57/PI * ATAN( 0.78511*LOG(p%met%PC_UW)+3.42584) - IF (rndSgn <= SignProb) p%met%PC_UW = -p%met%PC_UW - ENDIF - - CASE ( SpecModel_NWTCUP ) - - IF ( p%grid%HubHt > 47.0 ) THEN ! 58m data - p%met%PC_UW = 0.165 - 0.0232*p%UHub - 0.0129*p%met%RICH_NO + 1.337*Ustar2 - 0.758*SHR - ELSEIF ( p%grid%HubHt >= 26.0 ) THEN ! 37m data - p%met%PC_UW = 0.00279 - 0.00139*p%UHub + 1.074*Ustar2 + 0.179*SHR - ELSE ! 15m data - p%met%PC_UW = -0.1310 + 0.0239*p%UHub + 0.556*Ustar2 - ENDIF - p%met%PC_UW = MAX(p%met%PC_UW,0.0_ReKi) - - IF (p%met%PC_UW > 0) THEN !i.e. not equal to zero - SignProb = 0.765 + 0.57/PI * ATAN( 0.88356*LOG(p%met%PC_UW)+2.47668) - IF (rndSgn <= SignProb) p%met%PC_UW = -p%met%PC_UW - ENDIF - - CASE ( SpecModel_WF_14D ) - - p%met%PC_UW = -Ustar2 - IF ( rndSgn > 0.9937 ) p%met%PC_UW = -p%met%PC_UW - - CASE ( SpecModel_USER, SpecModel_TimeSer ) - p%met%PC_UW = 0.0 - p%met%UWskip = .TRUE. - - CASE ( SpecModel_TIDAL, SpecModel_RIVER ) ! HYDROTURBSIM specific. - p%met%PC_UW = -Ustar2*(1-p%grid%HubHt/p%met%RefHt) - - CASE DEFAULT - - p%met%PC_UW = -Ustar2 - - END SELECT - - IF ( p%met%IsIECModel ) THEN - p%met%PC_UW = 0.0 - p%met%UWskip = .TRUE. - END IF - - !------------------------------------------------------------------------------------------------- - ! default UV Reynolds stress - !------------------------------------------------------------------------------------------------- - p%met%UVskip = .FALSE. - - CALL RndUnif( p%RNG, OtherSt_RandNum, rndSgn ) - SELECT CASE ( p%met%TurbModel_ID ) - - CASE ( SpecModel_GP_LLJ ) - - IF ( p%grid%HubHt >= 100.5 ) THEN ! 116m - p%met%PC_UV = 0.199 - 0.0167*p%UHub + 0.0115*ZLtmp + 1.143*Ustar2 - p%met%PC_UV = MAX(p%met%PC_UV,0.0_ReKi) - IF ( rndSgn < 0.6527 ) p%met%PC_UV = -p%met%PC_UV - ELSEIF ( p%grid%HubHt >= 76.0 ) THEN ! 85 m - p%met%PC_UV = 0.190 - 0.0156*p%UHub + 0.00931*ZLtmp + 1.101*Ustar2 - p%met%PC_UV = MAX(p%met%PC_UV,0.0_ReKi) - IF ( rndSgn < 0.6394 ) p%met%PC_UV = -p%met%PC_UV - ELSEIF ( p%grid%HubHt >= 60.5 ) THEN ! 67 m - p%met%PC_UV = 0.178 - 0.0141*p%UHub + 0.00709*ZLtmp + 1.072*Ustar2 - p%met%PC_UV = MAX(p%met%PC_UV,0.0_ReKi) - IF ( rndSgn < 0.6326 ) p%met%PC_UV = -p%met%PC_UV - ELSE ! 54 m - p%met%PC_UV = 0.162 - 0.0123*p%UHub + 0.00784*p%met%RICH_NO + 1.024*Ustar2 - p%met%PC_UV = MAX(p%met%PC_UV,0.0_ReKi) - IF ( rndSgn < 0.6191 ) p%met%PC_UV = -p%met%PC_UV - ENDIF - - CASE ( SpecModel_NWTCUP ) - - ! Get the magnitude and add the sign - IF ( p%grid%HubHt > 47.0 ) THEN ! 58m data - p%met%PC_UV = 0.669 - 0.0300*p%UHub - 0.0911*p%met%RICH_NO + 1.421*Ustar2 - 1.393*SHR - ELSEIF ( p%grid%HubHt >= 26.0 ) THEN ! 37m data - p%met%PC_UV = 1.521 - 0.00635*p%UHub - 0.2200*p%met%RICH_NO + 3.214*Ustar2 - 3.858*SHR - ELSE ! 15m data - p%met%PC_UV = 0.462 - 0.01400*p%UHub + 1.277*Ustar2 - ENDIF - p%met%PC_UV = MAX(p%met%PC_UV,0.0_ReKi) - IF (p%met%PC_UV > 0) THEN !i.e. not equal to zero - SignProb = 0.33 + 0.64/PI * ATAN( -0.374775*LOG(p%met%PC_UV)-0.205681) - IF (rndSgn <= SignProb) p%met%PC_UV = -p%met%PC_UV - ENDIF - - CASE ( SpecModel_WF_UPW ) - - p%met%PC_UV = 0.0202 + 0.890*Ustar2 - 2.461*Shr - p%met%PC_UV = MAX(p%met%PC_UV,0.0_ReKi) - IF ( rndSgn < 0.7315 ) p%met%PC_UV = -p%met%PC_UV - - CASE ( SpecModel_WF_07D ) - - p%met%PC_UV = 0.5040 + 0.177*Ustar2 - p%met%PC_UV = MAX(p%met%PC_UV,0.0_ReKi) - IF ( rndSgn < 0.7355 ) p%met%PC_UV = -p%met%PC_UV - - CASE ( SpecModel_WF_14D ) - - p%met%PC_UV = 0.0430 + 0.258*Ustar2 - p%met%PC_UV = MAX(p%met%PC_UV,0.0_ReKi) - IF ( rndSgn < 0.4423 ) p%met%PC_UV = -p%met%PC_UV - - CASE DEFAULT - - p%met%PC_UV = 0.0 - p%met%UVskip = .TRUE. !use whatever comes our way from the random phases - - END SELECT - - - !------------------------------------------------------------------------------------------------- - ! default VW Reynolds stress - !------------------------------------------------------------------------------------------------- - p%met%VWskip = .FALSE. - - CALL RndUnif( p%RNG, OtherSt_RandNum, rndSgn ) - SELECT CASE ( p%met%TurbModel_ID ) - - CASE ( SpecModel_GP_LLJ ) - - IF ( p%grid%HubHt >= 100.5 ) THEN ! 116m - p%met%PC_VW = 0.0528 - 0.00210*p%UHub - 0.00531*p%met%RICH_NO - 0.519*Shr + 0.283*Ustar2 - p%met%PC_VW = MAX(p%met%PC_VW,0.0_ReKi) - IF ( rndSgn < 0.2999 ) p%met%PC_VW = -p%met%PC_VW - ELSEIF ( p%grid%HubHt >= 76.0 ) THEN ! 85 m - p%met%PC_VW = 0.0482 - 0.00264*p%UHub - 0.00391*p%met%RICH_NO - 0.240*Shr + 0.265*Ustar2 - p%met%PC_VW = MAX(p%met%PC_VW,0.0_ReKi) - IF ( rndSgn < 0.3061 ) p%met%PC_VW = -p%met%PC_VW - ELSEIF ( p%grid%HubHt >= 60.5 ) THEN ! 67 m - p%met%PC_VW = 0.0444 - 0.00249*p%UHub - 0.00403*p%met%RICH_NO - 0.141*Shr + 0.250*Ustar2 - p%met%PC_VW = MAX(p%met%PC_VW,0.0_ReKi) - IF ( rndSgn < 0.3041 ) p%met%PC_VW = -p%met%PC_VW - ELSE ! 54 m - p%met%PC_VW = 0.0443 - 0.00261*p%UHub - 0.00371*p%met%RICH_NO - 0.107*Shr + 0.226*Ustar2 - p%met%PC_VW = MAX(p%met%PC_VW,0.0_ReKi) - IF ( rndSgn < 0.3111 ) p%met%PC_VW = -p%met%PC_VW - ENDIF - - CASE ( SpecModel_NWTCUP ) - - IF ( p%grid%HubHt > 47.0 ) THEN ! 58m data - p%met%PC_VW = 0.174 + 0.00154*p%UHub - 0.0270*p%met%RICH_NO + 0.380*Ustar2 - 1.131*Shr - 0.00741*ZLtmp - ELSEIF ( p%grid%HubHt >= 26.0 ) THEN ! 37m data - p%met%PC_VW = 0.120 + 0.00283*p%UHub - 0.0227*p%met%RICH_NO + 0.306*Ustar2 - 0.825*Shr - ELSE ! 15m data - p%met%PC_VW = 0.0165 + 0.00833*p%UHub + 0.224*Ustar2 - ENDIF - p%met%PC_VW = MAX(p%met%PC_VW,0.0_ReKi) - IF (p%met%PC_VW > 0) THEN !i.e. not equal to zero - SignProb = 0.725 + 0.65/PI * ATAN( 0.654886_ReKi*LOG(p%met%PC_VW)+1.777198_ReKi) - IF (rndSgn <= SignProb) p%met%PC_VW = -p%met%PC_VW - ENDIF - - CASE ( SpecModel_WF_UPW ) - - p%met%PC_VW = 0.0263 + 0.273*Ustar2 - 0.684*Shr - p%met%PC_VW = MAX(p%met%PC_VW,0.0_ReKi) - IF ( rndSgn < 0.3139_ReKi ) p%met%PC_VW = -p%met%PC_VW - - CASE ( SpecModel_WF_07D ) - - p%met%PC_VW = 0.241 + 0.118*Ustar2 - p%met%PC_VW = MAX(p%met%PC_VW,0.0_ReKi) - IF ( rndSgn < 0.0982_ReKi ) p%met%PC_VW = -p%met%PC_VW - - CASE ( SpecModel_WF_14D ) - - p%met%PC_VW =-0.0224 + 0.159*Ustar2 - p%met%PC_VW = MAX(p%met%PC_VW,0.0_ReKi) - IF ( rndSgn < 0.8436_ReKi ) p%met%PC_VW = -p%met%PC_VW - - CASE DEFAULT - - p%met%PC_VW = 0.0 - p%met%VWskip = .TRUE. !use whatever comes our way from the random phases - - END SELECT - - -RETURN -END SUBROUTINE GetDefaultRS -!======================================================================= -!< This function calculates the default power law exponent. -FUNCTION DefaultPowerLawExp( p ) - -! necessary requirements: -! Rich_No, KHtest, TurbModel_ID, IEC_WindType, IECstandard - - - IMPLICIT NONE - - TYPE(TurbSim_ParameterType), INTENT(IN) :: p !< parameters - REAL(ReKi) :: DefaultPowerLawExp !< Default Power Law exponent for particular model - - IF ( p%met%KHtest ) THEN - DefaultPowerLawExp = 0.3 - RETURN - ENDIF - - SELECT CASE ( p%met%TurbModel_ID ) - - CASE (SpecModel_WF_UPW, SpecModel_NWTCUP) - IF ( p%met%RICH_NO > 0.0 ) THEN - DefaultPowerLawExp = 0.14733 - ELSE - DefaultPowerLawExp = 0.087687698 + 0.059641545*EXP(p%met%RICH_NO/0.04717783) - ENDIF - - CASE ( SpecModel_WF_07D, SpecModel_WF_14D ) - IF ( p%met%RICH_NO > 0.04 ) THEN - DefaultPowerLawExp = 0.17903 - ELSE - DefaultPowerLawExp = 0.127704032 + 0.031228952*EXP(p%met%RICH_NO/0.0805173) - ENDIF - - CASE (SpecModel_SMOOTH, SpecModel_GP_LLJ, SpecModel_TIDAL, SpecModel_RIVER, SpecModel_TimeSer ) - ! A 1/7 power law seems to work ok for HYDRO spectral models also... - DefaultPowerLawExp = 0.143 - - CASE DEFAULT - IF ( p%IEC%IEC_WindType == IEC_EWM1 .OR. p%IEC%IEC_WindType == IEC_EWM50 .OR. p%IEC%IEC_WindType == IEC_EWM100 ) THEN - DefaultPowerLawExp = 0.11 ! [IEC 61400-1 6.3.2.1 (14)] - ELSEIF ( p%IEC%IECstandard == 3 ) THEN - DefaultPowerLawExp = 0.14 ! [IEC 61400-3 Page 22 (3)] - ELSE - DefaultPowerLawExp = 0.2 ! [IEC 61400-1 6.3.1.2 (10)] - ENDIF - - END SELECT - - RETURN -END FUNCTION DefaultPowerLawExp -!======================================================================= -FUNCTION getUstarDiab(u_ref, z_ref, z0, ZL) - - - IMPLICIT NONE - - REAL(ReKi), INTENT(IN) :: u_ref ! Wind speed at reference height - REAL(ReKi), INTENT(IN) :: z_ref ! Reference height - REAL(ReKi), INTENT(IN) :: z0 ! Surface roughness length -- It must be > 0 (which we've already checked for) - REAL(ReKi), INTENT(IN) :: ZL ! M-O stability parameter - - REAL(ReKi) :: tmp ! a temporary value - REAL(ReKi) :: psiM - REAL(ReKi) :: getUstarDiab ! the diabatic u* value (u*0) - - IF ( ZL >= 0 ) THEN !& ZL < 1 - psiM = -5.0*MIN(ZL, REAL(1.0,ReKi) ) - ELSE - tmp = (1.0 - 15.0*ZL)**0.25 - - !psiM = -2.0*LOG( (1.0 + tmp)/2.0 ) - LOG( (1.0 + tmp*tmp)/2.0 ) + 2.0*ATAN( tmp ) - 0.5 * PI - psiM = -LOG( 0.125 * ( (1.0 + tmp)**2 * (1.0 + tmp*tmp) ) ) + 2.0*ATAN( tmp ) - 0.5 * PI - - !bjj 11-may-2016: because of the negative sign in the equation below, I believe psiM needs to switch signs. - ! if true, this has been implemented incorrectly for at least 15 years. - psiM = -psiM - - ENDIF - - getUstarDiab = ( 0.4 * u_ref ) / ( LOG( z_ref / z0 ) - psiM ) - -END FUNCTION getUstarDiab -!======================================================================= -!> this routine calculates the M-O z/L and L parameters using -!! Rich_No, SpecModel, and HubHt -SUBROUTINE Calc_MO_zL(SpecModel, Rich_No, HubHt, ZL, L ) - - - IMPLICIT NONE - - REAL(ReKi) , intent(in) :: HubHt ! Hub height - REAL(ReKi) , intent(in) :: RICH_NO ! Gradient Richardson number - REAL(ReKi) , intent( out) :: L ! M-O length - REAL(ReKi) , intent( out) :: ZL ! A measure of stability - - INTEGER(IntKi), intent(in) :: SpecModel ! Integer value of spectral model (see SpecModel enum) - - - ! ***** Calculate M-O z/L parameter : z/L is a number in (-inf, 1] ***** - - IF ( SpecModel == SpecModel_NWTCUP ) THEN - ! Calculate disk averaged Z/L from turbine layer Ri for NWTC/LIST experiment - - IF ( RICH_NO <= -0.1 ) THEN - ZL = -0.254 + 1.047*RICH_NO - ELSEIF ( RICH_NO < 0 ) THEN - ZL = 10.369*RICH_NO/(1.0 - 19.393*RICH_NO) - ELSE !( RICH_NO < 0.155 ) THEN - ZL = 2.535*MIN( RICH_NO, 0.155_ReKi ) / (1.0 - 6.252*MIN( RICH_NO, 0.155_ReKi )) - ENDIF - - - ELSEIF (SpecModel == SpecModel_GP_LLJ) THEN - - IF ( RICH_NO <= -0.1 ) THEN - ZL = -0.047 + 1.054*RICH_NO - ELSEIF ( RICH_NO < 0 ) THEN - ZL = 2.213*RICH_NO/(1.0 - 4.698*RICH_NO) - ELSE !( RICH_NO < 0.1367 ) THEN - ZL = 3.132*MIN( RICH_NO, 0.1367_ReKi ) / (1.0 - 6.762*MIN( RICH_NO, 0.1367_ReKi )) - ENDIF - - ELSE ! see Businger, J.A.; Wyngaard, J.C.; Izumi, Y.; Bradley, E.F. (1971). "Flux-Profile Relationships in the Atmospheric Surface Layer." Journal of the Atmospheric Sciences (28); pp.181-189. - - IF ( RICH_NO <= 0.0_ReKi ) THEN - ZL = RICH_NO - !PhiM = (1.0 - 16.0*ZL)**-0.25 - ELSEIF ( RICH_NO < 0.16667_ReKi ) THEN - ZL = MIN(RICH_NO / ( 1.0_ReKi - 5.0_ReKi*RICH_NO ), 1.0_ReKi ) ! The MIN() will take care of rounding issues. - !PhiM = (1.0 + 5.0*ZL) - ELSE - ZL = 1.0_ReKi - ENDIF - - ENDIF !SpecModels - - ZL = MIN( ZL, 1.0_ReKi ) - - - ! ***** Calculate M-O length scale, L [meters] ***** - ! L should be constant in the surface layer - - IF ( .NOT. EqualRealNos(ZL , 0.0_ReKi) ) THEN - L = HubHt / ZL ! Since ZL is the average ZL over the rotor disk, we should use HubHt to estimate L instead - ELSE - L = HUGE( L ) - ENDIF - - -END SUBROUTINE Calc_MO_zL -!======================================================================= -SUBROUTINE CalcIECScalingParams( p_IEC, HubHt, UHub, InCDec, InCohB, TurbModel_ID, IsIECModel, ErrStat, ErrMsg ) -! REQUires these be set prior to calling:NumTurbInp, IECedition, IECTurbC, IEC_WindType, IsIECModel -! calculates SigmaIEC, Lambda, IntegralScale, Lc - - TYPE(IEC_ParameterType), INTENT(INOUT) :: p_IEC ! parameters for IEC models - REAL(ReKi) , INTENT(IN) :: HubHt ! Hub-height - REAL(ReKi) , INTENT(IN) :: UHub ! Hub-height (total) wind speed (m/s) - - REAL(ReKi) , INTENT(OUT) :: InCDec (3) ! Contains the coherence decrements - REAL(ReKi) , INTENT(OUT) :: InCohB (3) ! Contains the coherence b/L (offset) parameters - INTEGER(IntKi) , INTENT(IN) :: TurbModel_ID ! Integer value of spectral model (see SpecModel enum) - LOGICAL , INTENT(IN) :: IsIECModel ! Determines if this is actually an IEC model, or if we just set the values to 0 and return - INTEGER(IntKi), intent( out) :: ErrStat !< Error level - CHARACTER(*), intent( out) :: ErrMsg !< Message describing error - - - ErrStat = ErrID_None - ErrMsg = "" - - IF ( .NOT. IsIECModel ) THEN - - p_IEC%SigmaIEC = 0 - p_IEC%Lambda = 0 - p_IEC%IntegralScale = 0 - p_IEC%LC = 0.0 ! The length scale is not defined for the non-IEC models - - RETURN - - ENDIF ! TurbModel == 'IECKAI', 'IECVKM', 'API', or 'MODVKM' - - - - ! If IECKAI or IECVKM spectral models are specified, determine turb intensity - ! and slope of Sigma wrt wind speed from IEC turbulence characteristic, - ! IECTurbC = A, B, or C or from user specified quantity. - - - IF ( p_IEC%NumTurbInp ) THEN - - ! user specified a particular percent TI: - - p_IEC%TurbInt = 0.01*p_IEC%PerTurbInt - p_IEC%SigmaIEC(1) = p_IEC%TurbInt*UHub - - ! bjj: note Vave isn't set in this case, but we only print it to the summary file (and use it) if .not. NumTurbInp - - ELSE - - - SELECT CASE (p_IEC%IECedition) - - CASE ( 2 ) - - IF ( p_IEC%IECTurbC == 'A' ) THEN - p_IEC%TurbInt15 = 0.18 - p_IEC%SigmaSlope = 2.0 - ELSEIF ( p_IEC%IECTurbC == 'B' ) THEN - p_IEC%TurbInt15 = 0.16 - p_IEC%SigmaSlope = 3.0 - ELSE ! We should never get here, but just to be complete... - ErrStat = ErrID_Fatal - ErrMsg = 'CalcIECScalingParams: Invalid IEC turbulence characteristic.' - RETURN - ENDIF - - p_IEC%SigmaIEC(1) = p_IEC%TurbInt15*( ( 15.0 + p_IEC%SigmaSlope*UHub ) / ( p_IEC%SigmaSlope + 1.0 ) ) - p_IEC%TurbInt = p_IEC%SigmaIEC(1)/UHub - - CASE ( 3 ) - - IF ( p_IEC%IECTurbC == 'A' ) THEN - p_IEC%TurbInt15 = 0.16 - ELSEIF ( p_IEC%IECTurbC == 'B' ) THEN - p_IEC%TurbInt15 = 0.14 - ELSEIF ( p_IEC%IECTurbC == 'C' ) THEN - p_IEC%TurbInt15 = 0.12 - ELSE ! We should never get here, but just to be complete... - ErrStat = ErrID_Fatal - ErrMsg = 'CalcIECScalingParams: Invalid IEC turbulence characteristic.' - RETURN - ENDIF - - - SELECT CASE ( p_IEC%IEC_WindType ) - CASE ( IEC_NTM ) - p_IEC%SigmaIEC(1) = p_IEC%TurbInt15*( 0.75*UHub + 5.6 ) ! [IEC-1 Ed3 6.3.1.3 (11)] - CASE ( IEC_ETM ) - p_IEC%Vave = 0.2*p_IEC%Vref ! [IEC-1 Ed3 6.3.1.1 ( 9)] - p_IEC%SigmaIEC(1) = p_IEC%ETMc * p_IEC%TurbInt15 * ( 0.072 * & - ( p_IEC%Vave / p_IEC%ETMc + 3.0) * (Uhub / p_IEC%ETMc - 4.0)+10.0 ) ! [IEC-1 Ed3 6.3.2.3 (19)] - CASE ( IEC_EWM1, IEC_EWM50, IEC_EWM100 ) - p_IEC%Vave = 0.2*p_IEC%Vref ! [IEC-1 Ed3 6.3.1.1 ( 9)] - p_IEC%SigmaIEC(1) = 0.11*Uhub ! [IEC-1 Ed3 6.3.2.1 (16)] - CASE DEFAULT - ErrStat = ErrID_Fatal - ErrMsg = 'CalcIECScalingParams: Invalid IEC wind type.' - RETURN - END SELECT - p_IEC%TurbInt = p_IEC%SigmaIEC(1)/UHub - - CASE DEFAULT ! Likewise, this should never happen... - - ErrStat = ErrID_Fatal - ErrMsg = 'CalcIECScalingParams: Invalid IEC 61400-1 edition number.' - RETURN - - END SELECT - - - ENDIF - - ! note PLExp for IEC is set elsewhere - - ! IEC turbulence scale parameter, Lambda(1), and IEC coherency scale parameter, LC - - IF ( p_IEC%IECedition == 2 ) THEN - - ! section 6.3.1.3 Eq. 9 - IF ( HubHt < 30.0_ReKi ) THEN - p_IEC%Lambda(1) = 0.7*HubHt - ELSE - p_IEC%Lambda(1) = 21.0 - ENDIF - - p_IEC%LC = 3.5*p_IEC%Lambda(1) - InCDec = (/ 8.80_ReKi, HUGE(p_IEC%LC), HUGE(p_IEC%LC) /) ! u-, v-, and w-component coherence decrement - - ELSE !IF (p_IEC%IECedition == 3 ) THEN - - ! section 6.3.1.3 Eq. 9 - - IF ( HubHt < 60.0_ReKi ) THEN - p_IEC%Lambda(1) = 0.7*HubHt - ELSE - p_IEC%Lambda(1) = 42.0 - ENDIF - - p_IEC%LC = 8.1*p_IEC%Lambda(1) - InCDec = (/ 12.00_ReKi, HUGE(p_IEC%LC), HUGE(p_IEC%LC) /) ! u-, v-, and w-component coherence decrement for IEC Ed. 3 - - ENDIF - - InCohB = (/ 0.12_ReKi/p_IEC%LC, 0.0_ReKi, 0.0_ReKi /) - - - ! Set Lambda for Modified von Karman model: -#ifdef MVK -!bjj: this will probably need to be rethought with TurbSim v2.0 - IF ( MVK .AND. TurbModel_ID == SpecModel_MODVKM ) THEN - p%met%z0 = FindZ0(HubHt, p_IEC%SigmaIEC(1), UHub, p%met%Fc) - CALL ScaleMODVKM(HubHt, UHub, p_IEC%Lambda(1), p_IEC%Lambda(2), p_IEC%Lambda(3)) - ENDIF -#endif - - ! Sigma for v and w components and - ! Integral scales (which depend on lambda) - - IF ( TurbModel_ID == SpecModel_IECVKM ) THEN - - p_IEC%SigmaIEC(2) = 1.0*p_IEC%SigmaIEC(1) - p_IEC%SigmaIEC(3) = 1.0*p_IEC%SigmaIEC(1) - - p_IEC%IntegralScale(:) = 3.5 *p_IEC%Lambda(1) !L_k - - ELSE - - p_IEC%SigmaIEC(2) = 0.8*p_IEC%SigmaIEC(1) - p_IEC%SigmaIEC(3) = 0.5*p_IEC%SigmaIEC(1) - - p_IEC%IntegralScale(1) = 8.1 *p_IEC%Lambda(1) !L_k - p_IEC%IntegralScale(2) = 2.7 *p_IEC%Lambda(1) !L_k - p_IEC%IntegralScale(3) = 0.66*p_IEC%Lambda(1) !L_k - - END IF - - - -END SUBROUTINE CalcIECScalingParams -!======================================================================= -!> Routine sets the default ETMc, WindProfileType, Z0, Latitude, CohExp. -!! These depend on p%met%TurbModel_ID and p%usr%NPoints. -!! -!! URef, ZJetMax, and PLExp are initialized, but cannot calculate their -!! default values until the richardson number or ustar are set. -SUBROUTINE DefaultMetBndryCndtns(p) - - -TYPE(TurbSim_ParameterType), INTENT(INOUT) :: p !< TurbSim parameters - - ! default ETMc - p%IEC%ETMc = 2.0_ReKi - - - ! default WindProfileType - SELECT CASE ( p%met%TurbModel_ID ) - CASE ( SpecModel_TimeSer ) - IF ( p%usr%NPoints > 1 ) THEN - p%met%WindProfileType = 'TS' - ELSE - p%met%WindProfileType = 'PL' - call WrScr( 'Warning: WindProfileType will default to power-law profile because only one time-series point was entered.') - END IF - CASE ( SpecModel_GP_LLJ ) - p%met%WindProfileType = 'JET' - - CASE ( SpecModel_TIDAL ) - p%met%WindProfileType = 'H2L' - - CASE ( SpecModel_USRVKM ) - p%met%WindProfileType = 'USR' - - CASE ( SpecModel_API ) - p%met%WindProfileType = 'API' ! ADDED BY YG - - CASE DEFAULT - p%met%WindProfileType = 'IEC' - END SELECT - - - ! Initialize ZJetMax (will need to set default later) - p%met%ZJetMax = 0.0_ReKi - - ! Initialize URef (will need to set default later) - p%met%URef = 0.0_ReKi - - ! Initialize PLExp (will need to set default later) - p%met%PLExp = 0.0_ReKi ! DefaultPowerLawExp( p ) For some models, this routine requires RICH_NO, which we do not know, yet. We'll call DefaultPowerLawExp later for all cases - - ! Default Z0 - SELECT CASE ( p%met%TurbModel_ID ) - CASE (SpecModel_SMOOTH) - p%met%Z0 = 0.010 - CASE (SpecModel_GP_LLJ ) - p%met%Z0 = 0.005 - CASE (SpecModel_WF_UPW ) - p%met%Z0 = 0.018 - CASE (SpecModel_NWTCUP ) - p%met%Z0 = 0.021 - CASE (SpecModel_WF_07D ) - p%met%Z0 = 0.233 - CASE (SpecModel_WF_14D ) - p%met%Z0 = 0.064 - CASE DEFAULT !IEC values - p%met%Z0 = 0.030 ! Represents smooth, homogenous terrain - END SELECT - - ! Default Latitude - p%met%Latitude = 45.0 - - ! Default CohExp - p%met%CohExp = 0.0 ! was 0.25 - - -END SUBROUTINE DefaultMetBndryCndtns -!======================================================================= -!> Calculate the default mixing layer depth, ZI, -!! based on Ustar, UstarDiab, Uref, RefHt, Z0, Fc -SUBROUTINE DefaultMixingLayerDepth(p) -! - TYPE(TurbSim_ParameterType), INTENT(INOUT) :: p !< TurbSim parameters - - IF ( p%met%Ustar < p%met%UstarDiab ) THEN - p%met%ZI = ( 0.04 * p%met%Uref ) / ( 1.0E-4 * LOG10( p%met%RefHt / p%met%Z0 ) ) !for "very" windy days - ELSE - !Should Wind Farm models use the other definition since that was what was used in creating those models? - p%met%ZI = p%met%Ustar / (6.0 * p%met%Fc) - ENDIF - -END SUBROUTINE DefaultMixingLayerDepth -!======================================================================= -!> Calculate the default UStar value, based on -!! UstarDiab (URef, RefHt, Z0, ZL), TurbModel_ID, ZL, URef -SUBROUTINE DefaultUstar(p) - - TYPE(TurbSim_ParameterType), INTENT(INOUT) :: p !< TurbSim parameters - - - p%met%UstarDiab = getUstarDiab(p%met%URef, p%met%RefHt, p%met%z0, p%met%ZL) - SELECT CASE ( p%met%TurbModel_ID ) - - CASE (SpecModel_WF_UPW) - - IF ( p%met%ZL < 0.0 ) THEN - p%met%Ustar = 1.162 * p%met%UstarDiab**( 2.0 / 3.0 ) - ELSE ! Include the neutral case to avoid strange discontinuities - p%met%Ustar = 0.911 * p%met%UstarDiab**( 2.0 / 3.0 ) - ENDIF - - CASE ( SpecModel_WF_07D, SpecModel_WF_14D ) - - IF ( p%met%ZL < 0.0 ) THEN - p%met%Ustar = 1.484 * p%met%UstarDiab**( 2.0 / 3.0 ) - ELSE ! Include the neutral case with the stable one to avoid strange discontinuities - p%met%Ustar = 1.370 * p%met%UstarDiab**( 2.0 / 3.0 ) - ENDIF - - CASE (SpecModel_GP_LLJ ) - p%met%Ustar = 0.17454 + 0.72045*p%met%UstarDiab**1.36242 - - CASE ( SpecModel_NWTCUP ) - p%met%Ustar = 0.2716 + 0.7573*p%met%UstarDiab**1.2599 - - CASE ( SpecModel_TIDAL , SpecModel_RIVER ) - ! Use a constant drag coefficient for the HYDRO spectral models. - p%met%Ustar = p%met%Uref*0.05 ! This corresponds to a drag coefficient of 0.0025. - !p%met%Ustar = p%met%Uref*0.04 ! This corresponds to a drag coefficient of 0.0016. - - CASE DEFAULT - p%met%Ustar = p%met%UstarDiab - - END SELECT -END SUBROUTINE DefaultUstar -!======================================================================= -!> Calculate the default ZJetMax value, based on -!! Rich_No, ZL, Ustar, plus A random amount -SUBROUTINE DefaultZJetMax(p, OtherSt_RandNum) - - TYPE(TurbSim_ParameterType), INTENT(INOUT) :: p !< TurbSim parameters - TYPE(RandNum_OtherStateType),INTENT(INOUT) :: OtherSt_RandNum !< other states for random numbers (next seed, etc) - - REAL(ReKi) :: RandomValue - - - ! values based on Neil Kelley's analysis - p%met%ZJetMax = -14.820561*p%met%Rich_No + 56.488123*p%met%ZL + 166.499069*p%met%Ustar + 188.253377 - p%met%ZJetMax = 1.9326 *p%met%ZJetMax - 252.7267 ! Correct with the residual - - CALL RndJetHeight( p%RNG, OtherSt_RandNum, RandomValue ) ! Add a random amount - - p%met%ZJetMax = MIN( MAX(p%met%ZJetMax + RandomValue, ZJetMax_LB ), ZJetMax_UB ) - -END SUBROUTINE DefaultZJetMax -!======================================================================= -!!> Calculate the default UStar value, based on -!!! UstarDiab, TurbModel_ID, ZL, URef -!SUBROUTINE Default(p) -! -! TYPE(TurbSim_ParameterType), INTENT(INOUT) :: p !< TurbSim parameters -! -!END SUBROUTINE Default - -!======================================================================= -!< Routine to set parameters for the JET profile: UJetMax, ChebyCoef_WS, ChebyCoef_WD -!! will also calculate default URef if requested. -!! needs ZJetMax, RefHt, URef (unless asked to calculated here) set prior to calling -SUBROUTINE getJetCoeffs( p, getDefaultURef, OtherSt_RandNum, ErrStat, ErrMsg ) - - TYPE(TurbSim_ParameterType), INTENT(INOUT) :: p !< parameters for TurbSim - TYPE(RandNum_OtherStateType), INTENT(INOUT) :: OtherSt_RandNum !< other states for random number generation - LOGICAL , INTENT(IN ) :: getDefaultURef !< determines if we also calculate a default URef - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< error level/status - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< error message - - ! local variables - REAL(ReKi) :: RandomValue - REAL(ReKi) :: URef - INTEGER(IntKi) :: ErrStat2 - CHARACTER(MaxMsgLen) :: ErrMsg2 - - ErrStat = ErrID_None - ErrMsg = "" - - - IF ( getDefaultURef ) THEN ! Calculate a default value - - p%met%UJetMax = MAX( -21.5515_ReKi + 6.6827_ReKi*LOG(p%met%ZJetMax), 5.0_ReKi ) !Jet max must be at least 5 m/s (occurs ~50 m); shouldn't happen, but just in case.... - - CALL Rnd3ParmNorm( p%RNG, OtherSt_RandNum, RandomValue, 0.1076_ReKi, -0.1404_ReKi, 3.6111_ReKi, -15.0_ReKi, 20.0_ReKi, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'getJetCoeffs') - - IF (p%met%UJetMax + RandomValue > 0 ) p%met%UJetMax = p%met%UJetMax + RandomValue - - CALL GetChebCoefs( p, .TRUE. , ErrStat2, ErrMsg2 ) ! These coefficients are a function of UJetMax, ZJetMax, RICH_NO, and p%met%Ustar - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'getJetCoeffs') - - CALL getVelocity(p, p%met%UJetMax, p%met%ZJetMax, p%met%RefHt, URef, ErrStat2, ErrMsg2) - p%met%URef = URef - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'getJetCoeffs') - - - ELSE !IF ( trim(p%met%WindProfileType) == 'JET' ) then - IF ( EqualRealNos( p%met%RefHt, p%met%ZJetMax ) ) THEN - p%met%UJetMax = p%met%URef - CALL GetChebCoefs( p, .TRUE. , ErrStat2, ErrMsg2 ) ! These coefficients are a function of UJetMax, ZJetMax, RICH_NO, and p%met%Ustar - ELSE - CALL GetChebCoefs(p, .FALSE., ErrStat2, ErrMsg2) ! also calculate p%met%UJetMax - END IF - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'getJetCoeffs') - - ENDIF !Jet wind profile - -END SUBROUTINE getJetCoeffs -!======================================================================= - -END MODULE TS_FileIO diff --git a/OpenFAST/modules/turbsim/src/TSsubs.f90 b/OpenFAST/modules/turbsim/src/TSsubs.f90 deleted file mode 100644 index f8b50992f..000000000 --- a/OpenFAST/modules/turbsim/src/TSsubs.f90 +++ /dev/null @@ -1,2536 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2014, 2016 National Renewable Energy Laboratory -! -! This file is part of TurbSim. -! -! 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. -! -!********************************************************************************************************************************** -MODULE TSSubs - - USE ModifiedvKrm_mod - - use TS_Profiles - use TS_RandNum - use TS_VelocitySpectra - USE NWTC_FFTPACK - USE NWTC_LAPACK - - - IMPLICIT NONE - - - -CONTAINS - -!======================================================================= -!> This subroutine returns the complex Fourier coefficients (packed in a -!! 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 ) - -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 -INTEGER(IntKi), INTENT(OUT) :: ErrStat -CHARACTER(*), INTENT(OUT) :: ErrMsg - - - ! Internal variables - -REAL(ReKi), ALLOCATABLE :: Dist(:) ! The distance between points -REAL(ReKi), ALLOCATABLE :: DistU(:) - -INTEGER :: J -INTEGER :: I -INTEGER :: IFreq -INTEGER :: Indx -INTEGER :: IVec ! wind component, 1=u, 2=v, 3=w - -INTEGER(IntKi) :: ErrStat2 -CHARACTER(MaxMsgLen) :: ErrMsg2 - - - - ErrStat = ErrID_None - ErrMsg = "" - - 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 - - - !-------------------------------------------------------------------------------- - ! Calculate the distances and other parameters that don't change with frequency - !--------------------------------------------------------------------------------- - - ! Calculate Dist array (distance between points I and J) - ! and the DistU term, i.e., (r/u): u is uHub for IEC - Indx=0 - DO J=1,p%grid%NPoints - DO I=J,p%grid%NPoints ! The coherence matrix is symmetric so we're going to skip the other side - Indx = Indx + 1 - Dist(Indx) = SQRT( ( p%grid%Y(I) - p%grid%Y(J) )**2 + ( p%grid%Z(I) - p%grid%Z(J) )**2 ) - DistU(Indx) = Dist(Indx)/p%UHub - END DO ! I - END DO ! J - - - !-------------------------------------------------------------------------------- - ! Calculate the fourier coefficients - !--------------------------------------------------------------------------------- - - DO IVec = 1,3 - - IF (p%met%SCMod(IVec) /= CohMod_IEC) CYCLE ! Check the next component (this one doesn't use the IEC method) - - V(:,:,IVec) = 0.0_ReKi - - CALL WrScr ( ' '//Comp(IVec)//'-component matrices (IEC coherence method)' ) - - !-------------------------------------------------------------------------------- - ! Calculate the coherence, Veers' H matrix (CSDs), and the fourier coefficients - !--------------------------------------------------------------------------------- - - DO IFREQ = 1,p%grid%NumFreq - ! ----------------------------------------------- - ! Create the coherence matrix for this frequency - ! ----------------------------------------------- - Indx = 1 - DO J = 1,p%usr%NPoints-1 ! start with the user-defined points (which don't get added coherence) - - TRH(Indx) = 1.0_ReKi - Indx = Indx + 1 - - DO I=J+1,p%grid%NPoints - TRH(Indx) = 0.0_ReKi - Indx = Indx + 1 - END DO !I - - END DO !J - - - DO J=max(1, p%usr%NPoints),p%grid%NPoints - DO I=J,p%grid%NPoints - - TRH(Indx) = EXP( -1.0_ReKi * p%met%InCDec(IVec) * & - SQRT( (p%grid%Freq(IFreq)*DistU(Indx) )**2 + (p%met%InCohB(IVec)*Dist(Indx))**2 ) ) - - Indx = Indx + 1 - - ENDDO ! I - ENDDO ! J - - ! ----------------------------------------------- - ! Now transform coherence to H matrix and then - ! use H matrix to calculate coefficients - ! ----------------------------------------------- - - CALL Coh2H( p, IVec, IFreq, TRH, S, ErrStat2, ErrMsg2 ) - 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 - - 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 -!======================================================================= -!> This subroutine returns the complex Fourier coefficients (packed in a -!! real array) of the simulated velocity (wind/water speed). It returns -!! values FOR ONLY the velocity components that use the general method for -!! computing spatial coherence; i.e., for i where SCMod(i) == CohMod_GENERAL -SUBROUTINE CalcFourierCoeffs_General( p, U, PhaseAngles, S, V, TRH, 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 -INTEGER(IntKi), INTENT(OUT) :: ErrStat -CHARACTER(*), INTENT(OUT) :: ErrMsg - - - ! Internal variables - -INTEGER :: UC ! I/O unit for Coherence debugging file. -LOGICAL, PARAMETER :: COH_OUT = .FALSE. ! This parameter has been added to replace the NON-STANDARD compiler directive previously used - -REAL(ReKi), ALLOCATABLE :: Dist(:) ! The distance between points -REAL(ReKi), ALLOCATABLE :: DistU(:) -REAL(ReKi), ALLOCATABLE :: DistZMExp(:) - -REAL(ReKi) :: dY ! the lateral distance between two points -REAL(ReKi) :: UM ! The mean wind speed of the two points -REAL(ReKi) :: ZM ! The mean height of the two points - -INTEGER :: J -INTEGER :: I -INTEGER :: IFreq -INTEGER :: Indx -INTEGER :: IVec ! wind component, 1=u, 2=v, 3=w - -INTEGER(IntKi) :: ErrStat2 -CHARACTER(MaxMsgLen) :: ErrMsg2 - - - - ErrStat = ErrID_None - ErrMsg = "" - - IF (.NOT. ANY(p%met%SCMod == CohMod_GENERAL) ) RETURN - - - !-------------------------------------------------------------------------------- - ! allocate arrays - !-------------------------------------------------------------------------------- - CALL AllocAry( Dist, p%grid%NPacked, 'Dist coherence array', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs_General') - CALL AllocAry( DistU, p%grid%NPacked, 'DistU coherence array', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs_General') - CALL AllocAry( DistZMExp, p%grid%NPacked, 'DistZMExp coherence array', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs_General') - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - - !-------------------------------------------------------------------------------- - ! Calculate the distances and other parameters that don't change with frequency - !--------------------------------------------------------------------------------- - - ! Calculate Dist array (distance between points I and J) - IF ( .NOT. PeriodicY ) THEN - Indx=0 - DO J=1,p%grid%NPoints - DO I=J,p%grid%NPoints ! The coherence matrix is symmetric so we're going to skip the other side - Indx = Indx + 1 - Dist(Indx)= SQRT( ( p%grid%Y(I) - p%grid%Y(J) )**2 + ( p%grid%Z(I) - p%grid%Z(J) )**2 ) - END DO ! I - END DO ! J - ELSE - ! bjj need to test ths more!!! - Indx=0 - DO J=1,p%grid%NPoints - DO I=J,p%grid%NPoints ! The coherence matrix is symmetric so we're going to skip the other side - - Indx = Indx + 1 - dY = p%grid%Y(I) - p%grid%Y(J) - IF (dY > 0.5*p%grid%GridWidth ) THEN - dY = dY - p%grid%GridWidth - p%grid%GridRes_Y - ELSE IF (dY < -0.5*p%grid%GridWidth ) THEN - dY = dY + p%grid%GridWidth + p%grid%GridRes_Y - END IF - - Dist(Indx)= SQRT( ( dY )**2 + ( p%grid%Z(I) - p%grid%Z(J) )**2 ) - - END DO - END DO - END IF - - - ! Compute the DistZMExp term, i.e., -(r/z_m)^CohExp - IF ( EqualRealNos( p%met%COHEXP, 0.0_ReKi ) ) THEN - DistZMExp = -1.0_ReKi ! value for entire array - ELSE - Indx=0 - DO J=1,p%grid%NPoints - DO I=J,p%grid%NPoints ! The coherence matrix is symmetric so we're going to skip the other side - - Indx = Indx + 1 - ZM = 0.5*( p%grid%Z(I) + p%grid%Z(J) ) - DistZMExp(Indx) = -1.0_ReKi*( Dist(Indx)/ZM )**p%met%COHEXP ! Note: 0**0 = 1 - END DO ! I - END DO ! J - END IF - - ! Compute the DistU term, i.e., (r/u): u is average u at points I and J - Indx=0 - DO J=1,p%grid%NPoints - DO I=J,p%grid%NPoints ! The coherence matrix is symmetric so we're going to skip the other side - Indx = Indx + 1 - UM = p%UHub ! was: 0.5*( U(I) + U(J) ) - DistU(Indx) = Dist(Indx)/UM - END DO ! I - END DO ! J - - !................. - ! DEBUGGING - !................. -IF ( COH_OUT ) THEN !debugging info... - - ! Write the coherence for three frequencies, for debugging purposes - CALL GetNewUnit( UC, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs_General') - - CALL OpenFOutFile( UC, TRIM(p%RootName)//'.coh', ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs_General') - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - WRITE( UC, '(A4,X,A16,1X,'//Num2LSTR(p%grid%NPacked)//'(G10.4,1X))' ) 'Comp','Freq',(I,I=1,p%grid%NPacked) - WRITE( UC, '(5X,A16,1X,'//Num2LSTR(p%grid%NPacked)//'(G10.4,1X))' ) 'Distance', Dist(:) - WRITE( UC, '(5X,A16,1X,'//Num2LSTR(p%grid%NPacked)//'(G10.4,1X))' ) '(r/u)', DistU(:) - WRITE( UC, '(5X,A16,1X,'//Num2LSTR(p%grid%NPacked)//'(G10.4,1X))' ) '(u)', p%met%URef - WRITE( UC, '(5X,A16,1X,'//Num2LSTR(p%grid%NPacked)//'(G10.4,1X))' ) '-(r/z_m)^CohExp', DistZMExp(:) -ENDIF - - - !-------------------------------------------------------------------------------- - ! Calculate the fourier coefficients - !--------------------------------------------------------------------------------- - - DO IVec = 1,3 - - IF (p%met%SCMod(IVec) /= CohMod_GENERAL) CYCLE ! Check the next component (this one doesn't use the GENERAL method) - - V(:,:,IVec) = 0.0_ReKi - - CALL WrScr ( ' '//Comp(IVec)//'-component matrices (general coherence model)' ) - - !-------------------------------------------------------------------------------- - ! Calculate the coherence, Veers' H matrix (CSDs), and the fourier coefficients - !--------------------------------------------------------------------------------- - - DO IFREQ = 1,p%grid%NumFreq - ! ----------------------------------------------- - ! Create the coherence matrix for this frequency - ! ----------------------------------------------- - - Indx = 1 - DO J = 1,p%usr%NPoints-1 ! start with user-defined points (which don't get added coherence) - - TRH(Indx) = 1.0_ReKi - Indx = Indx + 1 - - DO I=J+1,p%grid%NPoints - TRH(Indx) = 0.0_ReKi - Indx = Indx + 1 - END DO !I - - END DO !J - - DO J=max(1, p%usr%NPoints),p%grid%NPoints - DO I=J,p%grid%NPoints - - TRH(Indx) = EXP( p%met%InCDec(IVec) * DistZMExp(Indx)* & - SQRT( (p%grid%Freq(IFreq)*DistU(Indx) )**2 + (p%met%InCohB(IVec)*Dist(Indx))**2 ) ) - - Indx = Indx + 1 - - ENDDO ! I - ENDDO ! J - !................. - ! DEBUGGING - !................. - IF (COH_OUT) THEN - ! IF (IFreq == 1 .OR. IFreq == p%grid%NumFreq) THEN - WRITE( UC, '(I3,2X,F15.5,1X,'//Num2LSTR(p%grid%NPacked)//'(G10.4,1X))' ) IVec, p%grid%Freq(IFreq), TRH(1:p%grid%NPacked) - ! ENDIF - ENDIF - - ! ----------------------------------------------- - ! Now transform coherence to H matrix and then - ! use H matrix to calculate coefficients - ! ----------------------------------------------- - - CALL Coh2H( p, IVec, IFreq, TRH, S, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs_General') - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - CALL H2Coeffs( IVec, IFreq, TRH, PhaseAngles, V, p%grid%NPoints ) - END DO !IFreq - - END DO !IVec - - CALL Cleanup() - RETURN -!............................................ -CONTAINS - SUBROUTINE Cleanup() - - IF (COH_OUT .AND. UC > 0) CLOSE( UC ) - - IF ( ALLOCATED( Dist ) ) DEALLOCATE( Dist ) - IF ( ALLOCATED( DistU ) ) DEALLOCATE( DistU ) - IF ( ALLOCATED( DistZMExp ) ) DEALLOCATE( DistZMExp ) - END SUBROUTINE Cleanup -!............................................ -END SUBROUTINE CalcFourierCoeffs_General -!======================================================================= -!> This subroutine returns the complex Fourier coefficients (packed in a -!! real array) of the simulated velocity (wind/water speed). -!! It returns the values FOR ONLY the velocity components that use identity -!! spatial coherence; i.e., for i where SCMod(i) == CohMod_NONE -SUBROUTINE CalcFourierCoeffs_NONE( p, U, PhaseAngles, S, V, TRH, 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 -INTEGER(IntKi), INTENT(OUT) :: ErrStat -CHARACTER(*), INTENT(OUT) :: ErrMsg - - - ! Internal variables -INTEGER :: IFreq -INTEGER :: IVec ! wind component, 1=u, 2=v, 3=w - - - ErrStat = ErrID_None - ErrMsg = "" - - !-------------------------------------------------------------------------------- - ! Calculate the fourier coefficients - !--------------------------------------------------------------------------------- - - DO IVec = 1,3 - - IF (p%met%SCMod(IVec) /= CohMod_NONE) CYCLE ! Check the next component (this one doesn't use the identity coherence method) - - V(:,:,IVec) = 0.0_ReKi - - CALL WrScr ( ' '//Comp(IVec)//'-component matrices (identity coherence)' ) - - - ! now calculate coherence for compents that use this method - - ! ----------------------------------------------------------------------------------- - ! The coherence is the Identity (as is Cholesky Factorization); - ! the Veers' H matrix calculated in EyeCoh2H: - ! ----------------------------------------------------------------------------------- - - DO IFREQ = 1,p%grid%NumFreq - CALL EyeCoh2H( IVec, IFreq, TRH, S, p%grid%NPoints ) - CALL H2Coeffs( IVec, IFreq, TRH, PhaseAngles, V, p%grid%NPoints ) - ENDDO !IFreq - - END DO ! IVec - - RETURN -!............................................ -END SUBROUTINE CalcFourierCoeffs_NONE -!======================================================================= -!> This subroutine computes the coherence between two points on the grid, -!! forms the cross spectrum matrix, and returns the complex -!! Fourier coefficients of the simulated velocity (wind speed). -SUBROUTINE CalcFourierCoeffs( p, U, PhaseAngles, S, V, ErrStat, ErrMsg ) - -IMPLICIT NONE - - ! Passed variables - -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( OUT) :: V (:,:,:) !< An array containing the summations of the rows of H (NumSteps,NPoints,3). -INTEGER(IntKi), INTENT(OUT) :: ErrStat -CHARACTER(*), INTENT(OUT) :: ErrMsg - - ! Internal variables - -REAL(ReKi), ALLOCATABLE :: TRH (:) ! The transfer function matrix. -INTEGER(IntKi) :: ErrStat2 -CHARACTER(MaxMsgLen) :: ErrMsg2 - - ErrStat = ErrID_None - ErrMsg = "" - - ! with no turbulence, we return all zeros - IF (p%met%TurbModel_ID == SpecModel_NONE) THEN - V = 0.0_ReKi - RETURN - END IF - - ! otherwise, we use the coherence method specified by the user - - CALL AllocAry( TRH, p%grid%NPacked, 'TRH coherence array', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs') - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - CALL CalcFourierCoeffs_IEC( p, U, PhaseAngles, S, V, TRH, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs') - CALL CalcFourierCoeffs_API( p, U, PhaseAngles, S, V, TRH, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs') - CALL CalcFourierCoeffs_General( p, U, PhaseAngles, S, V, TRH, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs') - CALL CalcFourierCoeffs_NONE( p, U, PhaseAngles, S, V, TRH, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs') - - CALL Cleanup() - RETURN -!............................................ -CONTAINS - SUBROUTINE Cleanup() - IF ( ALLOCATED( TRH ) ) DEALLOCATE( TRH ) - END SUBROUTINE Cleanup -!............................................ -END SUBROUTINE CalcFourierCoeffs - -!======================================================================= -!> This subroutine returns the complex Fourier coefficients (packed in a -!! real array) of the simulated velocity (wind/water speed). It returns -!! values FOR ONLY the velocity components that use the API method for -!! computing spatial coherence; i.e., for i where SCMod(i) == CohMod_API -SUBROUTINE CalcFourierCoeffs_API( p, U, PhaseAngles, S, V, TRH, ErrStat, ErrMsg ) - -IMPLICIT NONE - - ! Passed variables -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 phase angles [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 -INTEGER(IntKi), INTENT( OUT) :: ErrStat -CHARACTER(*), INTENT( OUT) :: ErrMsg - - ! Internal variables - -REAL(ReKi), ALLOCATABLE :: Dist_Y(:) ! The Y distance between points -REAL(ReKi), ALLOCATABLE :: Dist_Z(:) ! The Z distance between points -REAL(ReKi), ALLOCATABLE :: z_g(:) ! sqrt( Z(IZ)*Z(JZ) ) / H - -INTEGER :: J -INTEGER :: I -INTEGER :: K -INTEGER :: IFreq -INTEGER :: Indx -INTEGER :: IVec ! wind component, 1=u, 2=v, 3=w - -INTEGER :: UC ! I/O unit for Coherence debugging file. -LOGICAL, PARAMETER :: COH_OUT = .FALSE. ! This parameter has been added to replace the NON-STANDARD compiler directive previously used - -INTEGER(IntKi) :: ErrStat2 -CHARACTER(MaxMsgLen) :: ErrMsg2 - -REAL, PARAMETER :: Qc(3) = (/ 1.00, 1.00, 1.25 /) -REAL, PARAMETER :: Pc(3) = (/ 0.40, 0.40, 0.50 /) -REAL, PARAMETER :: Rc(3) = (/ 0.92, 0.92, 0.85 /) -REAL, PARAMETER :: Alpha(3) = (/ 2.9 ,45.0 ,13.0 /) - -REAL, PARAMETER :: H = 10. ! Reference height -REAL, PARAMETER :: Coef_1 = 1.0 !3.28 - -REAL :: A_Y, A_Z - - - ! initialize variables - ErrStat = ErrID_None - ErrMsg = "" - UC = -1 - - IF (.NOT. ANY(p%met%SCMod == CohMod_API) ) RETURN - - !-------------------------------------------------------------------------------- - ! allocate arrays - !-------------------------------------------------------------------------------- - - CALL AllocAry( Dist_Y, p%grid%NPacked, 'Dist_Y coherence array', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs_API') - CALL AllocAry( Dist_Z, p%grid%NPacked, 'Dist_Z coherence array', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs_API') - !CALL AllocAry( Dist_Z12, p%grid%NPacked, 'Dist_Z12 coherence array', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs_API') - CALL AllocAry( z_g, p%grid%NPacked, 'z_g coherence array', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs_API') - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - - !-------------------------------------------------------------------------------- - ! Calculate the distances and other parameters that don't change with frequency - !--------------------------------------------------------------------------------- - - Indx=0 - DO J=1,p%grid%NPoints - DO I=J,p%grid%NPoints ! The coherence matrix is symmetric so we're going to skip the other side - Indx = Indx + 1 ! Indx = p%grid%NPoints*(J - 1) - J*(J - 1)/2 + I !Index of packed V matrix, coherence between points I & J - - Dist_Y(Indx)= ABS( p%grid%Y(I) - p%grid%Y(J) ) - Dist_Z(Indx)= ABS( p%grid%Z(I) - p%grid%Z(J) ) - z_g(Indx) = sqrt( p%grid%Z(I) * p%grid%Z(J) ) / H - - END DO - END DO - - - !................. - ! DEBUGGING - !................. -IF ( COH_OUT ) THEN !debugging info... - - ! Write the coherence for three frequencies, for debugging purposes - CALL GetNewUnit( UC, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs_API') - - CALL OpenFOutFile( UC, TRIM(p%RootName)//'.coh', ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs_API') - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - WRITE( UC, '(A4,X,A16,1X,'//Num2LSTR(p%grid%NPacked)//'(G10.4,1X))' ) 'Comp','Freq',(I,I=1,p%grid%NPacked) - WRITE( UC, '(5X,A16,1X,'//Num2LSTR(p%grid%NPacked)//'(G10.4,1X))' ) 'Distance_Y', Dist_Y(:) - WRITE( UC, '(5X,A16,1X,'//Num2LSTR(p%grid%NPacked)//'(G10.4,1X))' ) 'Distance_Z', Dist_Z(:) - WRITE( UC, '(5X,A16,1X,'//Num2LSTR(p%grid%NPacked)//'(G10.4,1X))' ) 'sqrt(Z(IZ)*Z(JZ))/H', z_g(:) -ENDIF - - !-------------------------------------------------------------------------------- - ! Calculate the fourier coefficients - !--------------------------------------------------------------------------------- - - DO IVec = 1,1 !BJJ: note that only the u component is defined, and I don't want to look at how to change the coherence in the other components.... - - IF (p%met%SCMod(IVec) /= CohMod_API) CYCLE ! Check the next component (this one doesn't use the API method) - - CALL WrScr ( ' '//Comp(IVec)//'-component matrices (2-dimensional API coherence method)' ) - - !-------------------------------------------------------------------------------- - ! Calculate the coherence, Veers' H matrix (CSDs), and the fourier coefficients - !--------------------------------------------------------------------------------- - - DO IFREQ = 1,p%grid%NumFreq - ! ----------------------------------------------- - ! Create the coherence matrix for this frequency - ! ----------------------------------------------- - - Indx = 1 - DO J = 1,p%usr%NPoints-1 ! start with user-defined points (which don't get added coherence) - - TRH(Indx) = 1.0_ReKi - Indx = Indx + 1 - - DO I=J+1,p%grid%NPoints - TRH(Indx) = 0.0_ReKi - Indx = Indx + 1 - END DO !I - - END DO !J - - DO J=max(1, p%usr%NPoints),p%grid%NPoints - DO I=J,p%grid%NPoints - -!mlb: THis is where to look for the error. - -!mlb TEMP_Y=Coef_AlphaY*p%grid%Freq(IFreq)**Coef_RY*(Dist_Y(Indx)/Coef_1)**Coef_QY*(Dist_Z12(Indx)/Coef_2)**(-0.5*Coef_PY) -!mlb TEMP_Z=Coef_AlphaZ*p%grid%Freq(IFreq)**Coef_RZ*(Dist_Z(Indx)/Coef_1)**Coef_QZ*(Dist_Z12(Indx)/Coef_2)**(-0.5*Coef_PZ) - -!dist_x is zero, so we ignore it here (i.e., A_X = 0) - A_Y = Alpha(2) * (p%grid%Freq(IFreq)**rc(2)) * ((Dist_Y(Indx)/Coef_1)**qc(2)) * (z_g(Indx)**(-pc(2))) - A_Z = Alpha(3) * (p%grid%Freq(IFreq)**rc(3)) * ((Dist_Z(Indx)/Coef_1)**qc(3)) * (z_g(Indx)**(-pc(3))) - -!mlb TRH(Indx)=EXP(-Coef_1*SQRT(TEMP_Y**2+TEMP_Z**2)/U0_1HR) - TRH(Indx)=EXP(- Coef_1 * SQRT(A_Y**2 + A_Z**2) / p%met%URef) - - Indx = Indx + 1 - - ENDDO ! I - ENDDO ! J - - - !................. - ! DEBUGGING - !................. - IF (COH_OUT) THEN - ! IF (IFreq == 1 .OR. IFreq == p%grid%NumFreq) THEN - WRITE( UC, '(I3,2X,F15.5,1X,'//Num2LSTR(p%grid%NPacked)//'(G10.4,1X))' ) IVec, p%grid%Freq(IFreq), TRH(1:p%grid%NPacked) - ! ENDIF - ENDIF - - ! ----------------------------------------------- - ! Now transform coherence to H matrix and then - ! use H matrix to calculate coefficients - ! ----------------------------------------------- - - CALL Coh2H( p, IVec, IFreq, TRH, S, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CalcFourierCoeffs_API') - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - CALL H2Coeffs( IVec, IFreq, TRH, PhaseAngles, V, p%grid%NPoints ) - - ENDDO !IFreq - ENDDO !IVec - - CALL Cleanup() - -RETURN -!............................................ -CONTAINS - SUBROUTINE Cleanup() - - IF (COH_OUT .AND. UC > 0) CLOSE( UC ) - - IF ( ALLOCATED( Dist_Y ) ) DEALLOCATE( Dist_Y ) - IF ( ALLOCATED( Dist_Z ) ) DEALLOCATE( Dist_Z ) - IF ( ALLOCATED( z_g ) ) DEALLOCATE( z_g ) - END SUBROUTINE Cleanup -!............................................ -END SUBROUTINE CalcFourierCoeffs_API -!======================================================================= -SUBROUTINE EyeCoh2H( IVec, IFreq, TRH, S, NPoints ) - -REAL(ReKi), INTENT(INOUT) :: TRH (:) ! The transfer function matrix (length is >= p%grid%NPacked). -REAL(ReKi), INTENT(IN) :: S (:,:,:) ! The turbulence PSD array (NumFreq,NPoints,3). -INTEGER(IntKi), INTENT(IN) :: IVec ! loop counter (=number of wind components) -INTEGER(IntKi), INTENT(IN) :: IFreq ! loop counter (=number of frequencies) -INTEGER(IntKi), INTENT(IN) :: NPoints ! Size of dimension 2 of S - -integer :: Indx, J, I - -!NPoints = SIZE(S,2) - - ! ----------------------------------------------------------------------------------- - ! The coherence is the Identity (as is Cholesky); the Veers' H matrix is as follows: - ! ----------------------------------------------------------------------------------- - - Indx = 1 - 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 - ENDDO ! J - -END SUBROUTINE EyeCoh2H -!======================================================================= -SUBROUTINE Coh2H( p, IVec, IFreq, TRH, S, ErrStat, ErrMsg ) - -!use NWTC_LAPACK - -TYPE(TurbSim_ParameterType), INTENT(IN ) :: p ! TurbSim parameters -REAL(ReKi), INTENT(INOUT) :: TRH (:) ! The transfer function matrix (size >= NumSteps). -REAL(ReKi), INTENT(IN) :: S (:,:,:) ! The turbulence PSD array (NumFreq,NPoints,3). -INTEGER(IntKi), INTENT(IN) :: IVec ! loop counter (=number of wind components) -INTEGER(IntKi), INTENT(IN) :: IFreq ! loop counter (=number of frequencies) - -INTEGER(IntKi), INTENT(OUT) :: ErrStat -CHARACTER(*), INTENT(OUT) :: ErrMsg - - -integer :: Indx, J, I, NPts - - - ! ------------------------------------------------------------- - ! Calculate the Cholesky factorization for the coherence matrix - ! ------------------------------------------------------------- - IF ( p%usr%NPoints > 0 ) THEN - J = p%usr%NPoints - Indx = p%grid%NPoints*(J-1) - J*(J-1)/2 + J !Index of H(J,J) - NPts = p%grid%NPoints - p%usr%NPoints + 1 - ELSE - Indx = 1 - NPts = p%grid%NPoints - END IF - - CALL LAPACK_pptrf( 'L', NPts, TRH(Indx:), ErrStat, ErrMsg ) ! 'L'ower triangular 'TRH' matrix (packed form), of order 'NPoints'; returns Stat - - IF ( ErrStat /= ErrID_None ) THEN - IF (ErrStat < AbortErrLev) then - CALL WrScr(ErrMsg) - ELSE - ErrMsg = 'Error in Cholesky factorization: '//TRIM(ErrMsg)//newline//& - 'The error occurred in the '//Comp(IVec)//'-component coherence matrix at frequency '//& - TRIM(Int2LStr(IFreq))//' ('//TRIM(Num2LStr(p%grid%Freq(IFreq)))//' Hz)'//& - ' Check the input file for invalid physical properties or modify the coherence.' - RETURN - - END IF - ENDIF - - ! ------------------------------------------------------------- - ! Create the lower triangular matrix, H, from Veer's method - ! ------------------------------------------------------------- - - Indx = 1 - DO J = 1,p%usr%NPoints-1 ! Column - ! use identity coherence for the user-input time series: - - !Indx = p%grid%NPoints*(J-1) - J*(J-1)/2 + J !Index of H(J,J) - - TRH(Indx) = SQRT( ABS( S(IFreq,J,IVec) ) ) - Indx = Indx + 1 - - DO I=J+1,p%grid%NPoints - TRH(Indx) = 0.0_ReKi - Indx = Indx + 1 - END DO - - END DO !J - - DO J = max(1,p%usr%NPoints),p%grid%NPoints ! Column - - TRH(Indx) = TRH(Indx) * SQRT( ABS( S(IFreq,J,IVec) ) ) - Indx = Indx + 1 - - DO I = J+1,p%grid%NPoints ! Row - - ! S(IFreq,I,IVec) should never be less than zero, but the ABS makes sure... - !Indx = NPoints*(J-1) - J*(J-1)/2 + I !Index of H(I,J) - -! TRH(Indx) = TRH(Indx) * SQRT( ABS( S(IFreq,I,IVec) ) ) - TRH(Indx) = TRH(Indx) * SQRT( SQRT( ABS( S(IFreq,I,IVec) * S(IFreq,J,IVec) ) ) ) - - Indx = Indx + 1 - - ENDDO !I - ENDDO !J - - -END SUBROUTINE Coh2H -!======================================================================= -SUBROUTINE H2Coeffs( IVec, IFreq, TRH, PhaseAngles, V, NPoints ) - - -REAL(ReKi), INTENT(IN) :: TRH (:) ! The transfer function matrix (length is >= p%grid%NPacked). -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(INOUT) :: V (:,:,:) ! An array containing the summations of the rows of H (NumSteps,NPoints,3). -INTEGER(IntKi), INTENT(IN) :: IVec ! loop counter (=number of wind components) -INTEGER(IntKi), INTENT(IN) :: IFreq ! loop counter (=number of frequencies) -INTEGER(IntKi), INTENT(IN) :: NPoints ! Size of dimension 2 of V - - -REAL(ReKi) :: CPh ! Cosine of the random phase -REAL(ReKi) :: SPh ! Sine of the random phase -INTEGER :: IF1 ! Index to real part of vector -INTEGER :: IF2 ! Index to complex part of vector - -integer :: Indx, J, I - - - ! ------------------------------------------------------------- - ! Calculate the correlated fourier coefficients. - ! ------------------------------------------------------------- - - IF2 = IFreq*2 - IF1 = IF2 - 1 - - DO J=1,NPoints - - ! Apply a random phase to each of the columns of H to - ! produce random phases in the wind component. - ! Then sum each of the rows into the vector V. - - CPh = COS( PhaseAngles(J,IFreq,IVec) ) - SPh = SIN( PhaseAngles(J,IFreq,IVec) ) - - Indx = NPoints*(J-1) - J*(J-1)/2 + J !Index of H(J,J) - DO I=J,NPoints - - V(IF1,I,IVec) = V(IF1,I,IVec) + TRH(Indx)*CPh !Real part - V(IF2,I,IVec) = V(IF2,I,IVec) + TRH(Indx)*SPh !Imaginary part - - Indx = Indx + 1 !H(I,J) - - ENDDO ! I - ENDDO ! J - -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 - - 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:' ) - -DO IVec=1,3 - - CALL WrScr ( ' '//Comp(IVec)//'-component' ) - - 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 - -! 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. - - ! 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 - - - - ! 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' ) - - if (allocated(work)) deallocate(work) - - END SUBROUTINE Cleanup -END SUBROUTINE Coeffs2TimeSeries -!======================================================================= -!> This routine calculates the two-sided Fourier amplitudes of the frequencies -!! note that the resulting time series has zero mean. -SUBROUTINE CalcTargetPSD(p, S, U, 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( OUT) :: S (:,:,:) !< The turbulence PSD array (NumFreq,NPoints,3). - - INTEGER(IntKi), INTENT( out) :: ErrStat !< Error level - CHARACTER(*), INTENT( out) :: ErrMsg !< Message describing error - - - ! local variables - - INTEGER(IntKi) :: IFreq ! Index for frequency - INTEGER(IntKi) :: LastIndex(2) ! Index for the last (Freq, Ht) used in models that interpolate/extrapolate user-input spectra or time series - - INTEGER(IntKi) :: IVec ! loop counter for velocity components - INTEGER(IntKi) :: IPoint, iPointUsr ! loop counter for grid points - - REAL(ReKi), ALLOCATABLE :: SSVS (:,:) ! A temporary work array (NumFreq,3) that holds a single-sided velocity spectrum. - REAL(ReKi) :: DUDZ ! The steady u-component wind shear for the grid [used in Hydro models only]. - REAL(ReKi) :: ZTmp, UTmp ! temporary height and velocity used for finite difference calculations - - REAL(ReKi) :: HalfDelF ! half of the delta frequency, used to discretize the continuous PSD at each point - - !INTEGER(IntKi) :: UP ! I/O unit for PSD debugging file. - !CHARACTER(200) :: FormStr ! String used to store format specifiers for PSD debugging. - - INTEGER(IntKi) :: ErrStat2 ! Error level (local) - CHARACTER(MaxMsgLen) :: ErrMsg2 ! Message describing error (local) - CHARACTER(*), PARAMETER :: RoutineName = 'CalcTargetPSD' - - ! initialize variables - - ErrStat = ErrID_None - ErrMsg = "" - - - ! Allocate the array to hold the single-sided velocity spectrum. - - CALL AllocAry( SSVS, p%grid%NumFreq,3, 'SSVS', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - - - ! Calculate the single point Power Spectral Densities. - - HalfDelF = 0.5*p%grid%Freq(1) - - - SELECT CASE ( p%met%TurbModel_ID ) - CASE ( SpecModel_IECKAI ) ! IECKAI has uniform spectra (does not vary with height or velocity) - CALL Spec_IECKAI ( p%UHub, p%IEC%SigmaIEC, p%IEC%IntegralScale, p%grid%Freq, p%grid%NumFreq, SSVS ) - - DO IVec=1,3 - DO IFreq=1,p%grid%NumFreq - S(IFreq,:,IVec) = SSVS(IFreq,IVec)*HalfDelF - END DO ! IFreq - END DO ! IVec - - - CASE ( SpecModel_IECVKM ) ! IECVKM has uniform spectra (does not vary with height or velocity) - CALL Spec_IECVKM ( p%UHub, p%IEC%SigmaIEC(1), p%IEC%IntegralScale, p%grid%Freq, p%grid%NumFreq, SSVS ) - - DO IVec=1,3 - DO IFreq=1,p%grid%NumFreq - S(IFreq,:,IVec) = SSVS(IFreq,IVec)*HalfDelF - END DO ! IFreq - END DO ! IVec - - - CASE ( SpecModel_API ) - DO IPoint=1,p%grid%NPoints - CALL Spec_API ( p, p%grid%Z(IPoint), SSVS ) - S(:,IPoint,:) = SSVS*HalfDelF - ENDDO - - - CASE ( SpecModel_GP_LLJ ) - IF ( ALLOCATED( p%met%ZL_profile ) ) THEN !.AND. ALLOCATED( p%met%Ustar_profile ) ) THEN - DO IPoint=1,p%grid%NPoints - CALL Spec_GPLLJ ( p, p%grid%Z(IPoint), U(IPoint), p%met%ZL_profile(IPoint), p%met%Ustar_profile(IPoint), SSVS ) - S(:,IPoint,:) = SSVS*HalfDelF - ENDDO - ELSE - DO IPoint=1,p%grid%NPoints - CALL Spec_GPLLJ ( p, p%grid%Z(IPoint), U(IPoint), p%met%ZL, p%met%Ustar, SSVS ) - S(:,IPoint,:) = SSVS*HalfDelF - ENDDO - ENDIF - - - CASE (SpecModel_NWTCUP) - DO IPoint=1,p%grid%NPoints - CALL Spec_NWTCUP ( p, p%grid%Z(IPoint), U(IPoint), SSVS ) - S(:,IPoint,:) = SSVS*HalfDelF - ENDDO - - - CASE ( SpecModel_SMOOTH ) - DO IPoint=1,p%grid%NPoints - CALL Spec_SMOOTH ( P, p%grid%Z(IPoint), U(IPoint), SSVS ) - S(:,IPoint,:) = SSVS*HalfDelF - ENDDO - - - CASE ( SpecModel_TIDAL, SpecModel_RIVER ) - DO IPoint=1,p%grid%NPoints - ZTmp = p%grid%Z(IPoint) + p%grid%GridRes_Z - - CALL getVelocity(p, p%UHub,p%grid%HubHt, ZTmp, UTmp, ErrStat2, ErrMsg2) !get velocity Utmp at height ZTmp - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - DUDZ = ( UTmp - U(IPoint) ) / p%grid%GridRes_Z - CALL Spec_TIDAL ( p, p%grid%Z(IPoint), DUDZ, SSVS, p%met%TurbModel_ID ) - - ! Discretize the continuous PSD and store it in matrix "S" - - S(:,IPoint,:) = SSVS*HalfDelF - ENDDO - - - CASE ( SpecModel_USER ) ! currently is uniform spectra - CALL Spec_UserSpec ( p, SSVS ) - - DO IVec=1,3 - DO IFreq=1,p%grid%NumFreq - S(IFreq,:,IVec) = SSVS(IFreq,IVec)*HalfDelF - END DO ! IFreq - END DO ! IVec - - - CASE ( SpecModel_TimeSer ) - - DO iPointUsr = 1,p%usr%NPoints - - iPoint = iPointUsr - IF (iPointUsr == p%usr%RefPtID ) THEN - iPoint = p%usr%NPoints !this is the point on the grid - ELSEIF (iPointUsr == p%usr%NPoints) THEN - iPoint = p%usr%RefPtID - END IF - !bjj: make sure size(ssvs,1) = p%grid%NumFreq <= p%usr%nFreq = size(p%usr%S,1) - ! initialize SSVS with extrapolated values if there are non-specified components or frequencies - ! i.e., fill the gaps where wind component or frequencies exceed what was specified in the time-series data with some numerical model - ! (use zeros for known spectral values that will get overwritten later) - CALL Spec_TimeSer_Extrap ( p, p%grid%Z(iPoint), U(iPoint), SSVS ) - - ! overwrite the frequencies and wind components that were computed from measurements in the time-series file - SSVS(1:p%usr%nFreq,1:p%usr%nComp) = p%usr%S(1:p%usr%nFreq,iPointUsr,1:p%usr%nComp) - - S(:,iPoint,:) = SSVS*HalfDelF - END DO - - - DO iPoint=1+p%usr%NPoints,p%grid%NPoints - CALL Spec_TimeSer( p, p%grid%Z(iPoint), U(iPoint), LastIndex, SSVS ) - S(:,iPoint,:) = SSVS*HalfDelF - ENDDO - - CASE ( SpecModel_USRVKM ) - DO iPoint=1,p%grid%NPoints - CALL Spec_vonKrmn ( P, p%grid%Z(iPoint), U(iPoint), SSVS ) - S(:,iPoint,:) = SSVS*HalfDelF - ENDDO - - - CASE (SpecModel_WF_UPW) - DO IPoint=1,p%grid%NPoints - CALL Spec_WF_UPW ( p, p%grid%Z(IPoint), U(IPoint), SSVS ) - S(:,IPoint,:) = SSVS*HalfDelF - ENDDO - - - CASE ( SpecModel_WF_07D, SpecModel_WF_14D ) - DO IPoint=1,p%grid%NPoints - CALL Spec_WF_DW ( p, p%grid%Z(IPoint), U(IPoint), SSVS, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - S(:,IPoint,:) = SSVS*HalfDelF - ENDDO - - - CASE ( SpecModel_NONE ) - S = 0.0_ReKi ! whole matrix is zero - !bjj TEST: CALL Spec_Test ( p%grid%Z(IPoint), U(IPoint), SSVS ) - - CASE ( SpecModel_MODVKM ) - IF (MVK) THEN - ! DO IPoint=1,p%grid%NPoints - ! CALL Mod_vKrm( p%grid%Z(IPoint), U(IPoint), SSVS ) - ! S(:,IPoint,:) = SSVS*HalfDelF - ! ENDDO - ELSE - CALL SetErrStat( ErrID_Fatal, 'Specified turbulence PSD, "'//TRIM( p%met%TurbModel )//'", not availible.', ErrStat, ErrMsg, RoutineName) - CALL Cleanup() - RETURN - ENDIF - - CASE DEFAULT - CALL SetErrStat( ErrID_Fatal, 'Specified turbulence PSD, "'//TRIM( p%met%TurbModel )//'", not availible.', ErrStat, ErrMsg, RoutineName) - CALL Cleanup() - RETURN - END SELECT - - - !IF (PSD_OUT) THEN - ! UP = -1 - ! CALL GetNewUnit( UP, ErrStat2, ErrMsg2 ) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! CALL OpenFOutFile ( UP, TRIM( p%RootName )//'.psd', ErrStat2, ErrMsg2) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! IF (ErrStat >= AbortErrLev) THEN - ! CALL Cleanup() - ! RETURN - ! END IF - ! - ! WRITE (UP,"(A)") 'PSDs ' - ! WRITE (UP, "( A4,'"//TAB//"',A4,"//TRIM( Int2LStr( p%grid%NumFreq ) )//"('"//TAB//"',G10.4) )") 'Comp','Ht', p%grid%Freq(:) - ! FormStr = "( I4,"//TRIM( Int2LStr( p%grid%NumFreq+1 ) )//"('"//TAB//"',G10.4) )" - ! - ! DO IPoint=1,p%grid%NPoints - ! - ! !IF ( ABS(Ht - p%grid%HubHt) < Tolerance ) THEN - ! WRITE( UP, FormStr ) 1, p%grid%Z(IPoint), S(:,IPoint,1)/HalfDelF - ! WRITE( UP, FormStr ) 2, p%grid%Z(IPoint), S(:,IPoint,2)/HalfDelF - ! WRITE( UP, FormStr ) 3, p%grid%Z(IPoint), S(:,IPoint,3)/HalfDelF - ! !ENDIF - ! - ! ENDDO ! IPoint - ! - ! CLOSE( UP ) - !ENDIF - - - CALL Cleanup() - RETURN - -CONTAINS -!.................................... - SUBROUTINE Cleanup() - - !IF ( PSD_OUT .AND. UP > 0) CLOSE( UP ) - - IF ( ALLOCATED( SSVS ) ) DEALLOCATE( SSVS ) - - END SUBROUTINE Cleanup -END SUBROUTINE CalcTargetPSD -!======================================================================= -!> This routine creates the grid (cartesian + other points) that are -!! to be simulated. -SUBROUTINE CreateGrid( p_grid, p_usr, UHub, AddTower, ErrStat, ErrMsg ) - -! Assumes that these variables are set: -! GridHeight -! GridWidth -! NumGrid_Y -! NumGrid_Z - - TYPE(Grid_ParameterType), INTENT(INOUT) :: p_grid - TYPE(UserTSSpec_ParameterType), INTENT(INOUT) :: p_usr - - REAL(ReKi) , INTENT(IN ) :: UHub ! Mean wind speed at hub, used only when usable time is not "ALL" (i.e., periodic flag is false) - LOGICAL , INTENT(INOUT) :: AddTower ! Value of p%WrFile(FileExt_TWR) [determines if tower points should be generarated] - - INTEGER(IntKi), intent( out) :: ErrStat ! Error level - CHARACTER(*), intent( out) :: ErrMsg ! Message describing error - - ! local variables: - REAL(DbKi) :: DelF ! Delta frequency - INTEGER(IntKi) :: IY, IZ, IFreq ! loop counters - INTEGER(IntKi) :: NTwrPts ! number of extra tower points - INTEGER(IntKi) :: NTwrIndx ! number of tower points to be placed in output file - - INTEGER(IntKi) :: TmpIndex ! temporary index - - INTEGER(IntKi) :: HubIndx_Y ! Index into Y dimension of grid for hub location - INTEGER(IntKi) :: HubIndx_Z ! Index into Z dimension of grid for hub location - - INTEGER(IntKi) :: NumSteps2 ! one-half the number of steps - INTEGER(IntKi) :: iPoint, iPointUsr ! loop counter for points - - INTEGER(IntKi) :: ErrStat2 ! Error level (local) - CHARACTER(MaxMsgLen) :: ErrMsg2 ! Message describing error (local) - CHARACTER(*), PARAMETER :: RoutineName = 'CreateGrid' - LOGICAL :: GenerateExtraHubPoint - - ErrStat = ErrID_None - ErrMsg = "" - - - !..................................................... - ! First, let's deal with time and frequencies: - !..................................................... - - ! Calculate Total time and NumSteps. - ! Find the product of small factors that is larger than NumSteps (prime #9 = 23). -!bjj: I have no idea why it is necessary to be a factor of 4, so I'm removing it for now: ! Make sure it is a multiple of 2 too. - - IF ( p_grid%Periodic ) THEN - p_grid%NumSteps = CEILING( p_grid%AnalysisTime / p_grid%TimeStep ) - - ! make sure NumSteps is an even number and a product of small primes - NumSteps2 = ( p_grid%NumSteps - 1 )/2 + 1 - p_grid%NumSteps = 2*PSF( NumSteps2 , 9 ) ! >= 2*NumSteps2 = NumSteps + 1 - MOD(NumSteps-1,2) >= NumSteps - !p_grid%NumSteps = PSF( p_grid%NumSteps , 9 ) - - p_grid%NumOutSteps = p_grid%NumSteps - ELSE - p_grid%NumOutSteps = CEILING( ( p_grid%UsableTime + p_grid%GridWidth / UHub )/p_grid%TimeStep ) - p_grid%NumSteps = MAX( CEILING( p_grid%AnalysisTime / p_grid%TimeStep ), p_grid%NumOutSteps ) - - ! make sure NumSteps is an even number and a product of small primes -! p_grid%NumSteps = PSF( p_grid%NumSteps , 9 ) ! make sure it's a product of small primes - NumSteps2 = ( p_grid%NumSteps - 1 )/2 + 1 - p_grid%NumSteps = 2*PSF( NumSteps2 , 9 ) ! >= 2*NumSteps2 = NumOutSteps + 1 - MOD(NumOutSteps-1,2) >= NumOutSteps - - END IF - - !IF (p_grid%NumSteps < 2 ) THEN - ! CALL SetErrStat( ErrID_Fatal, 'There must be at least 2 time steps. '//& - ! 'Increase the usable length of the time series or decrease the time step.', ErrStat, ErrMsg, RoutineName ) - ! RETURN - !END IF - - p_grid%NumFreq = p_grid%NumSteps / 2 - DelF = 1.0_DbKi/( p_grid%NumSteps*p_grid%TimeStep ) - - ! quick check that the frequency contents are the same as the user-input time series. (necessary because we want to keep the exact time series) - IF (p_usr%NPoints > 0) THEN - ! IF ( .NOT. EqualRealNos( DelF, p_usr%f(1) ) .or. .not. EqualRealNos(p_grid%AnalysisTime,p_usr%f(1)*p_usr%NFreq ) .or. p_grid%NumFreq > size(p_usr%f) ) THEN - IF ( .NOT. EqualRealNos( DelF, p_usr%DelF ) ) THEN - CALL SetErrStat(ErrID_Fatal, 'Delta frequency in the user-input time series must be the same as the delta frequency in the simulated series. '//& - 'Change AnalysisTime or number of rows entered in user-defined time series file.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - if ( p_grid%NumFreq > p_usr%nFreq ) then - CALL SetErrStat(ErrID_Fatal, 'Cannot output more frequency values than were entered in user-defined time series file.', ErrStat, ErrMsg,RoutineName) - RETURN - end if - - END IF - - - CALL AllocAry( p_grid%Freq, p_grid%NumFreq, 'Freq (frequency array)', ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - DO IFreq=1,p_grid%NumFreq - p_grid%Freq(IFreq) = IFreq*DelF - ENDDO - - - !..................................................... - ! Now, figure out the points in space: - ! 1) user-specified time-series points - ! 2) regularly spaced y-z grid - ! 3) hub point - ! 4) lollipop-stick tower points - !..................................................... - - ! start by determining how many points will be in the output files - ! (1) the full-field grid: - p_grid%GridRes_Y = p_grid%GridWidth / REAL( p_grid%NumGrid_Y - 1, ReKi ) - p_grid%GridRes_Z = p_grid%GridHeight / REAL( p_grid%NumGrid_Z - 1, ReKi ) - - p_grid%Zbottom = p_grid%HubHt + 0.5*p_grid%RotorDiameter ! height of the highest grid points - p_grid%Zbottom = p_grid%Zbottom - p_grid%GridRes_Z * REAL(p_grid%NumGrid_Z - 1, ReKi) ! height of the lowest grid points - - IF ( p_grid%Zbottom <= 0.0_ReKi ) THEN - CALL SetErrStat(ErrID_Fatal,'The lowest grid point ('//TRIM(Num2LStr(p_grid%Zbottom))// ' m) must be above the ground. '//& - 'Adjust the appropriate values in the input file.',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - - - ! (2) the tower points: - IF ( AddTower ) THEN - - IF ( MOD(p_grid%NumGrid_Y, 2) == 0 ) THEN - p_grid%ExtraTwrPT = .TRUE. - ELSE - p_grid%ExtraTwrPT = .FALSE. - END IF - - ! Compute the number of points between the bottom of the grid and the ground - ! ( but we don't want to be on the ground, just more than "Tolerance" from it ) - - NTwrPts = INT( ( p_grid%Zbottom - Tolerance ) / p_grid%GridRes_Z ) - NTwrIndx = NTwrPts + 1 - - IF ( NTwrPts < 1 ) THEN - CALL SetErrStat(ErrID_Warn, ' There are no extra tower data points below the grid. Tower output will be turned off.',ErrStat,ErrMsg,RoutineName) - AddTower = .FALSE. ! bjj: change this so it doesn't actually modify this variable inside this routine??? - NTwrPts = 0 - NTwrIndx = 0 - ENDIF - - IF ( p_grid%ExtraTwrPT ) THEN - NTwrPts = NTwrPts + 1 ! Let's add the point on the bottom of the grid so tower interpolation is easier in AeroDyn - ENDIF - - ELSE - NTwrPts = 0 - NTwrIndx = 0 - ENDIF - - ! we will set these index arrays to point to the grid/tower points or user-specified points - CALL AllocAry(p_grid%GridPtIndx,p_grid%NumGrid_Y*p_grid%NumGrid_Z, 'GridPtIndx', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry(p_grid%TwrPtIndx, NTwrIndx, 'TwrPtIndx', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - - !............... - ! Now, let's see how many points we're going to simulate - !.............. - - ! here's our first estimate of how many points there will be. Later we will add a point for the hub if - ! necessary and subtract points from the grid or tower that are duplicates of the user-specified ones. - p_grid%NPoints = p_usr%NPoints & ! (1) the user-specified time-series points - + p_grid%NumGrid_Y*p_grid%NumGrid_Z & ! (2) the rectangular grid - + NTwrPts ! (4) the tower points (the stick of the lollipop) - - ! Check if any of the user-specified time-series points are duplicated elsewhere: - p_grid%GridPtIndx = 0 - p_grid%TwrPtIndx = 0 - - ! (2) the rectangular grid: - DO iPointUsr = 1,p_usr%NPoints - - iPoint = iPointUsr - IF (iPointUsr == p_usr%RefPtID ) THEN - iPoint = p_usr%NPoints - ELSEIF (iPointUsr == p_usr%NPoints) THEN - iPoint = p_usr%RefPtID - END IF - - ! Is this point on the regularly-spaced grid? - TmpIndex = IndexOnGrid( p_grid, p_usr%pointyi(iPointUsr), p_usr%pointzi(iPointUsr) ) - - IF ( TmpIndex > 0 ) THEN - p_grid%GridPtIndx( TmpIndex ) = iPoint - ! it's a duplicate of a point on the rectangular grid, so subtract one from NPoints: - p_grid%NPoints = p_grid%NPoints - 1 - ELSE - ! Is this point on the tower? - IF ( NTwrPts > 0 ) THEN - TmpIndex = IndexOnTower( p_grid, p_usr%pointyi(iPointUsr), p_usr%pointzi(iPointUsr) ) - - IF ( TmpIndex > 0 ) THEN - p_grid%TwrPtIndx( TmpIndex ) = iPoint - - ! it's a duplicate of a tower point, so subtract one from NPoints: - p_grid%NPoints = p_grid%NPoints - 1 - END IF - END IF ! NTwrPts > 0 - - END IF - - END DO - - - ! (3) the hub point: - - IF ( MOD(p_grid%NumGrid_Y, 2) == 0 ) THEN - - p_grid%HubOnGrid = .FALSE. - - ELSE - ! This is the hub Z index if it falls on the grid - HubIndx_Z = INT( Tolerance + ( p_grid%HubHt - p_grid%Zbottom ) / p_grid%GridRes_Z ) + 1 - - IF ( ABS((HubIndx_Z-1)*p_grid%GridRes_Z + p_grid%Zbottom - p_grid%HubHt) > Tolerance ) THEN - p_grid%HubOnGrid = .FALSE. - ELSE - p_grid%HubOnGrid = .TRUE. - END IF - - END IF - - p_grid%HubIndx = 0 - IF ( .NOT. p_grid%HubOnGrid ) THEN - GenerateExtraHubPoint = .TRUE. - ! Is it a user-defined point? - DO iPointUsr = 1,p_usr%NPoints - - IF ( EqualRealNos( p_usr%pointyi(iPointUsr), 0.0_ReKi ) .AND. EqualRealNos( p_usr%pointzi(iPointUsr), p_grid%HubHt ) ) THEN - - IF (iPointUsr == p_usr%RefPtID ) THEN - iPoint = p_usr%NPoints - ELSEIF (iPointUsr == p_usr%NPoints) THEN - iPoint = p_usr%RefPtID - ELSE - iPoint = iPointUsr - END IF - - p_grid%HubIndx = iPoint - GenerateExtraHubPoint = .FALSE. - EXIT ! we found it - END IF - END DO - ELSE - GenerateExtraHubPoint = .FALSE. - END IF - - IF (GenerateExtraHubPoint) p_grid%NPoints = p_grid%NPoints + 1 - - p_grid%NPacked = p_grid%NPoints*( p_grid%NPoints + 1 )/2 ! number of entries stored in the packed version of the symmetric matrix of size NPoints by NPoints - - - ! we now know how many points there are going to be, so let's create the arrays that contains their locations and finish updating our index arrays - - CALL AllocAry(p_grid%Y, p_grid%NPoints, 'Y (lateral locations of the grid points)', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry(p_grid%Z, p_grid%NPoints, 'Z (vertical locations of the grid points)', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - ! (1) User-defined points - DO iPointUsr = 1,p_usr%NPoints - - iPoint = iPointUsr - IF (iPointUsr == p_usr%RefPtID ) THEN - iPoint = p_usr%NPoints - ELSEIF (iPointUsr == p_usr%NPoints) THEN - iPoint = p_usr%RefPtID - END IF - - p_grid%y(iPoint) = p_usr%pointyi(iPointUsr) - p_grid%z(iPoint) = p_usr%pointzi(iPointUsr) - END DO - - - ! (2) rectangular y-z grid: - iPoint = p_usr%NPoints - DO IZ = 1,p_grid%NumGrid_Z - DO IY = 1,p_grid%NumGrid_Y - - TmpIndex = (IZ-1)*p_grid%NumGrid_Y + IY - - IF ( p_grid%GridPtIndx(TmpIndex) < 1 ) THEN ! we didn't find this grid point in the set of user-defined points, so create a new point - iPoint = iPoint + 1 - - p_grid%Y(iPoint) = -0.5*p_grid%GridWidth + p_grid%GridRes_Y*( IY - 1 ) - p_grid%Z(iPoint) = p_grid%Zbottom + p_grid%GridRes_Z*( IZ - 1 ) - p_grid%GridPtIndx(TmpIndex) = iPoint - END IF - - END DO - END DO - - ! note: GridPtIndx should be completely set now. - - ! (3) hub point: - - IF ( p_grid%HubOnGrid ) THEN - - HubIndx_Y = INT( ( p_grid%NumGrid_Y + 1 ) / 2 ) ! the center point - p_grid%HubIndx = p_grid%GridPtIndx( p_grid%NumGrid_Y*( HubIndx_Z - 1 ) + HubIndx_Y ) - - ELSEIF ( GenerateExtraHubPoint ) THEN - iPoint = iPoint + 1 - - p_grid%Y(iPoint) = 0.0_ReKi - p_grid%Z(iPoint) = p_grid%HubHt - p_grid%HubIndx = iPoint - - ! ELSE -> HubIndx is set already - ENDIF - - - ! (4) Finally, let's deal with the tower "lollipop" points: - - IF ( AddTower ) THEN !p%WrFile(FileExt_TWR) - - IF ( .NOT. p_grid%ExtraTwrPT ) THEN - p_grid%TwrPtIndx(1) = p_grid%GridPtIndx( INT(p_grid%NumGrid_Y / 2) + 1 ) ! center y location on bottom height - END IF - - - DO IZ = 1,NTwrIndx - IF ( p_grid%TwrPtIndx(IZ) < 1 ) THEN - iPoint = iPoint + 1 - - p_grid%Y(iPoint) = 0.0_ReKi - p_grid%Z(iPoint) = p_grid%ZBottom - (IZ-1)*p_grid%GridRes_Z - p_grid%TwrPtIndx(IZ) = iPoint - - END IF - END DO - - ENDIF - -END SUBROUTINE CreateGrid -!======================================================================= -!> This routine determines if a point at location (y,z) is -!! on the regularly-spaced y-z grid. If it does, it returns the -!! index of the point on the grid. If it does not, it returns -1. -FUNCTION IndexOnGrid( p_grid, y, z ) - - TYPE(Grid_ParameterType), INTENT(IN) :: p_grid !< grid parameters - REAL(ReKi), INTENT(IN) :: y !< y position of point we're querying - REAL(ReKi), INTENT(IN) :: z !< z position of point we're querying - - INTEGER(IntKi) :: IndexOnGrid !< Index on regularly spaced grid - - ! local variables - INTEGER(IntKi) :: YIndx ! Index on regularly spaced grid - INTEGER(IntKi) :: ZIndx ! Index on regularly spaced grid - REAL(ReKi) :: y1 ! left-most location on grid - - - y1 = -0.5_ReKi * p_grid%GridWidth - - ZIndx = INT( Tolerance + ( z - p_grid%Zbottom ) / p_grid%GridRes_Z ) + 1 - - IF ( .NOT. EqualRealNos( p_grid%Zbottom + (ZIndx-1)*p_grid%GridRes_Z , z) ) THEN - IndexOnGrid = -1 - RETURN - END IF - - - - YIndx = INT( Tolerance + ( y - y1 ) / p_grid%GridRes_Y ) + 1 - - IF ( .NOT. EqualRealNos( y1 + (YIndx-1)*p_grid%GridRes_Y , y) ) THEN - IndexOnGrid = -1 - RETURN - END IF - - IF ( YIndx < 1 .OR. YIndx > p_grid%NumGrid_Y .OR. & - ZIndx < 1 .OR. ZIndx > p_grid%NumGrid_Z ) THEN - IndexOnGrid = -1 - RETURN - END IF - - - IndexOnGrid = (ZIndx-1)*p_grid%NumGrid_Y + YIndx - -END FUNCTION IndexOnGrid -!======================================================================= -!> This routine determines if a point at location (y,z) is -!! on the regularly-spaced y-z grid. If it does, it returns the -!! index of the point on the grid. If it does not, it returns -1. -FUNCTION IndexOnTower( p_grid, y, z ) - - TYPE(Grid_ParameterType), INTENT(IN) :: p_grid !< grid parameters - REAL(ReKi), INTENT(IN) :: y !< y position of point we're querying - REAL(ReKi), INTENT(IN) :: z !< z position of point we're querying - - INTEGER(IntKi) :: IndexOnTower !< Index on regularly spaced tower points - - ! local variables - INTEGER(IntKi) :: ZIndx ! Index on regularly spaced grid - - - IF ( .NOT. EqualRealNos( 0.0_ReKi , y) ) THEN - IndexOnTower = -1 - RETURN - END IF - - ZIndx = INT( Tolerance + ( p_grid%Zbottom - z ) / p_grid%GridRes_Z ) + 1 - - IF ( zIndx < 0 .OR. .NOT. EqualRealNos( p_grid%Zbottom - (ZIndx-1)*p_grid%GridRes_Z , z) ) THEN - IndexOnTower = -1 - RETURN - END IF - - IndexOnTower = ZIndx - - -END FUNCTION IndexOnTower -!======================================================================= -!> This routine calculates the wind components in the Inertial reference -!! frame. -SUBROUTINE SetPhaseAngles( p, OtherSt_RandNum, PhaseAngles, ErrStat, ErrMsg ) - - - TYPE(TurbSim_ParameterType), INTENT(IN ) :: p !< parameters for TurbSim - TYPE(RandNum_OtherStateType), INTENT(INOUT) :: OtherSt_RandNum !< other states for random number generation - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< error level/status - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< error message - - REAL(ReKi) , INTENT( OUT) :: PhaseAngles(p%grid%NPoints,p%grid%NumFreq,3) !< phases - - ! local variables - INTEGER(IntKi) :: iPoint, iPointUsr ! points that have phases defined already - - - ! generate random phases for all the points - - ! bjj: todo: don't generate the angles for user-specified time-series points, which have phases already - CALL RndPhases(p%RNG, OtherSt_RandNum, PhaseAngles, p%grid%NPoints, p%grid%NumFreq, p%US, ErrStat, ErrMsg) - - - IF (p%met%TurbModel_ID == SpecModel_TimeSer) THEN - - ! note: setting the phase angles this way assumes that p%usr%f(1:p%usr%nFreq) = p%grid%f(1:p%usr%nFreq) [i.e., TMax, AnalysisTime are equal]; - ! however, the simulated time series may have more frequencies and/or smaller time step than the user time-series input file. - DO iPointUsr = 1,p%usr%NPoints - - iPoint = iPointUsr - IF (iPointUsr == p%usr%RefPtID ) THEN - iPoint = p%usr%NPoints - ELSEIF (iPointUsr == p%usr%NPoints) THEN - iPoint = p%usr%RefPtID - END IF - PhaseAngles(iPoint,1:p%usr%nFreq,1:p%usr%nComp) = p%usr%phaseAngles(:,iPointUsr,:) - END DO - - END IF - - ! nyquist frequency must be real, thus phase angle must be 0: - PhaseAngles(:,p%grid%NumFreq,:) = 0.0_ReKi - -END SUBROUTINE SetPhaseAngles -!======================================================================= -!> This routine calculates the wind components in the Inertial reference -!! frame. -SUBROUTINE CalculateWindComponents(v, ubar, HFlowAng, VFlowAng, V_Inertial, UH, UT) - - REAL(ReKi), INTENT(IN) :: v(3) !< u,v,w components (streamwise) - REAL(ReKi), INTENT(IN) :: ubar !< mean streamwise component - REAL(ReKi), INTENT(IN) :: HFlowAng !< horizontal flow angle - REAL(ReKi), INTENT(IN) :: VFlowAng !< vertical flow angle - - REAL(ReKi), INTENT(OUT) :: V_Inertial(3) !< U,V,W components (inertial) - REAL(ReKi), INTENT(OUT),OPTIONAL :: UH !< horizontal wind speed (U+V components) - REAL(ReKi), INTENT(OUT),OPTIONAL :: UT !< total wind speed (U+V+W components) - - - - ! Local variables - REAL(ReKi) :: UTmp ! The instantaneous u-component wind speed at the hub - REAL(ReKi) :: UHTmp2 ! The square of the instantaneous horizontal wind speed at the hub - REAL(ReKi) :: V_Inertial2(3) ! the U,V,W components (inertial) squared - - REAL(ReKi) :: CVFA ! Cosine of the vertical flow angle - REAL(ReKi) :: SVFA ! Sine of the vertical flow angle - REAL(ReKi) :: CHFA ! Cosine of the horizontal flow angle - REAL(ReKi) :: SHFA ! Sine of the horizontal flow angle - - - CHFA = COS( HFlowAng*D2R ) - SHFA = SIN( HFlowAng*D2R ) - - CVFA = COS( VFlowAng*D2R ) - SVFA = SIN( VFlowAng*D2R ) - - - - ! Calculate longitudinal (UTmp) value for point, - ! as well as rotated (V_Inertial) - ! components applying specified flow angles. - - ! Add mean wind speed to the streamwise component - UTmp = v(1) + ubar - - ! Rotate the wind components from streamwise orientation to the X-Y-Z grid - V_Inertial(1) = UTmp*CHFA*CVFA - v(2)*SHFA - v(3)*CHFA*SVFA - V_Inertial(2) = UTmp*SHFA*CVFA + v(2)*CHFA - v(3)*SHFA*SVFA - V_Inertial(3) = UTmp*SVFA + v(3)*CVFA - - IF ( PRESENT( UH ) .OR. PRESENT( UT ) ) THEN - ! Calculate hub horizontal wind speed (UHTmp) and Total wind speed (UTTmp) - - V_Inertial2 = V_Inertial*V_Inertial !inertial frame coordinates - UHTmp2 = V_Inertial2(1) + V_Inertial2(2) !inertial frame coordinates - - IF ( PRESENT( UH ) ) UH = SQRT( UHTmp2 ) !inertial frame coordinates - IF ( PRESENT( UT ) ) UT = SQRT( UHTmp2 + V_Inertial2(3) ) - END IF - -END SUBROUTINE CalculateWindComponents -!======================================================================= -! This routine calculates the instantaneous Reynolds stresses, including TKE and CTKE -SUBROUTINE CalculateStresses(v, uv, uw, vw, TKE, CTKE ) - REAL(ReKi), INTENT(IN) :: v(3) !< u,v,w components (streamwise, zero-mean) - - REAL(ReKi), INTENT(OUT) :: uv !< The instantaneous u'v' Reynolds stress at the hub - REAL(ReKi), INTENT(OUT) :: uw !< The instantaneous u'w' Reynolds stress at the hub - REAL(ReKi), INTENT(OUT) :: vw !< The instantaneous v'w' Reynolds stress at the hub - REAL(ReKi), INTENT(OUT) :: TKE !< The instantaneous TKE at the hub - REAL(ReKi), INTENT(OUT) :: CTKE !< The instantaneous CTKE the hub - - - uv = v(1)*v(2) - uw = v(1)*v(3) - vw = v(2)*v(3) - - TKE = 0.5*(v(1)*v(1) + v(2)*v(2) + v(3)*v(3)) - CTKE = 0.5*SQRT(uv*uv + uw*uw + vw*vw) - -END SUBROUTINE CalculateStresses -!======================================================================= -!> Scale the velocity aligned along the sreamwise direction. -SUBROUTINE ScaleTimeSeries(p, V, ErrStat, ErrMsg) - - - TYPE(TurbSim_ParameterType), INTENT(IN) :: p !< TurbSim's parameters - REAL(ReKi), INTENT(INOUT) :: V(:,:,:) !< velocity, aligned along the streamwise direction without mean values added - INTEGER(IntKi), intent( out) :: ErrStat !< Error level - CHARACTER(*), intent( out) :: ErrMsg !< Message describing error - - - ErrStat = ErrID_None - ErrMsg = "" - - ! Crossfeed cross-axis components to u', v', w' components and scale IEC models if necessary - - SELECT CASE ( p%met%TurbModel_ID ) - !MLB: There does not seem to be a CASE for TurbModel=="API". - - CASE (SpecModel_GP_LLJ, & - SpecModel_NWTCUP, & - SpecModel_SMOOTH, & - SpecModel_WF_UPW, & - SpecModel_WF_07D, & - SpecModel_WF_14D, & - SpecModel_USRVKM, & - SpecModel_TIDAL, & - SpecModel_RIVER, & - SpecModel_USER ) ! Do reynolds stress for HYDRO also. - - - CALL TimeSeriesScaling_ReynoldsStress(p, V, ErrStat, ErrMsg) - - - CASE ( SpecModel_IECKAI , SpecModel_IECVKM ) ! API is considered an IEC model in this code, so it should fall here, if we wanted it - - CALL TimeSeriesScaling_IEC(p, V) - - END SELECT - -END SUBROUTINE ScaleTimeSeries -!======================================================================= -!> This routine scales the time series so that the output has the exact -!! statistics desired. This scaling has the effect of changing the amplitude -!! of the target spectra to account for discretizing the spectra over a -!! finite length of time. -SUBROUTINE TimeSeriesScaling_IEC(p, V) - - - TYPE(TurbSim_ParameterType), INTENT(IN) :: p !< TurbSim's parameters - REAL(ReKi), INTENT(INOUT) :: V(:,:,:) !< velocity, aligned along the streamwise direction without mean values added - - - REAL(DbKi) :: CGridSum ! The sums of the velocity components at the points surrounding the hub (or at the hub if it's on the grid) - REAL(DbKi) :: CGridSum2 ! The sums of the squared velocity components at the points surrouding the hub - REAL(ReKi) :: UGridMean ! Average wind speed at a point - REAL(ReKi) :: UGridSig ! Standard deviation of the wind speed at a point - INTEGER(IntKi) :: IT ! loop counter (time) - INTEGER(IntKi) :: Indx ! loop counter (grid point) - INTEGER(IntKi) :: IVec ! loop counter (wind component) - - - REAL(ReKi) :: ActualSigma(3) ! actual standard deviations - REAL(ReKi) :: HubFactor(3) ! factor used to scale standard deviations at the hub point - - IF (p%IEC%ScaleIEC < 1) RETURN - - DO IVec = 1,3 - CGridSum = 0.0 - CGridSum2 = 0.0 - - DO IT=1,p%grid%NumSteps !BJJ: NumOutSteps -- scale to the output value? - CGridSum = CGridSum + V( IT, p%grid%HubIndx, IVec ) - CGridSum2 = CGridSum2 + V( IT, p%grid%HubIndx, IVec )* V( IT, p%grid%HubIndx, IVec ) - ENDDO ! IT - - UGridMean = CGridSum/p%grid%NumSteps !BJJ: NumOutSteps -- scale to the output value? - ActualSigma(IVec) = SQRT( ABS( (CGridSum2/p%grid%NumSteps) - UGridMean*UGridMean ) ) - - - HubFactor(IVec) = p%IEC%SigmaIEC(IVec)/ActualSigma(IVec) ! factor = Target / actual - - IF (p%IEC%ScaleIEC == 1 .OR. p%met%SCMod(IVec) == CohMod_None) THEN ! with no coherence, all points have same std, so we'll save some calculations - - V(:,:,IVec) = HubFactor(IVec) * V(:,:,IVec) - - ELSE ! Scale each point individually - - DO Indx = 1,p%grid%NPoints - CGridSum = 0.0 - CGridSum2 = 0.0 - - DO IT=1,p%grid%NumSteps !BJJ: NumOutSteps -- scale to the output value? - CGridSum = CGridSum + V( IT, Indx, IVec ) - CGridSum2 = CGridSum2 + V( IT, Indx, IVec )* V( IT, Indx, IVec ) - ENDDO ! IT - - UGridMean = CGridSum/p%grid%NumSteps !BJJ: NumOutSteps -- scale to the output value? - UGridSig = SQRT( ABS( (CGridSum2/p%grid%NumSteps) - UGridMean*UGridMean ) ) - - V(:,Indx,IVec) = (p%IEC%SigmaIEC(IVec) / UGridSig) * V(:,Indx,IVec) - ENDDO ! Indx - - ENDIF - - ENDDO !IVec - - IF (p%US > 0 ) THEN - WRITE( p%US, "(//,'Scaling statistics from the hub grid point:',/)" ) - WRITE( p%US, "(2X,'Component Target Sigma (m/s) Simulated Sigma (m/s) Scaling Factor')" ) - WRITE( p%US, "(2X,'--------- ------------------ --------------------- --------------')" ) - - DO IVec = 1,3 - WRITE( p%US, "(5X,A,7x,f11.3,9x,f12.3,11x,f10.3)") Comp(IVec)//"'", p%IEC%SigmaIEC(IVec), & - ActualSigma(IVec), HubFactor(IVec) - END DO - END IF - - -END SUBROUTINE TimeSeriesScaling_IEC -!======================================================================= -!> This routine performs a linear combination of the uncorrelated zero-mean -!! velocity aligned along the streamwise direction to obtain the desired -!! Reynolds Stress values at the hub. -SUBROUTINE TimeSeriesScaling_ReynoldsStress(p, V, ErrStat, ErrMsg) - - ! passed variables - TYPE(TurbSim_ParameterType), INTENT(IN) :: p !< parameters - REAL(ReKi), INTENT(INOUT) :: V(:,:,:) !< velocity, aligned along the streamwise direction without mean values added - INTEGER(IntKi), intent( out) :: ErrStat !< Error level - CHARACTER(*), intent( out) :: ErrMsg !< Message describing error - - - ! local variables - REAL(DbKi) :: UVsum ! The sum of the u'v' Reynolds stress component at the hub - REAL(DbKi) :: UWsum ! The sum of the u'w' Reynolds stress component at the hub - REAL(DbKi) :: VWsum ! The sum of the v'w' Reynolds stress component at the hub - REAL(DbKi) :: UUsum ! The sum of the u'u' Reynolds stress component at the hub - REAL(DbKi) :: VVsum ! The sum of the v'v' Reynolds stress component at the hub - REAL(DbKi) :: WWsum ! The sum of the w'w' Reynolds stress component at the hub - - REAL(ReKi) :: UVmean ! The mean u'v' Reynolds stress component at the hub - REAL(ReKi) :: UWmean ! The mean u'w' Reynolds stress component at the hub - REAL(ReKi) :: VWmean ! The mean v'w' Reynolds stress component at the hub - REAL(ReKi) :: UUmean ! The mean u'u' Reynolds stress component at the hub - !REAL(ReKi) :: VVmean ! The mean v'v' Reynolds stress component at the hub - REAL(ReKi) :: WWmean ! The mean w'w' Reynolds stress component at the hub - - REAL(ReKi) :: alpha_uw ! The coefficient of the u component added to the w component for correlation - REAL(ReKi) :: alpha_uv ! The coefficient of the u component added to the v component for correlation - REAL(ReKi) :: alpha_wv ! The coefficient of the w component added to the v component for correlation - - REAL(ReKi) :: u_indept ! temporary copy of the uncorrelated u component of the velocity - REAL(ReKi) :: v_indept ! temporary copy of the uncorrelated v component of the velocity - REAL(ReKi) :: w_indept ! temporary copy of the uncorrelated w component of the velocity - - - REAL(ReKi) :: INumSteps ! Multiplicative Inverse of the Number of time Steps - - INTEGER(IntKi) :: ITime ! loop counter for time step/frequency - INTEGER(IntKi) :: IPoint ! loop counter for grid points - - - ErrStat = ErrID_None - ErrMsg = "" - - !................... - ! Calculate coefficients for obtaining "correct" Reynold's stresses at the hub - !................... - - ! compute mean values: - UWsum = 0.0_DbKi - UVsum = 0.0_DbKi - VWsum = 0.0_DbKi - UUSum = 0.0_DbKi - VVSum = 0.0_DbKi - WWSum = 0.0_DbKi - - DO ITime = 1,p%grid%NumSteps - UWsum = UWsum + V(ITime,p%grid%HubIndx,1) * V(ITime,p%grid%HubIndx,3) - UVsum = UVsum + V(ITime,p%grid%HubIndx,1) * V(ITime,p%grid%HubIndx,2) - VWsum = VWsum + V(ITime,p%grid%HubIndx,2) * V(ITime,p%grid%HubIndx,3) - UUSum = UUSum + V(ITime,p%grid%HubIndx,1) * V(ITime,p%grid%HubIndx,1) - !VVSum = VVSum + V(ITime,p%grid%HubIndx,2) * V(ITime,p%grid%HubIndx,2) - WWSum = WWSum + V(ITime,p%grid%HubIndx,3) * V(ITime,p%grid%HubIndx,3) - ENDDO - - INumSteps = 1.0/p%grid%NumSteps - - UWmean = UWsum * INumSteps - UVmean = UVsum * INumSteps - VWmean = VWsum * INumSteps - UUmean = UUSum * INumSteps - !VVmean = VVSum * INumSteps - WWmean = WWSum * INumSteps - - !BJJ: this is for v=alpha1, w=alpha2, u=alpha3 using derivation equations - alpha_uw = ( p%met%PC_UW - UWmean ) / UUmean !alpha23 - alpha_wv = ( UUmean*(p%met%PC_VW - VWmean - alpha_uw*UVmean) - p%met%PC_UW*(p%met%PC_UV - UVmean) ) / & !alpha12 - ( UUmean*(WWmean + alpha_uw*UWmean) - UWmean*p%met%PC_UW ) - alpha_uv = ( p%met%PC_UV - UVmean - alpha_wv*UWmean) / UUmean !alpha13 - - - ! if we enter "none" for any of the Reynolds-stress terms, don't scale that component: - IF (p%met%UWskip) alpha_uw = 0.0_ReKi - IF (p%met%UVskip) alpha_uv = 0.0_ReKi - IF (p%met%VWskip) alpha_wv = 0.0_ReKi - - !bjj: I'm implementing limits on the range of values here so that the spectra don't get too - ! out of whack. We'll display a warning in this case. - - IF ( ABS(alpha_uw) > 1.0 .OR. ABS(alpha_uv) > 1.0 .OR. ABS(alpha_wv) > 1.0 ) THEN - ErrStat = ErrID_Info - ErrMsg = "Scaling terms exceed 1.0. Reynolds stresses may be affected." - - alpha_uw = MAX( MIN( alpha_uw, 1.0_ReKi ), -1.0_ReKi ) - alpha_uv = MAX( MIN( alpha_uv, 1.0_ReKi ), -1.0_ReKi ) - alpha_wv = MAX( MIN( alpha_wv, 1.0_ReKi ), -1.0_ReKi ) - - ENDIF - - ! calculate the correlated time series: - - DO IPoint = 1,p%grid%NPoints - DO ITime = 1, p%grid%NumSteps - u_indept = V(ITime,IPoint,1) - v_indept = V(ITime,IPoint,2) - w_indept = V(ITime,IPoint,3) - - ! equation 16 [PC_UW] in TurbSim user's guide v1.50 - V(ITime,IPoint,2) = alpha_uv*u_indept + v_indept + alpha_wv*w_indept - V(ITime,IPoint,3) = alpha_uw*u_indept + w_indept - - ENDDO - ENDDO - - IF ( p%US > 0 ) THEN - - WRITE( p%US, "(//,'Scaling statistics from the hub grid point:',/)" ) - WRITE( p%US, "(3X, 'Cross-Component Scaling Factor')" ) - WRITE( p%US, "(3X, '--------------- --------------')" ) - WRITE( p%US, "(3X,A,2X,E14.5)" ) "u'w' ", alpha_uw - WRITE( p%US, "(3X,A,2X,E14.5)" ) "u'v' ", alpha_uv - WRITE( p%US, "(3X,A,2X,E14.5)" ) "v'w' ", alpha_wv - - END IF - -END SUBROUTINE TimeSeriesScaling_ReynoldsStress -!======================================================================= -SUBROUTINE AddMeanAndRotate(p, V, U, HWindDir, VWindDir) - - ! passed variables - TYPE(TurbSim_ParameterType), INTENT(IN) :: p !< parameters - REAL(ReKi), INTENT(INOUT) :: V(:,:,:) !< velocity, on input: aligned along with the mean velocity without mean values added - !! on output, aligned in the inertial reference frame with mean velocities added - REAL(ReKi), INTENT(IN) :: U (:) !< profile of steady wind speed - REAL(ReKi), INTENT(IN) :: HWindDir(:) !< profile of horizontal wind direction - REAL(ReKi), INTENT(IN) :: VWindDir(:) !< profile of vertical wind direction - - ! local variables - 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 - ! frame coordinate system - !.............................................................................. - 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: - - 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) - - TYPE(TurbSim_ParameterType), INTENT(INOUT) :: p !< parameters - - INTEGER(IntKi), intent( out) :: ErrStat ! Error level - CHARACTER(*), intent( out) :: ErrMsg ! Message describing error - - ! local variables - INTEGER(IntKi) :: UnOut ! unit for output files - INTEGER(IntKi) :: ErrStat2 ! Error level (local) - CHARACTER(MaxMsgLen) :: ErrMsg2 ! Message describing error (local) - CHARACTER(*), PARAMETER :: RoutineName = 'TS_ValidateInput' - - -ErrStat = ErrID_None -ErrMsg = "" - - -!BONNIE: UPPER LIMIT ON RICH_NO? -IF ( p%WrFile(FileExt_CTS) ) THEN - - ! models where coherent structures apply: - IF ( p%met%TurbModel_ID == SpecModel_GP_LLJ .OR. & - p%met%TurbModel_ID == SpecModel_NWTCUP .OR. & - p%met%TurbModel_ID == SpecModel_SMOOTH .OR. & - p%met%TurbModel_ID == SpecModel_WF_UPW .OR. & - p%met%TurbModel_ID == SpecModel_WF_07D .OR. & - p%met%TurbModel_ID == SpecModel_WF_14D ) THEN - - IF ( p%met%RICH_NO <= -0.05 ) THEN - CALL SetErrStat( ErrID_Info, 'A coherent turbulence time step file cannot be generated for RICH_NO <= -0.05.', ErrStat, ErrMsg, RoutineName) - p%WrFile(FileExt_CTS) = .FALSE. - ELSEIF ( .NOT. ( p%WrFile(FileExt_BTS) .OR. p%WrFile(FileExt_WND) ) ) THEN - CALL SetErrStat( ErrID_Info, 'AeroDyn Full-Field files(.bts) will be generated along with the coherent turbulence file.', ErrStat, ErrMsg, RoutineName) - p%WrFile(FileExt_BTS) = .TRUE. - ENDIF - - ELSE - CALL SetErrStat( ErrID_Info, 'A coherent turbulence time step file cannot be generated with the '//TRIM(p%met%TurbModel)//' model.', ErrStat, ErrMsg, RoutineName) - p%WrFile(FileExt_CTS) = .FALSE. - END IF - -ENDIF !WrAct - - ! Make sure inputs make sense for API model -IF ( p%met%TurbModel_ID == SpecModel_API ) THEN - IF ( .not. EqualRealNos( p%grid%AnalysisTime, 3600.0_ReKi) ) then ! warn if AnalysisTime isn't 1 hour (which is what we're assuming the URef is defined for) - CALL SetErrStat( ErrID_Warn, 'API model assumes URef is the 1-hour mean wind speed, even though AnalysisTime does not equal 3600 seconds.', ErrStat, ErrMsg, RoutineName ) - END IF - - IF ( p%IEC%ScaleIEC /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'API model does not provide time-series scaling to target standard deviation. Set ScaleIEC = 0.', ErrStat, ErrMsg, RoutineName ) - END IF - - IF ( .NOT. EqualRealNos( p%met%RefHt, 10.0_ReKi ) ) THEN - CALL SetErrStat( ErrID_Fatal, 'API model requires a 10-m reference height. Set RefHt = 10.', ErrStat, ErrMsg, RoutineName ) - END IF - -END IF - - - - ! Warn if EWM is used with incompatible times - -IF ( ( p%IEC%IEC_WindType == IEC_EWM1 .OR. p%IEC%IEC_WindType == IEC_EWM50 .OR. p%IEC%IEC_WindType == IEC_EWM100) .AND. & - ABS( 600.0_ReKi - MAX(p%grid%AnalysisTime,p%grid%UsableTime) ) > 90.0_ReKi ) THEN - CALL SetErrStat( ErrID_Warn, 'The EWM parameters are valid for 10-min simulations only.', ErrStat, ErrMsg, RoutineName) -ENDIF - - - ! Warn if Periodic is used with incompatible settings -IF ( p%grid%Periodic .AND. .NOT. EqualRealNos(p%grid%AnalysisTime, p%grid%UsableTime) ) THEN - CALL SetErrStat( ErrID_Warn, 'Periodic output files will not be generated when AnalysisTime /= UsableTime. Setting Periodic = .FALSE.', ErrStat, ErrMsg, RoutineName) - p%grid%Periodic = .FALSE. -END IF - - - ! Warn if tower points are output but grid is not: -IF ( p%WrFile(FileExt_TWR) .AND. .NOT. ( p%WrFile(FileExt_WND) .OR. p%WrFile(FileExt_BTS)) ) THEN - CALL SetErrStat( ErrID_Info, 'TurbSim .bts file will be generated to contain the tower points.', ErrStat, ErrMsg, RoutineName) - p%WrFile(FileExt_BTS) = .TRUE. -END IF - - - - ! Open appropriate output files. We will open formatted FF files later, if requested. - ! Mention the files in the summary file. - -IF ( ANY (p%WrFile) ) THEN - CALL GetNewUnit( UnOut ) - - WRITE (p%US,"( // 'You have requested that the following file(s) be generated:' / )") -! CALL WrScr1 ( ' You have requested that the following file(s) be generated:' ) - - IF ( p%WrFile(FileExt_BIN) ) THEN - -! CALL OpenBOutFile ( UnOut, TRIM( p%RootName)//'.bin', ErrStat, ErrMsg ) - CALL OpenUOutfile ( UnOut , TRIM( p%RootName)//'.bin', ErrStat2, ErrMsg2 ) ! just making sure it can be opened (not locked elsewhere) - CLOSE(UnOut) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - WRITE (p%US,"( 3X ,'"//TRIM( p%RootName)//".bin (binary hub-height turbulence-parameter file)' )") -! CALL WrScr ( ' '//TRIM( p%RootName)//'.bin (binary hub-height turbulence-parameter file)' ) - - ENDIF - - IF ( p%WrFile(FileExt_DAT) ) THEN - - CALL OpenFOutFile ( UnOut, TRIM( p%RootName)//'.dat', ErrStat2, ErrMsg2 ) ! just making sure it can be opened (not locked elsewhere) - CLOSE( UnOut ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - WRITE (p%US, "( 3X ,'"//TRIM( p%RootName)//".dat (formatted turbulence-parameter file)' )") -! CALL WrScr ( ' '//TRIM( p%RootName)//'.dat (formatted turbulence-parameter file)' ) - - ENDIF - - IF ( p%WrFile(FileExt_HH) ) THEN - - CALL OpenFOutFile ( UnOut, TRIM( p%RootName)//'.hh', ErrStat2, ErrMsg2 ) ! just making sure it can be opened (not locked elsewhere) - CLOSE( UnOut ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - WRITE (p%US,"( 3X ,'"//TRIM( p%RootName)//".hh (AeroDyn hub-height file)' )") -! CALL WrScr ( ' '//TRIM( p%RootName)//'.hh (AeroDyn hub-height file)' ) - - ENDIF - - IF ( p%WrFile(FileExt_BTS) ) THEN - - CALL OpenBOutFile ( UnOut, TRIM(p%RootName)//'.bts', ErrStat2, ErrMsg2 ) ! just making sure it can be opened (not locked elsewhere) - CLOSE( UnOut ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - WRITE (p%US,"( 3X ,'"//TRIM( p%RootName)//".bts (AeroDyn/TurbSim full-field wind file)' )") -! CALL WrScr ( ' '//TRIM( p%RootName)//'.bts (AeroDyn/TurbSim full-field wind file)' ) - - ENDIF - - IF ( p%WrFile(FileExt_WND) ) THEN - - CALL OpenBOutFile ( UnOut, TRIM(p%RootName)//'.wnd', ErrStat2, ErrMsg2 ) ! just making sure it can be opened (not locked elsewhere) - CLOSE(UnOut) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - WRITE (p%US,"( 3X ,'"//TRIM( p%RootName)//".wnd (AeroDyn/BLADED full-field wnd file)' )") -! CALL WrScr ( ' '//TRIM( p%RootName)//'.wnd (AeroDyn/BLADED full-field wnd file)' ) - - ENDIF - - IF ( p%WrFile(FileExt_TWR) .AND. p%WrFile(FileExt_WND) ) THEN - - CALL OpenBOutFile ( UnOut, TRIM( p%RootName )//'.twr', ErrStat2, ErrMsg2 ) ! just making sure it can be opened (not locked elsewhere) - CLOSE(UnOut) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - WRITE (p%US,"( 3X ,'"//TRIM( p%RootName)//".twr (binary tower file)' )") -! CALL WrScr ( ' '//TRIM( p%RootName)//'.twr (binary tower file)' ) - - ENDIF - - IF ( p%WrFile(FileExt_CTS) ) THEN - CALL OpenBOutFile ( UnOut, TRIM( p%RootName )//'.cts', ErrStat2, ErrMsg2 ) ! just making sure it can be opened (not locked elsewhere) - CLOSE(UnOut) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - WRITE (p%US,"( 3X ,'"//TRIM( p%RootName)//".cts (coherent turbulence time step file)' )") -! CALL WrScr ( ' '//TRIM( p%RootName)//'.cts (coherent turbulence time step file)' ) - ENDIF - - IF ( p%WrFile(FileExt_UVW) ) THEN - WRITE (p%US,"( 3X ,'"//TRIM( p%RootName)//".u (formatted full-field U-component file)' )") -! CALL WrScr ( ' '//TRIM( p%RootName)//'.u (formatted full-field U-component file)' ) - - WRITE (p%US,"( 3X ,'"//TRIM( p%RootName)//".v (formatted full-field V-component file)' )") -! CALL WrScr ( ' '//TRIM( p%RootName)//'.v (formatted full-field V-component file)' ) - - WRITE (p%US,"( 3X ,'"//TRIM( p%RootName)//".w (formatted full-field W-component file)' )") -! CALL WrScr ( ' '//TRIM( p%RootName)//'.w (formatted full-field W-component file)' ) - ENDIF - -ELSE - CALL SetErrStat( ErrID_Fatal, 'You have requested no output.', ErrStat, ErrMsg, RoutineName) -ENDIF - - ! WARN if using a large grid and not creating ff output files -IF ( p%grid%NumGrid_Y*p%grid%NumGrid_Z > 250 ) THEN - IF (.NOT. p%WrFile(FileExt_WND) .AND. .NOT. p%WrFile(FileExt_BTS) .AND. .NOT. p%WrFile(FileExt_UVW) ) THEN - - CALL SetErrStat( ErrID_Warn, 'You are using a large number of grid points but are not generating full-field output files.'//& - ' The simulation will run faster if you reduce the number of points on the grid.', ErrStat, ErrMsg, RoutineName) - END IF -END IF - -END SUBROUTINE TS_ValidateInput -!======================================================================= -SUBROUTINE TimeSeriesToSpectra( p, ErrStat, ErrMsg ) - - ! USE NWTC_FFTPACK - - ! passed variables - TYPE(TurbSim_ParameterType), INTENT(INOUT) :: p - - 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 for converting fourier coefficients to spectra - real(reki) :: Re, Im ! real and imaginary parts of complex variable returned from fft - - REAL(ReKi) :: meanU ! mean value of the U component - REAL(ReKi) :: meanV ! mean value of the V component - REAL(ReKi) :: meanW ! mean value of the W component - - REAL(DbKi) :: DelF ! delta frequency - - REAL(ReKi) :: cosH, sinH ! cosine and sin of horizontal angles - REAL(ReKi) :: cosV, sinV ! cosine and sin of vertical angles - REAL(ReKi) :: rotateMatrix(3,3) ! rotation matrix to align with direction of mean velocity - REAL(ReKi) :: uvw(3) ! temporary array to hold 3 velocity components in case < 3 were entered - - INTEGER(IntKi) :: Indx ! generic index - INTEGER(IntKi) :: iFreq ! loop counter for frequency - INTEGER(IntKi) :: iTime ! loop counter for time - INTEGER(IntKi) :: iVec ! loop counter for velocity components - INTEGER(IntKi) :: iPoint ! loop counter for grid points - INTEGER(IntKi) :: NumSteps ! number of time steps - - INTEGER(IntKi) :: ErrStat2 ! Error level (local) - CHARACTER(MaxMsgLen) :: ErrMsg2 ! error message (local) - CHARACTER(*), parameter :: RoutineName = 'TimeSeriesToSpectra' - - ErrStat = ErrID_None - ErrMsg = "" - - - ! BJJ: consider putting the call to PSF in the reading part - p%usr%nFreq = PSF ( p%usr%NTimes/2, 9, .TRUE.) - NumSteps = p%usr%nFreq*2 - - CALL AllocAry(p%usr%meanU, p%usr%NPoints,p%usr%nComp,'meanU', ErrStat2,ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry(p%usr%meanDir, p%usr%NPoints, 'meanDir', ErrStat2,ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry(p%usr%meanVAng, p%usr%NPoints, 'meanVAng', ErrStat2,ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry(p%usr%S, p%usr%nFreq ,p%usr%NPoints,p%usr%nComp,'S', ErrStat2,ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry(p%usr%f, p%usr%nFreq , 'f', ErrStat2,ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry(p%usr%phaseAngles,p%usr%nFreq ,p%usr%NPoints,p%usr%nComp,'phaseAngles',ErrStat2,ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry(work, NumSteps, 'work', ErrStat2,ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - !....................................................................... - ! calculate wind direction in radians (before rotating or removing mean): - !....................................................................... - - meanV = 0.0_ReKi - meanW = 0.0_ReKi - - DO iPoint = 1, p%usr%NPoints - meanU = sum(p%usr%v(:,iPoint,1))/p%usr%NTimes - - if (p%usr%nComp > 1 ) then - meanV = sum(p%usr%v(:,iPoint,2))/p%usr%NTimes - - if ( p%usr%nComp > 2 ) then - meanW = sum(p%usr%v(:,iPoint,3))/p%usr%NTimes - end if - - end if - - p%usr%meanDir( iPoint) = atan2( meanV, meanU ) - p%usr%meanVAng(iPoint) = atan2( meanW, sqrt( meanU**2 + meanV**2 ) ) - END DO - - !....................................................................... - ! rotate inputs based on angles at reference point: - !....................................................................... - uvw = 0.0_ReKi - DO iPoint = 1, p%usr%NPoints - - cosH = cos(p%usr%meanDir( iPoint ) ) - sinH = sin(p%usr%meanDir( iPoint ) ) - cosV = cos(p%usr%meanVAng( iPoint ) ) - sinV = sin(p%usr%meanVAng( iPoint ) ) - - rotateMatrix(1,1) = cosH*cosV - rotateMatrix(2,1) = -sinH - rotateMatrix(3,1) = -cosH*sinV - - rotateMatrix(1,2) = sinH*cosV - rotateMatrix(2,2) = cosH - rotateMatrix(3,2) = -sinH*sinV - - rotateMatrix(1,3) = sinV - rotateMatrix(2,3) = 0.0_ReKi - rotateMatrix(3,3) = cosV - - DO iTime = 1, p%usr%nTimes - uvw(1:p%usr%nComp) = p%usr%v(iTime,iPoint,:) - uvw = MATMUL( rotateMatrix, uvw ) - p%usr%v(iTime,iPoint,:) = uvw(1:p%usr%nComp) - END DO - - END DO - - ! now convert angles to degrees: - p%usr%meanDir = p%usr%meanDir * R2D - p%usr%meanVAng = p%usr%meanVAng * R2D - - - !....................................................................... - ! calculate and remove the mean wind components: - !....................................................................... - DO iVec = 1,p%usr%nComp - DO iPoint = 1, p%usr%NPoints - p%usr%meanU(iPoint,iVec) = SUM( p%usr%v(:,iPoint,iVec), 1 ) / p%usr%NTimes - p%usr%v(:, iPoint,iVec) = p%usr%v(:,iPoint,iVec) - p%usr%meanU(iPoint,iVec) - END DO - END DO - - - !....................................................................... - ! compute forward fft to get real and imaginary parts - ! S = Re^2 + Im^2 - ! PhaseAngle = acos( Re / S ) - !....................................................................... - - - CALL InitFFT( NumSteps, FFT_Data, NormalizeIn=.TRUE., ErrStat=ErrStat2 ) - CALL SetErrStat(ErrStat2, 'Error in InitFFT', ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - - ! Get the stationary-point time series. - DO iVec=1,p%usr%nComp - DO iPoint=1,p%usr%NPoints - - work = p%usr%v(:,iPoint,iVec) - - ! perform forward FFT - - CALL ApplyFFT_f( work, FFT_Data, ErrStat2 ) - IF (ErrStat2 /= ErrID_None ) THEN - CALL SetErrStat(ErrStat2, 'Error in ApplyFFT_f for point '//TRIM(Num2LStr(iPoint))//'.', ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) EXIT - END IF - - - DO iFreq = 1,p%usr%nFreq-1 - Indx = iFreq*2 - Re = work(Indx) - Im = work(Indx+1) - - p%usr%S( iFreq,iPoint,iVec) = Re**2 + Im**2 - - IF ( p%usr%S( iFreq,iPoint,iVec) /= 0.0_ReKi ) THEN - p%usr%PhaseAngles(iFreq,iPoint,iVec) = atan2( Im, Re ) ! this gives us the angles in range -pi to pi - if ( p%usr%PhaseAngles(iFreq,iPoint,iVec) < 0.0_ReKi ) then ! we want it in the range 0 to 2pi - p%usr%PhaseAngles(iFreq,iPoint,iVec) = TwoPi + p%usr%PhaseAngles(iFreq,iPoint,iVec) - end if - ELSE - p%usr%PhaseAngles(iFreq,iPoint,iVec) = 0.0_ReKi - END IF - END DO - - p%usr%S( p%usr%nFreq,iPoint,iVec) = work(NumSteps)**2 !0.0_ReKi !work(NumSteps)**2 ! this frequency doesn't seem to get used in the code, so I'm going to set it to zero. <<< bjj: will be used for extrapolation - p%usr%PhaseAngles(p%usr%nFreq,iPoint,iVec) = 0.0_ReKi - - ENDDO ! IPoint - ENDDO ! IVec - - ! calculate associated frequencies: - p%usr%DelF = 1.0_DbKi / ( NumSteps * ( p%usr%t(2) - p%usr%t(1) ) ) !store frequency in double precision for cases of very long time series - do iFreq=1,p%usr%nFreq - p%usr%f(iFreq) = p%usr%DelF * iFreq - end do - - p%usr%S = p%usr%S*real(2.0_DbKi/p%usr%DelF,ReKi) ! p%usr%S*2.0_ReKi/p%usr%f(1) ! make this the single-sided velocity spectra we're using in the rest of the code - - - CALL Cleanup() - - RETURN -CONTAINS -!........................................... - SUBROUTINE Cleanup() - - CALL ExitFFT( FFT_Data, ErrStat2 ) - CALL SetErrStat(ErrStat2, 'Error in ExitFFT', ErrStat, ErrMsg, RoutineName ) - - IF ( ALLOCATED(work) ) DEALLOCATE(work) - - ! we don't need these anymore: - IF ( ALLOCATED( p%usr%t ) ) DEALLOCATE( p%usr%t ) - IF ( ALLOCATED( p%usr%v ) ) DEALLOCATE( p%usr%v ) - - END SUBROUTINE Cleanup - -END SUBROUTINE TimeSeriesToSpectra -!======================================================================= -SUBROUTINE TS_End(p, OtherSt_RandNum) - - - TYPE(TurbSim_ParameterType), INTENT(INOUT) :: p !< parameters - TYPE(RandNum_OtherStateType), INTENT(INOUT) :: OtherSt_RandNum !< other states for random numbers (next seed, etc) - - - IF (p%US > 0) THEN - CLOSE( p%US ) - p%US = -1 - END IF - - -!bjj: todo: add more; make sure everything is deallocated here; make sure files are closed, too. - - IF ( ALLOCATED( p%grid%Y ) ) DEALLOCATE( p%grid%Y ) - IF ( ALLOCATED( p%grid%Z ) ) DEALLOCATE( p%grid%Z ) - IF ( ALLOCATED( p%grid%GridPtIndx ) ) DEALLOCATE( p%grid%GridPtIndx ) - IF ( ALLOCATED( p%grid%TwrPtIndx ) ) DEALLOCATE( p%grid%TwrPtIndx ) - IF ( ALLOCATED( p%grid%Freq ) ) DEALLOCATE( p%grid%Freq ) - - IF ( ALLOCATED( p%met%ZL_profile ) ) DEALLOCATE( p%met%ZL_profile ) - IF ( ALLOCATED( p%met%Ustar_profile ) ) DEALLOCATE( p%met%Ustar_profile ) - - IF ( ALLOCATED( p%met%USR_Z ) ) DEALLOCATE( p%met%USR_Z ) - IF ( ALLOCATED( p%met%USR_U ) ) DEALLOCATE( p%met%USR_U ) - IF ( ALLOCATED( p%met%USR_WindDir ) ) DEALLOCATE( p%met%USR_WindDir ) - IF ( ALLOCATED( p%met%USR_Sigma ) ) DEALLOCATE( p%met%USR_Sigma ) - IF ( ALLOCATED( p%met%USR_L ) ) DEALLOCATE( p%met%USR_L ) - - IF ( ALLOCATED( p%usr%pointyi ) ) DEALLOCATE( p%usr%pointyi ) - IF ( ALLOCATED( p%usr%pointzi ) ) DEALLOCATE( p%usr%pointzi ) - IF ( ALLOCATED( p%usr%t ) ) DEALLOCATE( p%usr%t ) - IF ( ALLOCATED( p%usr%v ) ) DEALLOCATE( p%usr%v ) - - IF ( ALLOCATED( p%usr%meanU ) ) DEALLOCATE( p%usr%meanU ) - IF ( ALLOCATED( p%usr%meanDir ) ) DEALLOCATE( p%usr%meanDir ) - IF ( ALLOCATED( p%usr%meanVAng ) ) DEALLOCATE( p%usr%meanVAng ) - - IF ( ALLOCATED( p%usr%f ) ) DEALLOCATE( p%usr%f ) - IF ( ALLOCATED( p%usr%S ) ) DEALLOCATE( p%usr%S ) - IF ( ALLOCATED( p%usr%phaseAngles ) ) DEALLOCATE( p%usr%phaseAngles ) - - IF ( ALLOCATED( p%RNG%RandSeedAry ) ) DEALLOCATE( p%RNG%RandSeedAry ) - - - IF (ALLOCATED(OtherSt_RandNum%nextSeed) ) DEALLOCATE(OtherSt_RandNum%nextSeed) - - -END SUBROUTINE TS_END -!======================================================================= -END MODULE TSSubs diff --git a/OpenFAST/modules/turbsim/src/TurbSim.f90 b/OpenFAST/modules/turbsim/src/TurbSim.f90 deleted file mode 100644 index e07223fa2..000000000 --- a/OpenFAST/modules/turbsim/src/TurbSim.f90 +++ /dev/null @@ -1,386 +0,0 @@ -!======================================================================= -PROGRAM TurbSim - - ! A turbulence simulator developed at the - ! National Renewable Energy Laboratory, Golden, Colorado - ! - ! v1.0a-bjj 15-Mar-2004 B. Jonkman - ! v1.0 4-Nov-2005 B. Jonkman - ! v1.01 24-Jan-2006 B. Jonkman (NWTC subs v1.00a-mlb) - ! v1.10 10-Apr-2006 B. Jonkman (NWTC subs v1.12) - ! v1.20 20-Oct-2006 B. Jonkman (NWTC subs v1.12) - ! v1.21 1-Feb-2007 B. Jonkman (NWTC subs v1.12) - ! v1.30 4-Apr-2008 B. Jonkman (NWTC subs v1.01.09) - ! v1.40 12-Sep-2008 B. Jonkman (NWTC subs v1.01.09) - ! v1.41h 11-Jun-2009 B. Jonkman (NWTC subs v1.01.09) - ! v1.50 25-Sep-2009 B. Jonkman (NWTC subs v1.01.09) - ! V1.06.00 21-Sep-2012 L. Kilcher & B. Jonkman (NWTC Library v1.04.01) - ! v1.07.00a-bjj 9-Jul-2014 B. Jonkman (NWTC Library v1.04.02a-bjj) - ! v2.00.00a-bjj Oct-2014 B. Jonkman (NWTC Library 2.0) - ! - ! This program simulates a full field of turbulent winds at points in space - ! in a rectangular Cartesian plane perpendicular to the mean wind direction. - ! - ! Example usage: at a command prompt, type - ! turbsim turbsim.inp - ! This will read the text input file named "turbsim.inp" - - ! ------------------------------------------------------------------------------------------------------- - ! This is for dimension 2 of V(:,:,:).... - ! - ! The grid of points on the Cartesian plane is numbered in the following way (notice that the first - ! height starts at the bottom of the grid): - ! - ! Yb(1) Yb(2) Yb(3) ... Yb(NumGrid_Y) - ! -------------------------------------------------------------------------------------------------------------------------------------------- - ! Zb(NumGrid_Z):|V(GridPtIndx(NumGrid_Y*(NumGrid_Z-1)+1)) ... V(GridPtIndx(NumGrid_Z*NumGrid_Y)) | - ! ... |... | - ! Zb(2) :|V(GridPtIndx(NumGrid_Y + 1)) V(GridPtIndx(NumGrid_Y + 2)) V(GridPtIndx(NumGrid_Y + 3)) ... V(GridPtIndx( 2*NumGrid_Y)) | - ! Zb(1) :|V(GridPtIndx( 1)) V(GridPtIndx( 2)) V(GridPtIndx( 3)) ... V(GridPtIndx( NumGrid_Y)) | - ! -------------------------------------------------------------------------------------------------------------------------------------------- - ! - ! Zb(i) < Zb(i+1) for all integers i, 1 <= i < NumGrid_Z - ! Yb(j) < Yb(j+1) for all integers j, 1 <= j < NumGrid_Y - ! note that the Y and Z arrays used in the code are NOT necessarially in the order of Yb and Zb described here. - ! - ! If an extra hub point is necessary because the point does not fall on the grid, - ! then it is added immediately following the regular grid points. - ! - ! If the tower wind file output is selected, those extra points (in a single vertical - ! line) are added at the end, at the end (after the grid and hub point). - ! - ! Any user-defined time-series points are stored at the BEGINNING, before the grid points. - ! -------------------------------------------------------------------------------------------------------- - - -USE TSsubs -USE TS_FileIO -USE TS_Profiles -use TS_CohStructures -use VersionInfo - -IMPLICIT NONE - - - ! Declare local variables - -TYPE( TurbSim_ParameterType ) :: p ! TurbSim parameters -TYPE(RandNum_OtherStateType) :: OtherSt_RandNum ! other states for random numbers (next seed, etc) - -REAL(ReKi), ALLOCATABLE :: PhaseAngles (:,:,:) ! The array that holds the random phases [number of points, number of frequencies, number of wind components=3]. -REAL(ReKi), ALLOCATABLE :: S (:,:,:) ! The turbulence PSD array (NumFreq,NPoints,3). -REAL(ReKi), ALLOCATABLE :: V (:,:,:) ! An array containing the summations of the rows of H (NumSteps,NPoints,3). -REAL(ReKi), ALLOCATABLE :: U (:) ! The steady u-component wind speeds for the grid (NPoints). -REAL(ReKi), ALLOCATABLE :: HWindDir (:) ! A profile of horizontal wind angle (NPoints) (measure of wind direction with height) -REAL(ReKi), ALLOCATABLE :: VWindDir (:) ! A profile of vretical wind angle (NPoints) (measure of wind vertical angle with height) - -REAL(ReKi) :: CPUtime ! Contains the number of seconds since the start of the program - -REAL(ReKi) :: USig ! Standard deviation of the u-component wind speed at the hub (used for scaling WND files) -REAL(ReKi) :: VSig ! Standard deviation of the v-component wind speed at the hub (used for scaling WND files) -REAL(ReKi) :: WSig ! Standard deviation of the w-component wind speed at the hub (used for scaling WND files and CTS files) - -INTEGER(IntKi) :: ErrStat ! allocation status -CHARACTER(MaxMsgLen) :: ErrMsg ! error message -CHARACTER(200) :: InFile ! Name of the TurbSim input file. -CHARACTER(200) :: git_commit ! String containing the current git commit hash -CHARACTER(20) :: FlagArg ! flag argument from command line - - -!BONNIE:***************************** -! Time = TIMEF() ! Initialize the Wall Clock Time counter -!BONNIE:***************************** - -p%US = -1 - - ! ... Initialize NWTC Library (open console, set pi constants) ... -CALL NWTC_Init( ProgNameIN=TurbSim_Ver%Name, EchoLibVer=.FALSE. ) - - ! Check for command line arguments. -InFile = 'TurbSim.inp' ! default name for input file -CALL CheckArgs( InFile, Flag=FlagArg ) -IF ( LEN( TRIM(FlagArg) ) > 0 ) CALL NormStop() - - ! Print out program name, version, and date. - - ! Display the copyright notice - CALL DispCopyrightLicense( TurbSim_Ver%Name ) - ! Obtain OpenFAST git commit hash - git_commit = QueryGitVersion() - ! Tell our users what they're running - CALL WrScr( ' Running '//TRIM( TurbSim_Ver%Name )//' a part of OpenFAST - '//TRIM(git_Commit)//NewLine//' linked with '//TRIM( NWTC_Ver%Name )//NewLine ) - -CALL GetRoot( InFile, p%RootName ) - - ! Open input file and summary file. - -CALL OpenSummaryFile( p%RootName, p%US, p%DescStr, ErrStat, ErrMsg ) -CALL CheckError(ErrStat, ErrMsg) - - ! Get input parameters. - -CALL ReadInputFile(InFile, p, OtherSt_RandNum, ErrStat, ErrMsg) -CALL CheckError(ErrStat, ErrMsg) - -CALL WrSum_EchoInputs(p) -call WrSum_UserInput(p%met,p%usr, p%US) - -CALL TS_ValidateInput(p, ErrStat, ErrMsg) -CALL CheckError(ErrStat, ErrMsg) - - -!.................................................................................................................................. -! Define the spatial grid -!.................................................................................................................................. - - ! Define the other parameters for the time series. -CALL CreateGrid( p%grid, p%usr, p%UHub, p%WrFile(FileExt_TWR), ErrStat, ErrMsg ) -CALL CheckError(ErrStat, ErrMsg) - -!.................................................................................................................................. -! Calculate mean velocity and direction profiles: -!.................................................................................................................................. - - ! Wind speed: -CALL AllocAry(U, SIZE(p%grid%Z), 'u (steady, u-component winds)', ErrStat, ErrMsg ) -CALL CheckError(ErrStat, ErrMsg) - -CALL getVelocityProfile( p, p%UHub, p%grid%HubHt, p%grid%Z, U, ErrStat, ErrMsg) -CALL CheckError(ErrStat, ErrMsg) - - ! Wind Direction: -CALL AllocAry(HWindDir, SIZE(p%grid%Z), 'HWindDir (wind direction profile)', ErrStat, ErrMsg ) ! Allocate the array for the wind direction profile -CALL CheckError(ErrStat, ErrMsg) - -CALL AllocAry(VWindDir, SIZE(p%grid%Z), 'VWindDir (vertical wind angle profile)', ErrStat, ErrMsg ) ! Allocate the array for the vertical wind profile -CALL CheckError(ErrStat, ErrMsg) - -CALL getDirectionProfile(p, p%grid%Z, HWindDir, VWindDir, ErrStat, ErrMsg) -CALL CheckError(ErrStat, ErrMsg) - -p%met%HH_HFlowAng = HWindDir( p%grid%HubIndx ) -p%met%HH_VFlowAng = VWindDir( p%grid%HubIndx ) - -!.................................................................................................................................. -! Calculate remaining parameters required for simulation: -!.................................................................................................................................. - - -IF ( p%met%TurbModel_ID == SpecModel_GP_LLJ) THEN - - ! Allocate the arrays for the z/l and ustar profile - - CALL AllocAry(p%met%ZL_profile, SIZE(p%grid%Z), 'ZL_profile (z/l profile)', ErrStat, ErrMsg ) - CALL CheckError(ErrStat, ErrMsg) - CALL AllocAry(p%met%Ustar_profile, SIZE(p%grid%Z), 'Ustar_profile (friction velocity profile)', ErrStat, ErrMsg ) - CALL CheckError(ErrStat, ErrMsg) - - p%met%ZL_profile(:) = getZLProfile( U, p%grid%Z, p%met%Rich_No, p%met%ZL, p%met%L, p%met%ZLOffset, p%met%WindProfileType ) - p%met%Ustar_profile(:) = getUStarProfile( p, U, p%grid%Z, p%met%UStarOffset, p%met%UStarSlope ) - -END IF - - -CALL WrSum_SpecModel( p, U, HWindDir, VWindDir, ErrStat, ErrMsg ) -CALL CheckError(ErrStat, ErrMsg) - - -!.................................................................................................................................. -! Get the single-point power spectral densities -!.................................................................................................................................. - -CALL AllocAry( S, p%grid%NumFreq,p%grid%NPoints,3, 'S (turbulence PSD)',ErrStat, ErrMsg ) -CALL CheckError(ErrStat, ErrMsg) - -CALL CalcTargetPSD(p, S, U, ErrStat, ErrMsg) -CALL CheckError(ErrStat, ErrMsg) - - ! we don't need these arrays any more, so deallocate to save some space -IF ( ALLOCATED( p%met%USR_Z ) ) DEALLOCATE( p%met%USR_Z ) -IF ( ALLOCATED( p%met%USR_U ) ) DEALLOCATE( p%met%USR_U ) -IF ( ALLOCATED( p%met%USR_WindDir ) ) DEALLOCATE( p%met%USR_WindDir ) -IF ( ALLOCATED( p%met%USR_Sigma ) ) DEALLOCATE( p%met%USR_Sigma ) -IF ( ALLOCATED( p%met%USR_L ) ) DEALLOCATE( p%met%USR_L ) - -IF ( ALLOCATED( p%met%ZL_profile ) ) DEALLOCATE( p%met%ZL_profile ) -IF ( ALLOCATED( p%met%Ustar_profile ) ) DEALLOCATE( p%met%Ustar_profile ) - -!IF ( ALLOCATED( p%usr%f ) ) DEALLOCATE( p%usr%f ) bjj: do we need to keep these for phase angles? -IF ( ALLOCATED( p%usr%S ) ) DEALLOCATE( p%usr%S ) -IF ( ALLOCATED( p%usr%meanU ) ) DEALLOCATE( p%usr%meanU ) -IF ( ALLOCATED( p%usr%meanDir ) ) DEALLOCATE( p%usr%meanDir ) -IF ( ALLOCATED( p%usr%meanVAng ) ) DEALLOCATE( p%usr%meanVAng ) - -!.................................................................................................................................. -! Get the phase angles -!.................................................................................................................................. - -CALL AllocAry( PhaseAngles, p%grid%NPoints, p%grid%NumFreq, 3, 'Random Phases', ErrStat, ErrMsg ) -CALL CheckError(ErrStat, ErrMsg) - -CALL SetPhaseAngles( p, OtherSt_RandNum, PhaseAngles, ErrStat, ErrMsg ) -CALL CheckError(ErrStat, ErrMsg) - - ! we don't need these arrays any more, so deallocate to save some space -IF ( ALLOCATED(OtherSt_RandNum%nextSeed ) ) DEALLOCATE( OtherSt_RandNum%nextSeed ) -IF ( ALLOCATED(p%usr%PhaseAngles ) ) DEALLOCATE( p%usr%PhaseAngles ) -IF ( ALLOCATED(p%usr%f ) ) DEALLOCATE( p%usr%f ) ! bjj: do we need to keep these for phase angles or should we destroy earlier? - -!.................................................................................................................................. -! Get the Fourier Coefficients -!.................................................................................................................................. -CALL AllocAry( V, p%grid%NumSteps, p%grid%NPoints, 3, 'V (velocity)', ErrStat, ErrMsg) ! Allocate the array that contains the velocities. -CALL CheckError(ErrStat, ErrMsg) - - - ! Calculate the transfer function matrices from the spectral matrix (the fourier coefficients). - -CALL WrScr ( ' Calculating the spectral and transfer function matrices:' ) - -CALL CalcFourierCoeffs( p, U, PhaseAngles, S, V, ErrStat, ErrMsg ) -CALL CheckError(ErrStat, ErrMsg) - - - ! we don't need these arrays any more, so deallocate to save some space -IF ( ALLOCATED( p%grid%Freq ) ) DEALLOCATE( p%grid%Freq ) -IF ( ALLOCATED( S ) ) DEALLOCATE( S ) -IF ( ALLOCATED( PhaseAngles ) ) DEALLOCATE( PhaseAngles ) - -!.................................................................................................................................. -! Create the time series -!.................................................................................................................................. -CALL Coeffs2TimeSeries( V, p%grid%NumSteps, p%grid%NPoints, p%usr%NPoints, ErrStat, ErrMsg) -CALL CheckError(ErrStat, ErrMsg) - -!.................................................................................................................................. -! Scale time series (if desired) for cross-component correlation or IEC statistics: -!.................................................................................................................................. -CALL ScaleTimeSeries(p, V, ErrStat, ErrMsg) -CALL CheckError(ErrStat, ErrMsg) - - -!.................................................................................................................................. -! Write statistics of the run to the summary file: -!.................................................................................................................................. -CALL WrSum_Stats(p, V, USig, VSig, WSig, ErrStat, ErrMsg) -CALL CheckError(ErrStat, ErrMsg) - -!.................................................................................................................................. -! Write hub-height output files (before adding mean and rotating final results) -!.................................................................................................................................. - -IF ( p%WrFile(FileExt_HH) ) THEN - CALL WrHH_ADtxtfile(p, V, p%IEC%TurbInt, ErrStat, ErrMsg) - CALL CheckError(ErrStat, ErrMsg) -END IF - -IF ( p%WrFile(FileExt_BIN) ) THEN - CALL WrHH_binary(p, V, ErrStat, ErrMsg) - CALL CheckError(ErrStat, ErrMsg) -END IF - -IF ( p%WrFile(FileExt_DAT) ) THEN - CALL WrHH_text(p, V, ErrStat, ErrMsg ) - CALL CheckError(ErrStat, ErrMsg) -END IF - - -!.................................................................................................................................. -! Add mean wind to u' components and rotate to inertial reference frame coordinate system -!.................................................................................................................................. -CALL AddMeanAndRotate(p, V, U, HWindDir, VWindDir) - - ! Deallocate memory for the matrix of the steady, u-component winds. - -IF ( ALLOCATED( U ) ) DEALLOCATE( U ) -IF ( ALLOCATED( HWindDir ) ) DEALLOCATE( HWindDir ) -IF ( ALLOCATED( VWindDir ) ) DEALLOCATE( VWindDir ) - -!.................................................................................................................................. -! Generate coherent turbulence if desired: -!.................................................................................................................................. -IF ( p%WrFile(FileExt_CTS) ) THEN - - CALL CohStr_WriteCTS(p, WSig, OtherSt_RandNum, ErrStat, ErrMsg) - CALL CheckError(ErrStat, ErrMsg) - -ENDIF !WrACT - -!.................................................................................................................................. -! Generate full-field output files: -!.................................................................................................................................. - - ! Are we generating binary FF files? -IF ( p%WrFile(FileExt_BTS) .OR. p%WrFile(FileExt_WND) ) THEN - CALL WrSum_InterpolatedHubStats(p, V) - - IF ( p%WrFile(FileExt_BTS) ) THEN - CALL WrBinTURBSIM(p, V, ErrStat, ErrMsg) - CALL CheckError(ErrStat, ErrMsg) - END IF - - IF ( p%WrFile(FileExt_WND) ) THEN - CALL WrBinBLADED(p, V, USig, VSig, WSig, ErrStat, ErrMsg) - CALL CheckError(ErrStat, ErrMsg) - END IF -END IF - - - ! Are we generating formatted (text) FF files? -IF ( p%WrFile(FileExt_UVW) ) THEN - CALL WrFormattedFF(p%RootName, p%grid, p%UHub, V) -ENDIF ! ( WrFile(FileExt_UVW) ) - -!.................................................................................................................................. -! End: -!.................................................................................................................................. - -IF ( ALLOCATED( V ) ) DEALLOCATE( V ) - - - ! Request CPU-time used. - -CALL CPU_TIME ( CPUtime ) -WRITE (p%US,"(//,'Processing complete. ',A,' CPU seconds used.')") TRIM( Num2LStr( CPUtime ) ) -CALL WrScr1 ( ' Processing complete. '//TRIM( Num2LStr( CPUtime ) )//' CPU seconds used.' ) - -CALL TS_End( p, OtherSt_RandNum ) -CALL NormStop - - -CONTAINS -!.................................................................................................................................. -SUBROUTINE CheckError(ErrID,Msg) - INTEGER(IntKi), INTENT(IN) :: ErrID ! The error identifier (ErrStat) - CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) - - - IF (ErrID /= ErrID_None) THEN - - IF (ErrID >= AbortErrLev) THEN - - IF (ALLOCATED(PhaseAngles)) DEALLOCATE(PhaseAngles) - IF (ALLOCATED(S )) DEALLOCATE(S ) - IF (ALLOCATED(V )) DEALLOCATE(V ) - IF (ALLOCATED(U )) DEALLOCATE(U ) - IF (ALLOCATED(HWindDir )) DEALLOCATE(HWindDir ) - IF (ALLOCATED(VWindDir )) DEALLOCATE(VWindDir ) - - - if (p%US > 0) then - WRITE (p%US, "(/'ERROR: ', A / )") TRIM(Msg) - WRITE (p%US, "('ABORTING PROGRAM.')" ) - end if - - CALL TS_end(p, OtherSt_RandNum) - - CALL ProgAbort ( TRIM(Msg), .FALSE., 5.0_ReKi ) - - ELSE - CALL WrScr(TRIM(Msg)) - END IF - - END IF -END SUBROUTINE CheckError - -END PROGRAM diff --git a/OpenFAST/modules/turbsim/src/TurbSim_Types.f90 b/OpenFAST/modules/turbsim/src/TurbSim_Types.f90 deleted file mode 100644 index 3e99754b0..000000000 --- a/OpenFAST/modules/turbsim/src/TurbSim_Types.f90 +++ /dev/null @@ -1,299 +0,0 @@ -!================================================================================================================================== -MODULE TurbSim_Types - -use NWTC_Library - - TYPE(ProgDesc), PARAMETER :: TurbSim_Ver = ProgDesc( 'TurbSim', '', '' ) - - LOGICAL, PARAMETER :: MVK = .FALSE. ! This parameter has been added to replace the NON-STANDARD compiler directive previously used - LOGICAL, PARAMETER :: PeriodicY = .FALSE. !.TRUE. - - - INTEGER(IntKi), PARAMETER :: MaxMsgLen = 1024 ! Maximum length of error messages - - ! Valid spectral models (i.e., turbulence models; values of TurbModel_ID) - INTEGER(IntKi), PARAMETER :: SpecModel_NONE = 0 ! No turbulence - INTEGER(IntKi), PARAMETER :: SpecModel_IECKAI = 1 ! IEC Kaimal - INTEGER(IntKi), PARAMETER :: SpecModel_IECVKM = 2 ! IEC von Karman - INTEGER(IntKi), PARAMETER :: SpecModel_GP_LLJ = 3 ! Great Plains Low-Level Jet - INTEGER(IntKi), PARAMETER :: SpecModel_NWTCUP = 4 ! NWTC (upwind) - INTEGER(IntKi), PARAMETER :: SpecModel_SMOOTH = 5 ! Risoe Smooth-Terrain - INTEGER(IntKi), PARAMETER :: SpecModel_WF_UPW = 6 ! Wind Farm Upwind - INTEGER(IntKi), PARAMETER :: SpecModel_WF_07D = 7 ! Wind Farm 7 rotor diameters downwind - INTEGER(IntKi), PARAMETER :: SpecModel_WF_14D = 8 ! Wind Farm 14 rotor diameters downwind - INTEGER(IntKi), PARAMETER :: SpecModel_TIDAL = 9 ! Tidal (Hydro) - INTEGER(IntKi), PARAMETER :: SpecModel_RIVER = 10 ! River (Hydro) - INTEGER(IntKi), PARAMETER :: SpecModel_API = 11 ! API - INTEGER(IntKi), PARAMETER :: SpecModel_MODVKM = 12 ! user-specified scaling in von Karman model - INTEGER(IntKi), PARAMETER :: SpecModel_USRVKM = 13 ! user-specified scaling in von Karman model - INTEGER(IntKi), PARAMETER :: SpecModel_USER = 14 ! User-defined spectra from file - INTEGER(IntKi), PARAMETER :: SpecModel_TimeSer = 15 ! time series input from file - - ! Spatial Coherence Models (SCMod) - INTEGER(IntKi), PARAMETER :: CohMod_NONE = 0 ! no additional spatial coherence - INTEGER(IntKi), PARAMETER :: CohMod_GENERAL = 1 ! General spatial coherence model using parameters input from file - INTEGER(IntKi), PARAMETER :: CohMod_IEC = 2 ! Spatial coherence specified by IEC standard - INTEGER(IntKi), PARAMETER :: CohMod_API = 3 ! Spatial coherence specified by API standard - - - ! IEC turbulence types (IEC_WindType) - ! bjj: note that EWM models *MUST* directly follow ETM, and EWM models must be at the end - INTEGER(IntKi), PARAMETER :: IEC_NTM = 1 ! Number to indicate the IEC Normal Turbulence Model - INTEGER(IntKi), PARAMETER :: IEC_ETM = 2 ! Number to indicate the IEC Extreme Turbulence Model - INTEGER(IntKi), PARAMETER :: IEC_EWM1 = 3 ! Number to indicate the IEC Extreme Wind speed Model ( 1-year) - INTEGER(IntKi), PARAMETER :: IEC_EWM50 = 4 ! Number to indicate the IEC Extreme Wind speed Model ( 50-year) - INTEGER(IntKi), PARAMETER :: IEC_EWM100 = 5 ! Number to indicate the IEC Extreme Wind speed Model (100-year) - - - ! distinct output file formats (WrFile()) (listed by extension) - INTEGER(IntKi), PARAMETER :: FileExt_BTS = 1 ! .bts file : AeroDyn FF data (binary) [WrADFF] - INTEGER(IntKi), PARAMETER :: FileExt_WND = 2 ! .wnd file : BLADED FF data (binary) [WrBLFF] - INTEGER(IntKi), PARAMETER :: FileExt_HH = 3 ! .hh file : AeroDyn HH data (formatted) [WrADHH] - INTEGER(IntKi), PARAMETER :: FileExt_BIN = 4 ! .bin file : binary HH turbulence parameters [WrBHHTP] - INTEGER(IntKi), PARAMETER :: FileExt_DAT = 5 ! .dat file : formatted HH turbulence parameters [WrFHHTP] - INTEGER(IntKi), PARAMETER :: FileExt_UVW = 6 ! .u, .v, .w files : formatted FF data (Traditional SNLWIND-3D format) [WrFMTFF] - INTEGER(IntKi), PARAMETER :: FileExt_CTS = 7 ! .cts file : coherent turbulence - INTEGER(IntKi), PARAMETER :: FileExt_TWR = 8 ! .twr file : AeroDyn tower data (binary) - INTEGER(IntKi), PARAMETER :: NumFileFmt = 8 ! TOTAL number of output file formats (used to dimension array) - - ! other parameters: - REAL(ReKi), PARAMETER :: ZJetMax_UB = 490.0_ReKi ! upper bound on height where jet maximum occurs - REAL(ReKi), PARAMETER :: ZJetMax_LB = 70.0_ReKi ! lower bound on height where jet maximum occurs - REAL(ReKi), PARAMETER :: profileZmax = 140. ! Upper height limit for extrapolating GP_LLJ profiles of ustar and zl - REAL(ReKi), PARAMETER :: profileZmin = 50. ! Lower height limit for extrapolating GP_LLJ profiles of ustar and zl - REAL(ReKi), PARAMETER :: Omega = 7.292116E-05 ! Angular speed of rotation of the earth (rad/s) - REAL(ReKi), PARAMETER :: Tolerance = 0.0001 ! The largest difference between two numbers that are assumed to be equal - - CHARACTER(1), PARAMETER :: Comp (3) = (/ 'u', 'v', 'w' /) ! The names of the wind components - - - type :: RandNum_ParameterType - - integer(IntKi) :: pRNG - INTEGER(IntKi) :: RandSeed (3) ! The array that holds the initial random seeds for the 3 components. - INTEGER(IntKi), ALLOCATABLE :: RandSeedAry(:) ! The array that holds the random seeds. - CHARACTER( 6) :: RNG_type ! Type of Random Number Generator to use - - end type RandNum_ParameterType - - type :: RandNum_OtherStateType - INTEGER(IntKi), ALLOCATABLE :: NextSeed (:) ! The array that holds the next random seed for the 3 components. - end type RandNum_OtherStateType - - - TYPE :: CohStr_ParameterType - - REAL(ReKi) :: CTLy ! Fractional location of tower centerline from right (looking downwind) to left side of the dataset. - REAL(ReKi) :: CTLz ! Fractional location of hub height from the bottom of the dataset. - REAL(ReKi) :: CTStartTime ! Minimum time to add coherent structures - REAL(ReKi) :: DistScl ! Disturbance scale for AeroDyn coherent turbulence events - - - CHARACTER(200) :: CTEventPath ! String used to store the name of the coherent event definition file - CHARACTER(200) :: CTEventFile ! String used to store the name of the coherent event definition file - CHARACTER( 3) :: CTExt ! String used to determine the type of coherent structures ("dns" or "les") - - END TYPE CohStr_ParameterType - - - - type :: Grid_ParameterType - - REAL(ReKi) :: GridHeight ! Grid height - REAL(ReKi) :: GridRes_Z ! Distance between two consecutive vertical points on the grid (Vertical resolution) - INTEGER(IntKi) :: NumGrid_Z ! Grid dimension. (in vertical direction) - - REAL(ReKi) :: GridWidth ! Grid width. - REAL(ReKi) :: GridRes_Y ! Distance between two consecutive horizontal points on the grid (Horizontal resolution) - INTEGER(IntKi) :: NumGrid_Y ! Grid dimension. (in horizontal direction) - - INTEGER(IntKi) :: NPoints ! Number of points being simulated. - INTEGER(IntKi) :: NPacked ! Number of entries stored in the packed version of the symmetric matrix of size NPoints by NPoints - - REAL(ReKi) :: Zbottom ! The height of the lowest point on the grid (before tower points are added), equal to Z(1) - REAL(ReKi) :: RotorDiameter ! The assumed diameter of the rotor - - INTEGER(IntKi) :: HubIndx ! Index that tells where the hub point is in the V matrix - - REAL(ReKi) :: HubHt ! Hub height. - LOGICAL :: HubOnGrid ! Flag to indicate if the hub is on the regular grid (true) or if an extra point must be added (false) - LOGICAL :: ExtraTwrPT ! Flag to indicate if the tower is on the regular grid or if an extra point must be added - - - REAL(ReKi), ALLOCATABLE :: Y (:) ! The lateral locations of the points (NPoints). - REAL(ReKi), ALLOCATABLE :: Z (:) ! The vertical locations of the points (NPoints). - - INTEGER(IntKi),ALLOCATABLE :: GridPtIndx (:) ! size is (NumGrid_Y * NumGrid_Z): The indices into the velocity array, indicating the points in the cartesian grid for output. Previously was assumed to be the first NumGrid_Y * NumGrid_Z points; now necessary because user-defined time series data may specifiy points on the grid. - INTEGER(IntKi),ALLOCATABLE :: TwrPtIndx (:) ! size is number of tower points: The indices into the velocity array, indicating the points to be put in the tower file for output. Previously was assumed to be the last NumTower points; now necessary because user-defined time series data may specifiy points on the tower. - - - REAL(ReKi) :: AnalysisTime ! Analysis Time. (amount of time for analysis, allows user to perform analysis using one time length, but output UsableTime - REAL(ReKi) :: UsableTime ! Usable time. Program adds GridWidth/MeanHHWS if not specified as "ALL" AnalysisTime in input file. - REAL(ReKi) :: TimeStep ! Time step. - REAL(ReKi), ALLOCATABLE :: Freq (:) ! The array of frequencies (NumFreq). - INTEGER(IntKi) :: NumFreq ! Number of frequencies (=NumSteps/2). - INTEGER(IntKi) :: NumSteps ! Number of time steps for the FFT. - INTEGER(IntKi) :: NumOutSteps ! Number of output time steps. - - LOGICAL :: Periodic ! Flag to indicate that output files must contain exactly one full (time) period - LOGICAL :: Clockwise ! Flag to indicate clockwise rotation when looking downwind. - - end type Grid_ParameterType - - - type IEC_ParameterType - INTEGER(IntKi) :: IECedition ! The edition number of the IEC 61400-1 standard that is being used (determines the scaling) - INTEGER(IntKi) :: IECstandard ! The standard number (x) of the IEC 61400-x that is being used - INTEGER(IntKi) :: IEC_WindType ! Number to indicate the IEC wind type - INTEGER(IntKi) :: ScaleIEC ! Switch to indicate if turbulence should be scaled to target value; 0 = NO scaling; 1 = scale based on hub; 2 = scale each point individually - - REAL(ReKi) :: Lambda (3) ! IEC turbulence scale parameter: defined as wavelength where the non-dimensional power spectral density fS(f)/sigma^2 == 0.05 [m] - REAL(ReKi) :: SigmaIEC (3) ! IEC target standard deviation. - REAL(ReKi) :: IntegralScale (3) ! IEC integral scales (s) - REAL(ReKi) :: LC ! IEC coherency scale parameter - REAL(ReKi) :: SigmaSlope ! Slope used with IEC models to determine target sigma and turbulent intensity - REAL(ReKi) :: TurbInt ! IEC target Turbulence Intensity - REAL(ReKi) :: TurbInt15 ! Turbulence Intensity at hub height with a mean wind speed of 15 m/s - REAL(ReKi) :: ETMc ! The c parameter in IEC ETM, 61400-1, Ed 3. Section 6.3.2.3, Eq. 19. Variable per last sentence in section 7.4.1 - REAL(ReKi) :: Vave ! The IEC Vave for ETM - REAL(ReKi) :: Vref ! The IEC Vref for ETM - REAL(ReKi) :: PerTurbInt ! Percent Turbulence Intensity - - LOGICAL :: NumTurbInp ! Flag to indicate if turbulence is user-specified (as opposed to IEC standard A, B, or C) - - CHARACTER( 1) :: IECTurbC ! IEC turbulence characteristic - CHARACTER( 1) :: IECTurbE ! IEC Extreme turbulence class - CHARACTER( 35) :: IEC_WindDesc ! The description of the IEC wind type - CHARACTER( 25) :: IECeditionStr ! description of the IEC standard being used - end type IEC_ParameterType - - - type Meteorology_ParameterType - - INTEGER(IntKi) :: TurbModel_ID ! Integer value of spectral model (see SpecModel enum) - LOGICAL :: KHtest ! Flag to indicate that turbulence should be extreme, to demonstrate effect of KH billows - CHARACTER( 3) :: WindProfileType ! The wind profile type - CHARACTER( 6) :: TurbModel ! Turbulence model - CHARACTER( 50) :: TMName ! Turbulence model name. - - REAL(ReKi) :: Fc ! Coriolis parameter in units (1/sec) - !REAL(ReKi) :: h ! Boundary layer depth - REAL(ReKi) :: RICH_NO ! Gradient Richardson number - REAL(ReKi) :: Z0 ! Surface roughness length, meters - REAL(ReKi) :: ZI ! Mixing layer depth - REAL(ReKi) :: Latitude ! The site latitude in radians - REAL(ReKi) :: L ! M-O length - REAL(ReKi) :: ZL ! A measure of stability - REAL(ReKi) :: PLExp ! Rotor disk power law exponent - REAL(ReKi) :: Ustar ! Shear or friction velocity (m/s) -- rotor-disk average - REAL(ReKi) :: UstarDiab ! The diabatic ustar value - REAL(ReKi) :: UstarOffset ! A scaling/offset value used with the Ustar_profile to ensure that the mean hub u'w' and ustar inputs agree with the profile values - REAL(ReKi) :: UstarSlope ! A scaling/slope value used with the Ustar_profile to ensure that the mean hub u'w' and ustar inputs agree with the profile values - REAL(ReKi) :: ZLoffset ! An offset to align the zl profile with the mean zl input parameter - - REAL(ReKi) :: RefHt ! Height for reference wind speed. - REAL(ReKi) :: URef ! The input wind speed at the reference height. (Added by M. Buhl for API profiles) - - REAL(ReKi), ALLOCATABLE :: ZL_profile(:) ! A profile of z/l (measure of stability with height) - REAL(ReKi), ALLOCATABLE :: Ustar_profile(:) ! A profile of ustar (measure of friction velocity with height) - !REAL(ReKi) :: TurbIntH20 ! Turbulence intensity used for HYDRO module. - - - REAL(ReKi) :: HH_HFlowAng ! Horizontal flow angle at the hub (may be different than HFlowAng if using direction profile). - REAL(ReKi) :: HH_VFlowAng ! Vertical flow angle at the hub (may be different than VFlowAng if using vertical angle profile (i.e., user-defined time-series)). - REAL(ReKi) :: HFlowAng ! Horizontal flow angle - REAL(ReKi) :: VFlowAng ! Vertical flow angle - - - ! coefficients for velocity and direction profiles (currently used with jet profiles only) - REAL(ReKi) :: ChebyCoef_WS(11) ! The Chebyshev coefficients for wind speed - REAL(ReKi) :: ChebyCoef_WD(11) ! The Chebyshev coefficients for wind direction - - - REAL(ReKi) :: ZJetMax ! The height of the jet maximum (m) - REAL(ReKi) :: UJetMax ! The (horizontal) wind speed at the height of the jet maximum (m/s) - - - ! Coherence - REAL(ReKi) :: COHEXP ! Coherence exponent for general spatial coherence model - REAL(ReKi) :: InCDec (3) ! Contains the coherence decrements for general spatial coherence model - REAL(ReKi) :: InCohB (3) ! Contains the coherence b/L (offset) parameters for general spatial coherence model - - INTEGER(IntKi) :: SCMod (3) ! SCMod_u, SCMod_v, and SCMod_w: switches determining which coherence model to use - - LOGICAL :: IsIECModel ! Flag to determine if we're using IEC scaling (coherence, etc) - - - ! Scaling - REAL(ReKi) :: PC_UW ! u'w' cross-correlation coefficient - REAL(ReKi) :: PC_UV ! u'v' cross-correlation coefficient - REAL(ReKi) :: PC_VW ! v'w' cross-correlation coefficient - - LOGICAL :: UVskip ! Flag to determine if UV cross-feed term should be skipped or used - LOGICAL :: UWskip ! Flag to determine if UW cross-feed term should be skipped or used - LOGICAL :: VWskip ! Flag to determine if VW cross-feed term should be skipped or used - - - ! user-defined profiles (also used with UsrVKM model): - INTEGER(IntKi) :: NumUSRz ! Number of heights defined in the user-defined profiles. - REAL(ReKi), ALLOCATABLE :: USR_Z (:) ! Heights of user-specified variables - REAL(ReKi), ALLOCATABLE :: USR_U (:) ! User-specified total wind speed, varying with height - REAL(ReKi), ALLOCATABLE :: USR_WindDir (:) ! User-specified wind direction profile, varying with height - REAL(ReKi), ALLOCATABLE :: USR_Sigma (:) ! User-specified standard deviation of the wind speed components (isotropic), varying with height - REAL(ReKi), ALLOCATABLE :: USR_L (:) ! User-specified von Karman length scale, varying with height - REAL(ReKi) :: USR_StdScale (3) ! Scaling for the user-specified standard deviation - - end type Meteorology_ParameterType - - - TYPE UserTSSpec_ParameterType - - integer(intKi) :: nComp ! number of velocity components in the file (1=u; 2=u&v; 3=u,v,w) - integer(intKi) :: nFreq ! number of frequencies in the calculated spectra - real(dbKi) :: DelF ! delta frequenc of the calculated spectra (same as f(1) in double precision) - integer(intKi) :: nPoints ! number of points in the time series input - integer(intKi) :: RefPtID ! Index of the reference point (1-nPoints) - integer(intKi) :: nTimes ! number of rows in the time series input - real(reki), allocatable :: pointyi (:) ! y position where each time series was input; size: nPoints - real(reki), allocatable :: pointzi (:) ! z position (height) where each time series was input; size: nPoints - real(reki), allocatable :: t(:) - real(reki), allocatable :: v(:,:,:) ! velocity time series; size: nTimes, nPoints, { 2 if .not. containsW | 3 otherwise } - - real(reKi), allocatable :: meanU(:,:) ! mean velocity; size: nPoints, nComp [m/s] - real(reKi), allocatable :: meanDir(:) ! mean horizontal direction; size: nPoints [degrees] - real(reKi), allocatable :: meanVAng(:) ! mean vertical angle; size: nPoints [degrees] - real(reKi), allocatable :: S(:,:,:) ! spectra; size: nFreq, nPoints, nComp - real(reKi), allocatable :: f(:) ! frequency; size: nFreq [Hz] - real(reKi), allocatable :: phaseAngles(:,:,:) - - INTEGER(IntKi) :: TurbModel_ID = SpecModel_NONE ! Integer value of spectral model (see SpecModel enum) for filling in high-frequency content; not all SpecModel values are valid here - - END TYPE UserTSSpec_ParameterType - - - type TurbSim_ParameterType - LOGICAL :: WrFile(NumFileFmt) ! Flag to determine which output files should be generated - INTEGER :: US = -1 ! I/O unit for summary file. - - - CHARACTER(200) :: DescStr ! String used to describe the run (and the first line of the summary file) - CHARACTER(197) :: RootName ! Root name of the I/O files. - TYPE(RandNum_ParameterType) :: RNG ! parameters for random numbers p_RandNum - TYPE(Grid_ParameterType) :: grid ! parameters for TurbSim (specify grid/frequency size) - TYPE(Meteorology_ParameterType) :: met ! parameters for TurbSim - TYPE(IEC_ParameterType) :: IEC ! parameters for IEC models - TYPE(UserTSSpec_ParameterType) :: usr ! parameters for user spectra or time-series input - TYPE(CohStr_ParameterType) :: CohStr ! parameters for coherent structures - - !bjj: there probably won't be a need for this later... - REAL(ReKi) :: UHub ! Hub-height (total) wind speed (m/s) - - - end type - - - - - -END MODULE TurbSim_Types -!================================================================================================================================== diff --git a/OpenFAST/modules/turbsim/src/VelocitySpectra.f90 b/OpenFAST/modules/turbsim/src/VelocitySpectra.f90 deleted file mode 100644 index c122a5c68..000000000 --- a/OpenFAST/modules/turbsim/src/VelocitySpectra.f90 +++ /dev/null @@ -1,2158 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2014, 2016 National Renewable Energy Laboratory -! -! This file is part of TurbSim. -! -! 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. -! -!********************************************************************************************************************************** -MODULE TS_VelocitySpectra - - USE TurbSim_Types - - IMPLICIT NONE - -CONTAINS - - -!======================================================================= -!> This subroutine defines the Kaimal PSD model as specified by IEC 61400-1, 2nd Ed. & 3rd Ed. -!! the use of this subroutine requires that all variables have the units of meters and seconds. -SUBROUTINE Spec_IECKAI ( UHub, SigmaIEC, L_K, Freq, NumFreq, Spec ) - - - IMPLICIT NONE - - ! Passed variables - INTEGER(IntKi), INTENT(IN ) :: NumFreq !< Input: Number of frequencies - REAL(ReKi), INTENT(IN ) :: SigmaIEC (3) !< Input: sigma for 3 wind components specified by the IEC - REAL(ReKi), INTENT(IN ) :: L_k (3) !< Input: L_k (integral scale parameter) for 3 wind components specified by the IEC - REAL(ReKi), INTENT(IN ) :: UHub !< Input: mean wind speed at hub height - REAL(ReKi), INTENT(IN ) :: Freq (NumFreq) !< Input: frequency array - REAL(ReKi), INTENT(INOUT) :: Spec (NumFreq,3) !< Output: target spectrum - - ! Internal variables - - REAL(ReKi),PARAMETER :: Exp1 = 5.0/3.0 - - REAL(ReKi) :: L_over_U (3) - REAL(ReKi) :: SigmaLU (3) - - INTEGER :: I - INTEGER :: IVec - - - - ! Create the spectrum. -L_over_U = L_k / UHub -SigmaLU = 4.0 * SigmaIEC**2 * L_over_U ! array operations - -DO IVec = 1,3 - - L_over_U(IVec) = 6.0*L_over_U(IVec) - - DO I = 1,NumFreq - Spec(I,IVec) = SigmaLU(IVec) / ( 1.0 + L_over_U(IVec)*Freq(I) )**Exp1 - ENDDO !I - -ENDDO !IVec - - -RETURN -END SUBROUTINE Spec_IECKAI -!======================================================================= -!> This subroutine defines the von Karman PSD model as specified by IEC 61400-1 (2nd Ed). -!! The use of this subroutine requires that all variables have the units of meters and seconds. -SUBROUTINE Spec_IECVKM ( UHub, SigmaIEC_u, IntegralScale, Freq, NumFreq, Spec ) - - IMPLICIT NONE - - ! Passed variables - - INTEGER(IntKi), INTENT(IN ) :: NumFreq !< Input: Number of frequencies - REAL(ReKi), INTENT(IN ) :: SigmaIEC_u !< Input: target standard deviation for u component - REAL(ReKi), INTENT(IN ) :: IntegralScale (3) !< Input: integral scale parameter, L (isotropic, so we only care about the 1st one) - REAL(ReKi), INTENT(IN ) :: UHub !< Input: mean wind speed at hub height - REAL(ReKi), INTENT(IN ) :: Freq (NumFreq) !< Input: frequency array - REAL(ReKi), INTENT( OUT) :: Spec (NumFreq,3) !< Output: target spectrum - - - ! Internal variables - - REAL(ReKi),PARAMETER :: Exp1 = 5.0/6.0 - REAL(ReKi),PARAMETER :: Exp2 = 11.0/6.0 - REAL(ReKi) :: FLU2 - REAL(ReKi) :: L1_U - REAL(ReKi) :: SigmaL1_U - REAL(ReKi) :: Tmp - - INTEGER :: I - - - ! Set up scaling values. - - - ! Define u-component integral scale. - -L1_U = IntegralScale(1)/UHub -SigmaL1_U = 2.0*SigmaIEC_u*SigmaIEC_u*L1_U - -DO I=1,NumFreq - - FLU2 = ( Freq(I)*L1_U )**2 - Tmp = 1.0 + 71.0*FLU2 - - Spec(I,1) = 2.0*SigmaL1_U/Tmp**Exp1 - Spec(I,2) = SigmaL1_U*( 1.0 + 189.0*FLU2 )/Tmp**Exp2 - Spec(I,3) = Spec(I,2) - -ENDDO ! I - -RETURN -END SUBROUTINE Spec_IECVKM -!======================================================================= -!> This subroutine defines the API-BULLET-IN recommended extreme wind spectrum -!! The use of this subroutine requires that all variables have the units of meters and seconds. -!! See A.7.4 (Page 41) of API 2MET/ISO 19901-1:2005(E). -!! See https://rules.dnvgl.com/docs/pdf/DNV/codes/docs/2010-10/RP-C205.pdf (page 20 of 124), describing the -!! Froya model spectral density proposed by Andersen and Lovseth (1992, 2006) for wind over water. -SUBROUTINE Spec_API ( p, Ht, Spec ) - - ! NOTE: This routine uses the Kaimal model to create the spectrum for all three components - ! and then overwrites the u-component spectrum with the API model. - - -IMPLICIT NONE - - ! Passed variables - TYPE(TurbSim_ParameterType) , INTENT(IN ) :: p !< Input: turbsim parameters - REAL(ReKi), INTENT(IN) :: Ht !< Input: Height (Should be HubHt), value ignored !bjj: is this true???? - REAL(ReKi), INTENT(INOUT) :: Spec (:,:) !< Output: target spectrum - -!REAL(ReKi),INTENT(IN) :: URef ! Added by YG -!REAL(ReKi),INTENT(IN) :: RefHt ! Reference height - - ! Internal variables - -REAL(ReKi),PARAMETER :: N = 0.468 -REAL(ReKi),PARAMETER :: Exp5 = 5.0/( 3.0*N ) -!mlb REAL(ReKi),PARAMETER :: Exp5 = 11.0/6.0 -REAL(ReKi),PARAMETER :: Ref_Ht = 10.0 -REAL(ReKi),PARAMETER :: Ref_WS = 10.0 -REAL(ReKi) :: Scale1 -REAL(ReKi) :: Scale2 -REAL(ReKi) :: Temp -!mlb REAL(ReKi) :: FLU2 -!mlb REAL(ReKi) :: L1_U -!mlb REAL :: X0=10.0 ! Added by Y. Guo for calculating UHr_10 -!mlb REAL :: X -INTEGER :: I -!mlb REAL :: UHr_10 - - ! Set up scaling values. - - ! calculate the spectra for the v and w components using IECKAI model - ! because API doesn't specify a spectra for those components -CALL Spec_IECKAI ( p%UHub, p%IEC%SigmaIEC, p%IEC%IntegralScale, p%grid%Freq, p%grid%NumFreq, Spec ) - - ! Define u-component integral scale. -!CALL WrScr ('Calling Froya/API wind spectrum.............') -!mlb L1_U = 3.5*Lambda/p%UHub -!mlb SigmaL1_U = 2.0*SigmaIEC(1)*p%UHub*L1_U - -!mlb CALL ROOT_SEARCHING(X0,X,p%UHub,Ht,Ht) -!mlb UHr_10=X; - - ! Compute some parameters that are independent of frequency. - -Scale1 = 172.0*( Ht/Ref_Ht )**(2.0/3.0) * ( p%met%URef/Ref_WS )**(-0.75) -Scale2 = 320.0*( p%met%URef/Ref_WS )**2 * ( Ht/Ref_Ht )**0.45 - -DO I=1,p%grid%NumFreq - - -!mlb Tmp1 = 172.0*p%grid%Freq(I)*(Ht/10.0)**Exp2*(UHr_10/10.0)**Exp3 -!mlb Tmp2 = (1.0+Tmp1**Exp1)**(5.0/3.0/Exp1) -!mlb -!mlb Spec(I,1) = 320.0*(UHr_10/10.0)**2*(Ht/10.0)**Exp4/Tmp2 - - Temp = Scale1*p%grid%Freq(I) - Spec(I,1) = Scale2/( 1.0 + Temp**N )**Exp5 - -ENDDO ! I - -!CALL WrScr ('Froya/API wind spectrum generated') - -RETURN -END SUBROUTINE Spec_API -!======================================================================= -!> This subroutine defines the 3-D turbulence spectrum that can be expected over terrain -!! and heights similiar to the LLLJP project as developed by Neil Kelley & Bonnie Jonkman at NREL. -!! The use of this subroutine requires that variables have the units of meters and seconds. -SUBROUTINE Spec_GPLLJ ( p, Ht, Ucmp, ZL_tmp, UStar_tmp, Spec ) - -IMPLICIT NONE - - ! Passed variables - - TYPE(TurbSim_ParameterType) , INTENT(IN ) :: p !< Input: turbsim parameters - REAL(ReKi), INTENT(IN) :: Ht !< Height (local) - REAL(ReKi), INTENT(IN) :: Ucmp !< Longitudinal Velocity (local) - REAL(ReKi), INTENT(IN) :: Ustar_tmp !< Local ustar - REAL(ReKi), INTENT(IN) :: ZL_tmp !< Local z/l - REAL(ReKi), INTENT( OUT) :: Spec (:,:) !< Output: target spectrum - - - ! Internal variables - -REAL(ReKi), PARAMETER :: Exp53 = 5.0 / 3.0 -REAL(ReKi), PARAMETER :: Exp23 = 2.0 / 3.0 -REAL(ReKi), PARAMETER :: Exp32 = 3.0 / 2.0 -REAL(ReKi) :: fi ! Temporary variable for calculation of Spec -REAL(ReKi) :: fr ! Temporary variable for calculation of Spec -REAL(ReKi) :: Freq2 ! Temporary variable for the reduced frequency squared -REAL(ReKi) :: fr_ih(3) ! Scaling for high-frequency peak location -REAL(ReKi) :: fr_il(3) ! Scaling for low-frequency peak location -REAL(ReKi) :: HtZI ! Temporary variable for calculation of Spec -REAL(ReKi) :: HtZI2 ! Temporary variable for calculation of Spec -REAL(ReKi) :: phiE -REAL(ReKi) :: phiM ! Non-Dimensional Wind Shear -REAL(ReKi) :: Pr_ih(3) ! Scaling for magnitude of high-frequency peak -REAL(ReKi) :: Pr_il(3) ! Scaling for magnitude of low-frequency peak -REAL(ReKi) :: ps_h -REAL(ReKi) :: ps_l -REAL(ReKi), PARAMETER :: Scales(2,3) = RESHAPE( (/ 79.0, 13.0, 3.5, & - 263.0, 32.0, 8.6 /), & - SHAPE=(/2,3/), ORDER=(/2,1/) ) -REAL(ReKi) :: tmpF ! Temporary variable for calculation of Spec -REAL(ReKi) :: tmpFw ! Temporary variable for calculation of Spec -REAL(ReKi) :: tmpX ! Temporary variable for calculation of Spec -REAL(ReKi) :: tmpPhi ! Temporary variable for calculation of Spec -REAL(ReKi) :: tmpZIL ! Temporary variable for calculation of Spec -REAL(ReKi) :: tmpZIU ! Temporary variable for calculation of Spec -REAL(ReKi) :: tmpZU ! Temporary variable for calculation of Spec -REAL(ReKi) :: UDen -REAL(ReKi) :: Ustar_loc ! Local ustar -REAL(ReKi) :: uStar2 ! Temporary variable holding Ustar-squared -REAL(ReKi) :: Ustar2F -REAL(ReKi) :: VDen -REAL(ReKi) :: X_h -REAL(ReKi) :: X_l -REAL(ReKi) :: ZL_loc ! Local z/l - -INTEGER :: I ! DO LOOP counter -INTEGER :: IC ! DO LOOP counter - -uStar2 = Ustar_tmp * Ustar_tmp ! We don't use ustar_loc here b/c this ustar_loc was used to calculate non-dimensional spectral; this is to scale to dimensional values - -ustar_loc = MAX( MIN(ustar_tmp, REAL(1.0,ReKi) ), REAL( 0.15,ReKi) ) ! make sure ustar does not go beyond the observed range that the values were calcualted over -zl_loc = MAX( MIN(zl_tmp, REAL(1.0,ReKi) ), REAL(-1.00,ReKi) ) ! make sure z/l does not go beyond the calculated range - - -IF (zL_loc >= 0) THEN - - phiM = 1.0 + 4.7*(zL_loc) ! = q - phiE = (1.0 + 2.5*(zL_loc)**0.6)**Exp32 - - zl_loc = MAX( zl_loc, REAL(0.025,ReKi) ) !This will prevent 0**-x from becoming infinite. ustar_loc has this built in already. This value is the observed min here anyway. - - ! Calculate NEUTRAL/STABLE spectral estimates - - fr_il(1) = 0.014746*( zl_loc**(-0.37495232))*(ustar_loc**(-0.6167086) )*exp(-0.994591040*zl_loc+1.676298830*ustar_loc) - fr_ih(1) = 0.043108*( zl_loc**(-0.39311528))*(ustar_loc**(-2.1719048) )*exp( 0.152732100*zl_loc+2.939119120*ustar_loc) - Pr_il(1) = 0.003043*( zl_loc**(-0.60526081))*(ustar_loc**(-2.4348077) )*exp( 1.386013230*zl_loc+2.185372290*ustar_loc) - Pr_ih(1) = 15.468066*( zl_loc**( 0.27375765))*(ustar_loc**( 1.8091998) )*exp(-0.266223760*zl_loc-3.091731900*ustar_loc) - - fr_il(2) = 0.0008437*( zl_loc**(-0.79592929))*(ustar_loc**(-1.78297586))*exp( 1.316511335*zl_loc+0.175154746*ustar_loc) - fr_ih(2) = 1.5278523*( zl_loc**(-0.14197939))*(ustar_loc**( 0.02684469))*exp(-0.261902952*zl_loc-0.672772974*ustar_loc) - Pr_il(2) = 0.0222952*( zl_loc**( 0.18448738))*(ustar_loc**(-2.23473414))*exp(-1.216594402*zl_loc+1.491864128*ustar_loc) - Pr_ih(2) = 1.6568440*( zl_loc**(-0.03919916))*(ustar_loc**( 0.57537263))*exp(+0.282805584*zl_loc-1.199845489*ustar_loc) - - fr_il(3) = 1. - fr_ih(3) = 0.97627403*(zl_loc**(-0.05470045))*(ustar_loc**(0.09666427) )*exp(-0.301255210*zl_loc-0.063122900*ustar_loc) - Pr_il(3) = 0. - Pr_ih(3) = 0.69547455*(zl_loc**(-0.00800265))*(ustar_loc**(-0.1352012) )*exp( 0.041784840*zl_loc-0.003785870*ustar_loc) - - fr_il(1) = MAX( MIN( fr_il(1), REAL(0.30,ReKi) ), REAL(0.015,ReKi) ) - fr_ih(1) = MAX( MIN( fr_ih(1), REAL(2.5 ,ReKi) ), REAL(1.25 ,ReKi) ) - Pr_il(1) = MAX( MIN( Pr_il(1), REAL(0.75,ReKi) ), REAL(0.1 ,ReKi) ) - Pr_ih(1) = MAX( MIN( Pr_ih(1), REAL(0.75,ReKi) ), REAL(0.25 ,ReKi) ) - - fr_il(2) = MAX( MIN( fr_il(2), REAL(0.3 ,ReKi) ), REAL(0.005,ReKi) ) - fr_ih(2) = MAX( MIN( fr_ih(2), REAL(2.5 ,ReKi) ), REAL(0.75 ,ReKi) ) - Pr_il(2) = MAX( MIN( Pr_il(2), REAL(1.4 ,ReKi) ), REAL(0.05 ,ReKi) ) - Pr_ih(2) = MAX( MIN( Pr_ih(2), REAL(1.0 ,ReKi) ), REAL(0.5 ,ReKi) ) - - fr_ih(3) = MAX( MIN( fr_ih(3), REAL(1.4 ,ReKi) ), REAL(0.5 ,ReKi) ) - Pr_ih(3) = MAX( MIN( Pr_ih(3), REAL(1.1 ,ReKi) ), REAL(0.6 ,ReKi) ) - - tmpPhi = ( (phiE / phiM)**Exp23 ) - tmpF = Ht / (Ucmp * phiM) - - - DO IC = 1,3 ! Wind components - DO I = 1,p%grid%NumFreq - tmpX = p%grid%Freq(I)*tmpF ! reduced frequency divided by q (q = phiM here) - X_l = tmpX/fr_il(ic) - X_h = tmpX/fr_ih(ic) - - ps_l = (Pr_il(ic)*scales(1,ic)*X_l*tmpPhi) / (1.0 + scales(2,ic)*X_l**Exp53); - ps_h = (Pr_ih(ic)*scales(1,ic)*X_h*tmpPhi) / (1.0 + scales(2,ic)*X_h**Exp53); - - Spec(I,IC) = (ps_l + ps_h)*uStar2/p%grid%Freq(I) - ENDDO - ENDDO - - -ELSE - ! Calculate UNSTABLE spectral estimates - fr_il(:) = 1. - fr_ih(:) = 1. - Pr_il(:) = 1. - Pr_ih(:) = 1. - -! THESE VALUES ARE BASED ON A SMALL AMOUNT OF DATA AND DON'T SEEM TO BEHAVE VERY WELL FOR THE GENERAL CASE. -! Using 1 for each of these values creates the spectral estimates for the SMOOTH model. -! -! nzl = -zl_loc -! -! fr_il(1) = MIN(10.0, 0.0443117*( (nzl)**(-0.42429))*(ustar_loc**(- 2.03969))*exp( 7.18271*(nzl)+ 1.11017*ustar_loc)) -! fr_ih(1) = MIN( 5.0, 1.10957*( (nzl)**( 0.18200))*(ustar_loc**(- 0.13968))*exp( 2.48651*(nzl)+ 0.88788*ustar_loc)) -! Pr_il(1) = MIN(20.0, 1.08387e-004*((nzl)**( 0.32784))*(ustar_loc**(- 6.69897))*exp(-8.25590*(nzl)+14.46554*ustar_loc)) -! Pr_ih(1) = MIN( 5.0, 0.0870653*( (nzl)**(-0.55618))*(ustar_loc**(- 0.85499))*exp( 3.66686*(nzl)- 0.34810*ustar_loc)) -! -! fr_il(2) = MIN( 5.0, 2.8412e-013*( (nzl)**(-0.43587))*(ustar_loc**(-14.62097))*exp( 2.41002*(nzl)+31.59745*ustar_loc)) -! fr_ih(2) = MIN( 5.0, 0.12219003 *( (nzl)**(-0.20010))*(ustar_loc**(- 1.11780))*exp( 1.66314*(nzl)+ 1.74815*ustar_loc)) -! Pr_il(2) = MIN(10.0, 6.6853e-018*( (nzl)**(-1.48280))*(ustar_loc**(-18.80570))*exp( 9.92010*(nzl)+41.12724*ustar_loc)) -! Pr_ih(2) = MIN( 5.0, 2.47627547 *( (nzl)**( 0.04305))*(ustar_loc**(- 0.01287))*exp(-2.74234*(nzl)- 0.95780*ustar_loc)) -! -! fr_il(3) = MIN(30.0, 2.66408e-004*((nzl)**(-0.65260))*(ustar_loc**(- 4.82119))*exp( 7.08116*(nzl)+ 5.85913*ustar_loc)) -! fr_ih(3) = MIN( 5.0, 0.0118916* ( (nzl)**( 0.09544))*(ustar_loc**(- 2.82943))*exp(-3.21429*(nzl)+ 5.95403*ustar_loc)) -! Pr_il(3) = MIN(10.0, 3.6709e-011*( (nzl)**(-0.96751))*(ustar_loc**(-11.48936))*exp( 5.06644*(nzl)+26.26320*ustar_loc)) -! Pr_ih(3) = MIN( 5.0, 13.53430* ( (nzl)**(-0.14450))*(ustar_loc**( 1.32560))*exp( 1.66323*(nzl)- 4.28085*ustar_loc)) - - tmpZIL = ( ABS(p%met%ZI / p%met%L) )**Exp23 - HtZI = Ht / p%met%ZI - - tmpZIU = p%met%ZI / Ucmp - tmpZU = Ht / Ucmp - HtZI2 = (1.0 - HtZI)**2 - UDen = 1.0 + 15.0*HtZI - VDen = 1.0 + 2.8*HtZI - - DO I=1,p%grid%NumFreq - fi = p%grid%Freq(I)*tmpZIU - tmpF = p%grid%Freq(I)*tmpZU ! reduced frequency - Ustar2F = uStar2/p%grid%Freq(I) ! Normalizing term - - ! u component - - fr = tmpF/UDen - X_l = fi/fr_il(1) - X_h = fr/fr_ih(1) - - ps_l = (Pr_il(1)* tmpZIL * 0.50*X_l)/( 1.0 + 2.2*X_l**Exp53 ) - ps_h = (Pr_ih(1)*(HtZI2/(UDen**Exp23))*105.00*X_h)/((1.0 + 33.0*X_h)**Exp53) - - Spec(I,1) = (ps_l + ps_h) * Ustar2F - - - ! v component - - fr = tmpF/VDen - X_l = fi/fr_il(2) - X_h = fr/fr_ih(2) - - ps_l = (Pr_il(2)* tmpZIL * 0.95*X_l)/((1.0 + 2.0*X_l)**Exp53) - ps_h = (Pr_ih(2)*(HtZI2/(VDen**Exp23))* 17.00*X_h)/((1.0 + 9.5*X_h)**Exp53) - - Spec(I,2) = (ps_l + ps_h) * Ustar2F - - - ! w component - - Freq2 = tmpF**2 - tmpFw = SQRT( (Freq2 + (0.3*HtZI)**2 ) / (Freq2 + 0.15**2) ) - X_l = fi /fr_il(3) - X_h = tmpF/fr_ih(3) - - ps_l = tmpFw*(Pr_il(3)*tmpZIL*0.95*X_l)/((1.0 + 2.0*X_l)**Exp53) - ps_h = (Pr_ih(3)*HtZI2 *2.00*X_h)/( 1.0 + 5.3*X_h**Exp53 ) - - Spec(I,3) = (ps_l + ps_h) * Ustar2F - - ENDDO -ENDIF - - -RETURN -END SUBROUTINE Spec_GPLLJ -!======================================================================= -!> This subroutine defines the 3-D turbulence spectrum that can be expected -!! over terrain and heights similiar to the NWTC LIST project as developed -!! by Neil Kelley & Bonnie Jonkman at NREL. The use of this subroutine -!! requires that variables have the units of meters and seconds. -SUBROUTINE Spec_NWTCUP ( p, Ht, Ucmp, Spec ) - - -IMPLICIT NONE - - ! Passed variables - - TYPE(TurbSim_ParameterType) , INTENT(IN ) :: p !< Input: turbsim parameters - REAL(ReKi), INTENT(IN ) :: Ht !< Height (local) - REAL(ReKi), INTENT(IN ) :: Ucmp !< Longitudinal Velocity (local) - REAL(ReKi), INTENT( OUT) :: Spec (:,:) !< Output: target spectrum - - - - ! Internal variables - -REAL(ReKi), PARAMETER :: Exp53 = 5.0 / 3.0 -REAL(ReKi), PARAMETER :: Exp23 = 2.0 / 3.0 -REAL(ReKi), PARAMETER :: Exp32 = 3.0 / 2.0 -REAL(ReKi) :: fi ! Temporary variable for calculation of Spec -REAL(ReKi) :: fr ! Temporary variable for calculation of Spec -REAL(ReKi) :: Freq2 ! Temporary variable for the reduced frequency squared -REAL(ReKi) :: fr_ih(3) ! Scaling for high-frequency peak location -REAL(ReKi) :: fr_il(3) ! Scaling for low-frequency peak location -REAL(ReKi) :: HtZI ! Temporary variable for calculation of Spec -REAL(ReKi) :: HtZI2 ! Temporary variable for calculation of Spec -REAL(ReKi) :: phiE -REAL(ReKi) :: phiM ! Non-Dimensional Wind Shear -REAL(ReKi) :: Pr_ih(3) ! Scaling for magnitude of high-frequency peak -REAL(ReKi) :: Pr_il(3) ! Scaling for magnitude of low-frequency peak -REAL(ReKi) :: ps_h -REAL(ReKi) :: ps_l -REAL(ReKi), PARAMETER :: Scales(2,3) = RESHAPE( (/ 79.0, 13.0, 3.5, & - 263.0, 32.0, 8.6 /), & - SHAPE=(/2,3/), ORDER=(/2,1/) ) -REAL(ReKi) :: tmpF ! Temporary variable for calculation of Spec -REAL(ReKi) :: tmpFw ! Temporary variable for calculation of Spec -REAL(ReKi) :: tmpX ! Temporary variable for calculation of Spec -REAL(ReKi) :: tmpPhi ! Temporary variable for calculation of Spec -REAL(ReKi) :: tmpZIL ! Temporary variable for calculation of Spec -REAL(ReKi) :: tmpZIU ! Temporary variable for calculation of Spec -REAL(ReKi) :: tmpZU ! Temporary variable for calculation of Spec -REAL(ReKi) :: UDen -REAL(ReKi) :: Ustar_tmp ! Disk-averaged ustar, limited by the observed range of values for fitting these emperical functions -REAL(ReKi) :: uStar2 ! Temporary variable holding Ustar-squared -REAL(ReKi) :: Ustar2F -REAL(ReKi) :: VDen -REAL(ReKi) :: X_h -REAL(ReKi) :: X_l -REAL(ReKi) :: ZL_tmp ! Disk-averaged z/l, limited by the observed range of z/l for fitting these emperical functions - -INTEGER :: I ! DO LOOP counter -INTEGER :: IC ! DO LOOP counter - -uStar2 = p%met%Ustar * p%met%Ustar - -IF (p%met%zL >= 0) THEN - - zl_tmp = max( min(p%met%zl, 3.5_ReKi ), 0.005_ReKi ) - - ! Calculate NEUTRAL/STABLE spectral estimates - - fr_il(1) = 0.096376774*(zl_tmp**(-0.315715361)) * exp(-0.385026736*zl_tmp) - fr_ih(1) = 1.690996304*(zl_tmp**(-0.340366943)) * exp(-0.132661086*zl_tmp) - Pr_il(1) = 1.209487882*(zl_tmp**( 0.052273494)) * exp( 0.189014328*zl_tmp) - Pr_ih(1) = 0.224103219*(zl_tmp**( 0.169561956)) * exp( 0.222723480*zl_tmp) - - fr_il(2) = 0.032285308*(zl_tmp**(-0.387804427)) * exp(-0.388660410*zl_tmp) - fr_ih(2) = 0.473438689*(zl_tmp**(-0.441450751)) * exp( 0.290697895*zl_tmp) - Pr_il(2) = 1.285421087*(zl_tmp**( 0.006644801)) * exp( 0.354496483*zl_tmp) - Pr_ih(2) = 0.991251080*(zl_tmp**( 0.343831230)) * exp(-0.605373943*zl_tmp) - - fr_il(3) = 0.097156827*(zl_tmp**(-0.096412942)) * exp(-0.616256651*zl_tmp) - fr_ih(3) = 0.469904415*(zl_tmp**(-0.218253779)) * exp(-0.157526974*zl_tmp) - Pr_il(3) = 0.368138932*(zl_tmp**( 0.093776256)) * exp( 0.109020969*zl_tmp) - Pr_ih(3) = 0.638868926*(zl_tmp**( 0.035396647)) * exp(-0.031884105*zl_tmp) - - fr_il(1) = MAX( MIN( fr_il(1),REAL( 0.40,ReKi) ), REAL(0.015,ReKi) ) - fr_ih(1) = MAX( MIN( fr_ih(1),REAL(10.0 ,ReKi) ), REAL(0.35 ,ReKi) ) - Pr_il(1) = MAX( MIN( Pr_il(1),REAL( 2.25,ReKi) ), REAL(0.8 ,ReKi) ) - Pr_ih(1) = MAX( MIN( Pr_ih(1),REAL( 0.8 ,ReKi) ), REAL(0.05 ,ReKi) ) - - fr_il(2) = MAX( MIN( fr_il(2),REAL( 0.23,ReKi) ), REAL(0.003,ReKi) ) - fr_ih(2) = MAX( MIN( fr_ih(2),REAL( 3.0 ,ReKi) ), REAL(0.25 ,ReKi) ) - Pr_il(2) = MAX( MIN( Pr_il(2),REAL( 2.25,ReKi) ), REAL(0.95 ,ReKi) ) - Pr_ih(2) = MAX( MIN( Pr_ih(2),REAL( 1.0 ,ReKi) ), REAL(0.2 ,ReKi) ) - - fr_il(3) = MAX( MIN( fr_il(3),REAL( 0.175,ReKi)), REAL(0.006,ReKi) ) - fr_ih(3) = MAX( MIN( fr_ih(3),REAL( 1.25 ,ReKi)), REAL(0.2 ,ReKi) ) - Pr_il(3) = MAX( MIN( Pr_il(3),REAL( 0.75 ,ReKi)), REAL(0.2 ,ReKi) ) - Pr_ih(3) = MAX( MIN( Pr_ih(3),REAL( 1.0 ,ReKi)), REAL(0.25 ,ReKi) ) - - phiM = 1.0 + 4.7*(zl_tmp) ! = q - phiE = (1.0 + 2.5*(zl_tmp)**0.6)**Exp32 - - tmpPhi = ( (phiE / phiM)**Exp23 ) - tmpF = Ht / (Ucmp * phiM) - - - DO IC = 1,3 ! Wind components - DO I = 1,p%grid%NumFreq - tmpX = p%grid%Freq(I)*tmpF ! reduced frequency divided by q (q = phiM here) - X_l = tmpX/fr_il(ic) - X_h = tmpX/fr_ih(ic) - - ps_l = (Pr_il(ic)*scales(1,ic)*X_l*tmpPhi) / (1.0 + scales(2,ic)*X_l**Exp53); - ps_h = (Pr_ih(ic)*scales(1,ic)*X_h*tmpPhi) / (1.0 + scales(2,ic)*X_h**Exp53); - - Spec(I,IC) = (ps_l + ps_h)*uStar2/p%grid%Freq(I) - ENDDO - ENDDO - - -ELSE - ! Calculate UNSTABLE spectral estimates - - zl_tmp = abs( min( max( p%met%zl ,REAL(-0.5,ReKi) ),REAL( -0.025,ReKi) ) ) - ustar_tmp = max( min(p%met%ustar,REAL( 1.4,ReKi) ),REAL( 0.2 ,ReKi) ) - - fr_il(1) = 0.08825035*(zl_tmp**(-0.08806865))*(ustar_tmp**(-0.26295052))*exp( 1.74135233*zl_tmp + 1.86785832*ustar_tmp) - fr_ih(1) = 1.34307411*(zl_tmp**(-0.55126969))*(ustar_tmp**(-0.07034031))*exp( 0.40185202*zl_tmp - 0.55083463*ustar_tmp) - Pr_il(1) = 57.51578485*(zl_tmp**(-1.89080610))*(ustar_tmp**( 4.03260796))*exp( 6.09158000*zl_tmp - 7.47414385*ustar_tmp) - Pr_ih(1) = 4.52702491*(zl_tmp**( 0.72447070))*(ustar_tmp**(-0.10602646))*exp(-3.73265876*zl_tmp - 0.49429015*ustar_tmp) - - fr_il(2) = 0.58374913*(zl_tmp**(-0.53220033))*(ustar_tmp**( 1.49509302))*exp( 3.61867635*zl_tmp - 0.98540722*ustar_tmp) - fr_ih(2) = 4.30596626*(zl_tmp**( 0.31302745))*(ustar_tmp**(-0.26457011))*exp(-1.41513284*zl_tmp + 0.91503248*ustar_tmp) - Pr_il(2) = 32.06436225*(zl_tmp**(-1.43676866))*(ustar_tmp**( 3.57797045))*exp( 5.31617813*zl_tmp - 5.76800891*ustar_tmp) - Pr_ih(2) = 3.93109762*(zl_tmp**( 0.57974534))*(ustar_tmp**(-0.20510478))*exp(-4.85367443*zl_tmp - 0.61610914*ustar_tmp) - - fr_il(3) = 0.81092087*(zl_tmp**(-0.03483105))*(ustar_tmp**( 0.58332966))*exp(-0.10731274*zl_tmp - 0.16463702*ustar_tmp) - fr_ih(3) = 1.05515450*(zl_tmp**(-0.25002535))*(ustar_tmp**( 0.14528047))*exp( 1.00641958*zl_tmp - 0.67569359*ustar_tmp) - Pr_il(3) = 6.60003543*(zl_tmp**(-0.45005503))*(ustar_tmp**( 1.35937877))*exp( 2.45632937*zl_tmp - 1.98267575*ustar_tmp) - Pr_ih(3) = 16.56290180*(zl_tmp**( 0.40464339))*(ustar_tmp**( 0.82276250))*exp(-3.92300971*zl_tmp - 1.82957067*ustar_tmp) - - - fr_il(1) = MAX( MIN( fr_il(1), REAL(1.50,ReKi) ), REAL(0.2 ,ReKi) ) - fr_ih(1) = MAX( MIN( fr_ih(1), REAL(8.0 ,ReKi) ), REAL(0.1 ,ReKi) ) - Pr_il(1) = MAX( MIN( Pr_il(1), REAL(8.0 ,ReKi) ), REAL(1.0 ,ReKi) ) - Pr_ih(1) = MAX( MIN( Pr_ih(1), REAL(1.2 ,ReKi) ), REAL(0.1 ,ReKi) ) - - fr_il(2) = MAX( MIN( fr_il(2), REAL(2.3 ,ReKi) ), REAL(0.12,ReKi) ) - fr_ih(2) = MAX( MIN( fr_ih(2), REAL(7.5 ,ReKi) ), REAL(1.8 ,ReKi) ) - Pr_il(2) = MAX( MIN( Pr_il(2), REAL(8.0 ,ReKi) ), REAL(0.2 ,ReKi) ) - Pr_ih(2) = MAX( MIN( Pr_ih(2), REAL(0.9 ,ReKi) ), REAL(0.2 ,ReKi) ) - - fr_il(3) = MAX( MIN( fr_il(3), REAL(1.4 ,ReKi) ), REAL(0.2 ,ReKi) ) - fr_ih(3) = MAX( MIN( fr_ih(3), REAL(1.75,ReKi) ), REAL(0.95,ReKi) ) - Pr_il(3) = MAX( MIN( Pr_il(3), REAL(7.0 ,ReKi) ), REAL(1.0 ,ReKi) ) - Pr_ih(3) = MAX( MIN( Pr_ih(3), REAL(1.0 ,ReKi) ), REAL(0.3 ,ReKi) ) - - tmpZIL = (-p%met%ZI / p%met%L)**Exp23 - HtZI = Ht / p%met%ZI - - tmpZIU = p%met%ZI / Ucmp - tmpZU = Ht / Ucmp - HtZI2 = (1.0 - HtZI)**2 - UDen = 1.0 + 15.0*HtZI - VDen = 1.0 + 2.8*HtZI - - DO I=1,p%grid%NumFreq - fi = p%grid%Freq(I)*tmpZIU - - tmpF = p%grid%Freq(I)*tmpZU ! reduced frequency - Ustar2F = uStar2/p%grid%Freq(I) ! Normalizing term - - ! u component - - fr = tmpF/UDen - X_l = fi/fr_il(1) - X_h = fr/fr_ih(1) - - ps_l = (Pr_il(1)* tmpZIL * 0.50*X_l)/( 1.0 + 2.2*X_l**Exp53 ) - ps_h = (Pr_ih(1)*(HtZI2/(UDen**Exp23))*105.00*X_h)/((1.0 + 33.0*X_h)**Exp53) - - Spec(I,1) = (ps_l + ps_h) * Ustar2F - - - ! v component - - fr = tmpF/VDen - X_l = fi/fr_il(2) - X_h = fr/fr_ih(2) - - ps_l = (Pr_il(2)* tmpZIL * 0.95*X_l)/((1.0 + 2.0*X_l)**Exp53) - ps_h = (Pr_ih(2)*(HtZI2/(VDen**Exp23))* 17.00*X_h)/((1.0 + 9.5*X_h)**Exp53) - - Spec(I,2) = (ps_l + ps_h) * Ustar2F - - - ! w component - - Freq2 = tmpF**2 - tmpFw = SQRT( (Freq2 + (0.3*HtZI)**2 ) / (Freq2 + 0.15**2) ) - X_l = fi /fr_il(3) - X_h = tmpF/fr_ih(3) - - ps_l = tmpFw*(Pr_il(3)*tmpZIL*0.95*X_l)/((1.0 + 2.0*X_l)**Exp53) - ps_h = (Pr_ih(3)*HtZI2 *2.00*X_h)/( 1.0 + 5.3*X_h**Exp53 ) - - Spec(I,3) = (ps_l + ps_h) * Ustar2F - - ENDDO -ENDIF - - -RETURN - -END SUBROUTINE Spec_NWTCUP -!======================================================================= -!> This routine gets velocity spectra for each of 3 wind components (u,v,w) -!! by 2-D interpolation. -SUBROUTINE Spec_TimeSer ( p, Ht, Ucmp, LastIndex, Spec ) - - - ! Passed variables - TYPE(TurbSim_ParameterType), INTENT(IN ) :: p !< Input: turbsim parameters - REAL(ReKi), INTENT(IN ) :: Ht !< Input: height for which spectra are requested - REAL(ReKi), INTENT(IN ) :: Ucmp !< Input: wind speed for which spectra are requested (used for missing components) - INTEGER(IntKi), INTENT(INOUT) :: LastIndex(2) !< Index for the last (Freq, Ht) used - REAL(ReKi), INTENT( OUT) :: Spec (:,:) !< Output: target spectrum (Frequency, component) - ! Local variables - REAL(ReKi) :: InCoord(2) ! Arranged as (Freq, Ht) - INTEGER(IntKi) :: i ! loop counters - - - -!bjj: fix me!!! (make use of nComp and height ) - - ! initialize Spec with extrapolated values on non-specified components or frequencies - ! i.e., fill the gaps where wind component or frequencies exceed what was specified in the time-series data with some numerical model - ! (or use zeros for known spectral values that will get overwritten later) - CALL Spec_TimeSer_Extrap ( p, Ht, Ucmp, Spec ) - - - InCoord(2) = Ht - - ! overwrite Spec at the frequencies and wind components by interpolating from known points - DO I=1,p%usr%nFreq !p%grid%NumFreq ! note that this assumes TMax = AnalysisTime (i.e., we have the same delta frequencies) - - InCoord(1) = p%grid%Freq(i) - CALL UserSpec_Interp2D( InCoord, p%usr, LastIndex, Spec(I,:) ) ! sets only Spec(1:p%usr%nFreq, 1:p%usr%nComp) values - - ENDDO ! I - - RETURN - - -END SUBROUTINE Spec_TimeSer -!======================================================================= -!< This routine adds high-frequency content to user-supplied data, -!! using the model specified in p%usr%TurbModel_ID -SUBROUTINE Spec_TimeSer_Extrap ( p, Ht, Ucmp, Spec ) - - - ! Passed variables - TYPE(TurbSim_ParameterType), INTENT(IN ) :: p !< Input: turbsim parameters - REAL(ReKi), INTENT(IN ) :: Ht !< Input: height for which spectra are requested - REAL(ReKi), INTENT(IN ) :: Ucmp !< Input: wind speed for which spectra are requested (used for missing components) - REAL(ReKi), INTENT( OUT) :: Spec (:,:) !< Output: target spectrum (Frequency, component) - - - IF ( p%usr%nComp < 3 .OR. p%usr%nFreq < p%grid%NumFreq ) THEN - - SELECT CASE ( p%usr%TurbModel_ID ) - CASE ( SpecModel_IECKAI ) ! IECKAI has uniform spectra (does not vary with height or velocity) - CALL Spec_IECKAI ( p%UHub, p%IEC%SigmaIEC, p%IEC%IntegralScale, p%grid%Freq, p%grid%NumFreq, Spec ) - - CASE ( SpecModel_IECVKM ) ! IECVKM has uniform spectra (does not vary with height or velocity) - CALL Spec_IECVKM ( p%UHub, p%IEC%SigmaIEC(1), p%IEC%IntegralScale, p%grid%Freq, p%grid%NumFreq, Spec ) - - CASE ( SpecModel_API ) - CALL Spec_API ( p, Ht, Spec ) - - CASE ( SpecModel_SMOOTH ) - CALL Spec_SMOOTH ( p, Ht, Ucmp, Spec ) - - CASE DEFAULT - Spec = 0.0_ReKi ! whole matrix is zero - - END SELECT - - ELSE - Spec = 0.0_ReKi ! whole matrix is zero - END IF - -END SUBROUTINE Spec_TimeSer_Extrap -!======================================================================= -!< This routine linearly interpolates the p%usr spectral data. It is -!! set for a 2-d interpolation on frequency and height of the input point. -!! p%usr%f and p%usr%pointzi must be in increasing order. Each dimension -!! may contain only 1 value. -SUBROUTINE UserSpec_Interp2D( InCoord, p_usr, LastIndex, OutSpec ) - - ! I/O variables - - REAL(ReKi), INTENT(IN ) :: InCoord(2) !< Arranged as (Freq, Ht) - TYPE(UserTSSpec_ParameterType), INTENT(IN ) :: p_usr !< - INTEGER(IntKi), INTENT(INOUT) :: LastIndex(2) !< Index for the last (Freq, Ht) used - REAL(ReKi), INTENT(INOUT) :: OutSpec(3) !< The interpolated resulting PSD from each component of p%usr%S(:,:,1-3) - - - ! Local variables - - INTEGER(IntKi) :: I ! loop counter - INTEGER(IntKi) :: Indx_Lo(2) ! index associated with lower bound of dimension 1,2 where val(Indx_lo(i)) <= InCoord(i) <= val(Indx_hi(i)) - INTEGER(IntKi) :: Indx_Hi(2) ! index associated with upper bound of dimension 1,2 where val(Indx_lo(i)) <= InCoord(i) <= val(Indx_hi(i)) - REAL(ReKi) :: Pos_Lo(2) ! coordinate value with lower bound of dimension 1,2 - REAL(ReKi) :: Pos_Hi(2) ! coordinate value with upper bound of dimension 1,2 - - REAL(ReKi) :: isopc(2) ! isoparametric coordinates - - REAL(ReKi) :: N(4) ! size 2^n - REAL(ReKi) :: u(4) ! size 2^n - - - - ! find the indices into the arrays representing coordinates of each dimension: - ! (by using LocateStp, we do not require equally spaced frequencies or points) - - CALL LocateStp( InCoord(1), p_usr%f, LastIndex(1), p_usr%nFreq ) - CALL LocateStp( InCoord(2), p_usr%pointzi, LastIndex(2), p_usr%nPoints ) - - Indx_Lo = LastIndex ! at this point, 0 <= Indx_Lo(i) <= n(i) for all i - - - ! Frequency (indx 1) - IF (Indx_Lo(1) == 0) THEN - Indx_Lo(1) = 1 - ELSEIF (Indx_Lo(1) == p_usr%nFreq ) THEN - Indx_Lo(1) = max( p_usr%nFreq - 1, 1 ) ! make sure it's a valid index - END IF - Indx_Hi(1) = min( Indx_Lo(1) + 1 , p_usr%nFreq ) ! make sure it's a valid index - - ! Height (indx 2) - IF (Indx_Lo(2) == 0) THEN - Indx_Lo(2) = 1 - ELSEIF (Indx_Lo(2) == p_usr%nPoints ) THEN - Indx_Lo(2) = max( p_usr%nPoints - 1, 1 ) ! make sure it's a valid index - END IF - Indx_Hi(2) = min( Indx_Lo(2) + 1 , p_usr%nPoints ) ! make sure it's a valid index - - - ! calculate the bounding box; the positions of all dimensions: - - pos_Lo(1) = p_usr%f( Indx_Lo(1) ) - pos_Hi(1) = p_usr%f( Indx_Hi(1) ) - - pos_Lo(2) = p_usr%pointzi( Indx_Lo(2) ) ! note that this assumes z are in increasing order - pos_Hi(2) = p_usr%pointzi (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 - - - do i = 1,p_usr%nComp - u(1) = p_usr%S( Indx_Hi(1), Indx_Lo(2), i ) - u(2) = p_usr%S( Indx_Hi(1), Indx_Hi(2), i ) - u(3) = p_usr%S( Indx_Lo(1), Indx_Hi(2), i ) - u(4) = p_usr%S( Indx_Lo(1), Indx_Lo(2), i ) - - OutSpec(i) = SUM ( N * u ) - end do - - -END SUBROUTINE UserSpec_Interp2D -!======================================================================= -!> This routine linearly interpolates data from an input file that -!! specifies the velocity spectra for each of 3 wind components (u,v,w) -SUBROUTINE Spec_UserSpec ( p, Spec ) - - IMPLICIT NONE - - ! Passed variables - type(TurbSim_ParameterType) , INTENT(IN ) :: p !< Input: turbsim parameters - REAL(ReKi), INTENT( OUT) :: Spec (:,:) !< Output: target spectrum - - ! Internal variables - - REAL(ReKi) :: Tmp - - - INTEGER :: I - INTEGER :: Indx - INTEGER :: J - INTEGER,PARAMETER :: iPoint = 1 - - ! --------- Interpolate to the desired frequencies --------------- - - Indx = 1; - - DO I=1,p%grid%NumFreq - - IF ( p%grid%Freq(I) <= p%usr%f(1) ) THEN - Spec(I,:) = p%usr%S(1,iPoint,:) - ELSEIF ( p%grid%Freq(I) >= p%usr%f(p%usr%nFreq) ) THEN - Spec(I,:) = p%usr%S(p%usr%nFreq,iPoint,:) - ELSE - - ! Find the two points between which the frequency lies - - DO J=(Indx+1),p%usr%nFreq - IF ( p%grid%Freq(I) <= p%usr%f(J) ) THEN - Indx = J-1 - - ! Let's just do a linear interpolation for now - - Tmp = (p%grid%Freq(I) - p%usr%f(Indx)) / ( p%usr%f(Indx) - p%usr%f(J) ) - - Spec(I,:) = Tmp * ( p%usr%S(Indx,iPoint,:) - p%usr%S(J,iPoint,:) ) + p%usr%S(Indx,iPoint,:) - - EXIT - ENDIF - ENDDO ! J - - ENDIF - - ENDDO ! I - - RETURN - - -END SUBROUTINE Spec_UserSpec -!======================================================================= -!> This subroutine defines the 3-D turbulence spectrum that can be expected over flat, -!! homogeneous terrain as developed by RISO authors Hojstrup, Olesen, and Larsen. -!! The use of this subroutine requires that variables have the units of meters and seconds. -SUBROUTINE Spec_SMOOTH ( p, Ht, Ucmp, Spec ) - - -IMPLICIT NONE - - ! Passed variables - - TYPE(TurbSim_ParameterType) , INTENT(IN ) :: p !< Input: turbsim parameters - REAL(ReKi), INTENT(IN ) :: Ht !< Height - REAL(ReKi), INTENT(IN ) :: Ucmp !< Longitudinal Velocity - REAL(ReKi), INTENT( OUT) :: Spec (:,:) !< output: target spectra - - ! Internal variables - - REAL(ReKi), PARAMETER :: Exp1 = 5.0 / 3.0 - REAL(ReKi), PARAMETER :: Exp2 = 2.0 / 3.0 - REAL(ReKi), PARAMETER :: Exp3 = 3.0 / 2.0 - REAL(ReKi) :: fi ! Temporary variable for calculation of Spec - REAL(ReKi) :: fr ! Temporary variable for calculation of Spec - REAL(ReKi) :: HtZI ! Temporary variable for calculation of Spec - REAL(ReKi) :: HtZI2 ! Temporary variable for calculation of Spec - REAL(ReKi) :: phiE - REAL(ReKi) :: phiM ! Non-Dimensional Wind Shear - REAL(ReKi) :: ps_h - REAL(ReKi) :: ps_l - REAL(ReKi) :: tmpF ! Temporary variable for calculation of Spec - REAL(ReKi) :: tmpN ! Temporary variable for calculation of Spec - REAL(ReKi) :: tmpX ! Temporary variable for calculation of Spec - REAL(ReKi) :: tmpXX ! Temporary variable for calculation of Spec - REAL(ReKi) :: tmpPhi ! Temporary variable for calculation of Spec - REAL(ReKi) :: tmpZIL ! Temporary variable for calculation of Spec - REAL(ReKi) :: tmpZIU ! Temporary variable for calculation of Spec - REAL(ReKi) :: tmpZU ! Temporary variable for calculation of Spec - REAL(ReKi) :: UDen - REAL(ReKi) :: uStar2 ! Temporary variable holding Ustar-squared - REAL(ReKi) :: Ustar2F - REAL(ReKi) :: VDen - - INTEGER :: I ! DO LOOP counter - -uStar2 = p%met%Ustar * p%met%Ustar - -IF (p%met%zL >= 0) THEN - - ! Calculate NEUTRAL/STABLE spectral estimates - - phiM = 1.0 + 4.7*(p%met%zL) ! = q - phiE = (1.0 + 2.5*(p%met%zL)**0.6)**Exp3 - - tmpPhi = uStar2 * ( (phiE / phiM)**Exp2 ) - tmpF = Ht / (Ucmp * phiM) - - DO I = 1,p%grid%NumFreq - tmpX = p%grid%Freq(I)*tmpF ! reduced frequency divided by q (q = phiM here) - tmpXX = tmpX**Exp1 - tmpN = tmpPhi / p%grid%Freq(I) * tmpX ! normalization factor used to obtain power spectrum components - - Spec(I,1) = tmpN * (79.0) / (1.0 + 263.0*tmpXX) - Spec(I,2) = tmpN * (13.0) / (1.0 + 32.0*tmpXX) - Spec(I,3) = tmpN * ( 3.5) / (1.0 + 8.6*tmpXX) - ENDDO - -ELSE - ! Calculate UNSTABLE spectral estimates - tmpZIL = (- p%met%ZI / p%met%L)**Exp2 - HtZI = Ht / p%met%ZI - - HtZI2 = (1.0 - HtZI)**2 - tmpZU = Ht / Ucmp - tmpZIU = p%met%ZI / Ucmp - UDen = 1.0 + 15.0*HtZI - VDen = 1.0 + 2.8*HtZI - - DO I = 1,p%grid%NumFreq - - Fi = p%grid%Freq(I)*tmpZIU - tmpF = p%grid%Freq(I)*tmpZU ! reduced frequency - - Ustar2F = uStar2/p%grid%Freq(I) - - ! u component - Fr = tmpF / UDen - ps_l = ( ( 0.5*Fi) / (1.0 + 2.2* Fi**Exp1)) * tmpZIL - ps_h = ( (105.0*Fr) / (1.0 + 33.0*Fr )**Exp1 ) * HtZI2 / UDen**Exp2 - - Spec(I,1) = (ps_l + ps_h) * Ustar2F - - ! v component - Fr = tmpF / VDen - ps_l = ( ( 0.95*Fi) / (1.0 + 2.0*Fi)**Exp1 ) * tmpZIL - ps_h = ( (17.00*Fr) / (1.0 + 9.5*Fr)**Exp1 ) * HtZI2 / VDen**Exp2 - - Spec(I,2) = (ps_l + ps_h) * Ustar2F - - ! w component - tmpN = SQRT( (tmpF**2 + (0.3*HtZI)**2) / (tmpF**2 + 0.0225) ) - - ps_l = tmpN * ( (0.95*Fi ) / (1.0 + 2.0*Fi )**Exp1 ) * tmpZIL - ps_h = ( (2.00*tmpF) / (1.0 + 5.3*tmpF**Exp1)) * HtZI2 - - Spec(I,3) = (ps_l + ps_h) * Ustar2F - - ENDDO - -ENDIF - - -RETURN -END SUBROUTINE Spec_SMOOTH -!======================================================================= -!> This subroutine defines the 3-D turbulence expected in a tidal channel (HYDROTURBSIM specific). -!! It is similar to the 'smooth' spectral model (RISO; Hojstrup, Olesen and Larsen) for wind, -!! but is scaled by the TKE (SigmaU**2), and du/dz rather than Ustar and u/z. -!! The fit is based on data from Puget Sound, estimated by L. Kilcher. -!! The use of this subroutine requires that variables have the units of meters and seconds. -!! Note that this model does not require height. -SUBROUTINE Spec_TIDAL ( p, Ht, Shr_DuDz, Spec, SpecModel ) - -IMPLICIT NONE - - ! Passed variables - - TYPE(TurbSim_ParameterType) , INTENT(IN ) :: p !< Input: turbsim parameters - REAL(ReKi), INTENT(IN ) :: Ht !< Height (dz) - REAL(ReKi), INTENT(IN ) :: Shr_DuDz !< Shear (du/dz) - INTEGER(IntKi), INTENT(IN ) :: SpecModel !< SpecModel (SpecModel_TIDAL .OR. SpecModel_RIVER) - REAL(ReKi), INTENT( OUT) :: Spec (:,:) !< output: target spectra - - ! Internal variables - - REAL(ReKi), PARAMETER :: Exp1 = 5.0 / 3.0 - REAL(ReKi) :: Sigma_U2 ! Standard Deviation of U velocity, squared. - REAL(ReKi) :: Sigma_V2 ! Standard Deviation of V velocity, squared. - REAL(ReKi) :: Sigma_W2 ! Standard Deviation of W velocity, squared. - - REAL(ReKi) :: tmpX ! Temporary variable for calculation of Spec - REAL(ReKi) :: tmpvec(3) ! Temporary vector for calculation of Spec - REAL(ReKi) :: tmpa (3) ! Spectra coefficients - REAL(ReKi) :: tmpb (3) ! Spectra coefficients - INTEGER :: I ! DO LOOP counter - - - -!print *, Ustar -!Sigma_U2=(TurbIntH20*U(IZ))**2 ! A fixed value of the turbulence intensity. Do we want to implement this? -Sigma_U2=4.5*p%met%Ustar*p%met%Ustar*EXP(-2*Ht/p%met%RefHt) -Sigma_V2=0.5*Sigma_U2 -Sigma_W2=0.2*Sigma_U2 - - -SELECT CASE ( SpecModel ) - CASE ( SpecModel_TIDAL ) - tmpa = (/ 0.193, 0.053 , 0.0362 /)*TwoPi ! These coefficients were calculated using Shr_DuDz in units of 'radians', so we multiply these coefficients by 2*pi. - tmpb = (/ 0.201, 0.0234, 0.0124 /)*(TwoPi**Exp1) - CASE ( SpecModel_RIVER ) - ! THESE ARE NOT VERIFIED YET!!!, therefore they are undocumented. - tmpa = (/ 0.081, 0.056 , 0.026 /)*TwoPi - tmpb = (/ 0.16, 0.025, 0.020 /)*(TwoPi**Exp1) -END SELECT - -tmpvec = tmpa*(/Sigma_U2, Sigma_V2, Sigma_W2/)/Shr_DuDz - -DO I = 1,p%grid%NumFreq - tmpX = (p%grid%Freq(I)/Shr_DuDz)**Exp1 - Spec(I,1) = tmpvec(1) / (1.0 + tmpb(1)*tmpX) - Spec(I,2) = tmpvec(2) / (1.0 + tmpb(2)*tmpX) - Spec(I,3) = tmpvec(3) / (1.0 + tmpb(3)*tmpX) -ENDDO - -RETURN -END SUBROUTINE Spec_TIDAL -!======================================================================= -!> This routine is just a test function to see if we get the requested -!! spectra from the TurbSim code. -SUBROUTINE Spec_Test ( Spec, Freq ) - -IMPLICIT NONE - - ! Passed variables - REAL(ReKi), intent( out) :: Spec (:,:) !< Output: target spectrum - REAL(ReKi), INTENT(IN ) :: Freq(:) - - -INTEGER :: I -INTEGER :: IVec - - - ! Create the spectrum. - -DO IVec = 1,3 - - DO I = 1,SIZE(Spec,1) - Spec(I,IVec) = 0.0 - ENDDO !I - !I = INT( NumFreq/2 ) - I = INT( 100 ) - Spec( I, IVec ) = 1/Freq(1) - - call WrScr( 'Test Spectra: sine wave with frequency '//trim(num2lstr(Freq(I)))//' Hz.' ) - -ENDDO !IVec - - -RETURN -END SUBROUTINE Spec_Test -!======================================================================= -!> This subroutine defines the von Karman PSD model. -!! The use of this subroutine requires that all variables have the units of meters and seconds. -SUBROUTINE Spec_vonKrmn ( p, Ht, Ucmp, Spec ) - - -IMPLICIT NONE - - ! Passed variables - - TYPE(TurbSim_ParameterType) , INTENT(IN ) :: p !< Input: turbsim parameters - REAL(ReKi), INTENT(IN ) :: Ht !< local height - REAL(ReKi), INTENT(IN ) :: Ucmp !< local wind speed - REAL(ReKi), INTENT( OUT) :: Spec (:,:) !< Target spectra - - ! Internal variables - -REAL(ReKi),PARAMETER :: Exp1 = 5.0/6.0 -REAL(ReKi),PARAMETER :: Exp2 = 11.0/6.0 -REAL(ReKi) :: FLU2 -REAL(ReKi) :: L1_U -REAL(ReKi) :: Lambda -REAL(ReKi) :: Lvk ! von Karman length scale -REAL(ReKi) :: Sigma ! Standard deviation -REAL(ReKi) :: SigmaL1_U -REAL(ReKi) :: Tmp - -INTEGER :: I - - ! Define isotropic integral scale. -IF ( ALLOCATED( p%met%USR_L ) ) THEN - IF ( Ht <= p%met%USR_Z(1) ) THEN - Lvk = p%met%USR_L(1) ! Extrapolation: nearest neighbor for heights below minimum height specified - ELSEIF ( Ht >= p%met%USR_Z(p%met%NumUSRz) ) THEN - Lvk = p%met%USR_L(p%met%NumUSRz) ! Extrapolation: nearest neighbor for heights above maximum height specified - ELSE !Interpolation: linear between user-defined height/integral scale curves - DO I=2,p%met%NumUSRz - IF ( Ht <= p%met%USR_Z(I) ) THEN - Lvk = (Ht - p%met%USR_Z(I-1)) * ( p%met%USR_L(I-1) - p%met%USR_L(I) ) / ( p%met%USR_Z(I-1) - p%met%USR_Z(I) ) + p%met%USR_L(I-1) - EXIT - ENDIF - ENDDO - ENDIF -ELSE - IF ( Ht < 150.0 ) THEN - Lambda = 0.7*Ht - ELSE - Lambda = 105.0 - ENDIF - Lvk = 3.5*Lambda -ENDIF - - ! Define isotropic integral scale. -IF ( ALLOCATED( p%met%USR_Sigma ) ) THEN - IF ( Ht <= p%met%USR_Z(1) ) THEN - Sigma = p%met%USR_Sigma(1) - ELSEIF ( Ht >= p%met%USR_Z(p%met%NumUSRz) ) THEN - Sigma = p%met%USR_Sigma(p%met%NumUSRz) - ELSE - DO I=2,p%met%NumUSRz - IF ( Ht <= p%met%USR_Z(I) ) THEN - Sigma = (Ht - p%met%USR_Z(I-1)) * ( p%met%USR_Sigma(I-1) - p%met%USR_Sigma(I) ) / ( p%met%USR_Z(I-1) - p%met%USR_Z(I) ) + p%met%USR_Sigma(I-1) - EXIT - ENDIF - ENDDO - ENDIF -ELSE - Sigma = p%met%Ustar*2.15 !bjj: BONNIE, make sure this is defined, or else define ustar for this model... -ENDIF - - -L1_U = Lvk/Ucmp -SigmaL1_U = 2.0*Sigma*Sigma*L1_U - -DO I=1,p%grid%NumFreq - - FLU2 = ( p%grid%Freq(I)*L1_U )**2 - Tmp = 1.0 + 71.0*FLU2 - - Spec(I,1) = (p%met%USR_StdScale(1)**2)*2.0*SigmaL1_U/Tmp**Exp1 - Spec(I,2) = SigmaL1_U*( 1.0 + 189.0*FLU2 )/Tmp**Exp2 - Spec(I,3) = Spec(I,2) - - Spec(I,2) = (p%met%USR_StdScale(2)**2)*Spec(I,2) - Spec(I,3) = (p%met%USR_StdScale(3)**2)*Spec(I,3) - -ENDDO ! I - -RETURN -END SUBROUTINE Spec_vonKrmn -!======================================================================= -!> This subroutine defines the 3-D turbulence spectrum that can be expected to exist upstream of a large, multi-row -!! wind park. It is based on the smooth or homogeneous terrain models of Hojstrup, Olesen, and Larsen of RISO -!! National Laboratory in Denmark. The RISO model has been adjusted to reflect the different spectral scaling present -!! in the flow upwind of a large wind park. The scaling is based on measurements made by the National Renewable Energy -!! Laboratory (NREL) in San Gorgonio Pass, California. -SUBROUTINE Spec_WF_UPW ( p, Ht, Ucmp, Spec ) - -IMPLICIT NONE - - ! Passed variables - - TYPE(TurbSim_ParameterType) , INTENT(IN ) :: p !< Input: turbsim parameters - REAL(ReKi), INTENT(IN ) :: Ht !< Height ( input ) - REAL(ReKi), INTENT(IN ) :: Ucmp !< Velocity ( input ) - REAL(ReKi), INTENT( out) :: Spec (:,:) !< Target velocity spectra ( output ) - - ! Internal variables - -REAL(ReKi) :: den ! Denominator (replaces Pum_ih, Pum_il, fum_ih, fum_il) -REAL(ReKi), PARAMETER :: Exp1 = 5.0 / 3.0 -REAL(ReKi), PARAMETER :: Exp2 = 2.0 / 3.0 -REAL(ReKi), PARAMETER :: Exp3 = 3.0 / 2.0 -REAL(ReKi) :: F ! Reduced frequency -REAL(ReKi) :: Fi -REAL(ReKi) :: Fq ! reduced frequency / q -REAL(ReKi) :: fur_ih -REAL(ReKi) :: fur_il -REAL(ReKi) :: fvr_ih -REAL(ReKi) :: fvr_il -REAL(ReKi) :: fwr_ih -REAL(ReKi) :: fwr_il -REAL(ReKi) :: Fw -REAL(ReKi) :: HtU ! Height / Ucmp -REAL(ReKi) :: HtZI ! Height / ZI -- used to avoid recalculation -REAL(ReKi) :: HtZI2 ! (1.0 - Height / ZI)^2 -REAL(ReKi) :: num ! Numerator (replaces Puo_ih, Puo_il, fuo_ih, fuo_il) -REAL(ReKi) :: phiE -REAL(ReKi) :: phiEQ ! temp variable -REAL(ReKi) :: phiM -REAL(ReKi) :: Ps_h -REAL(ReKi) :: Ps_l -REAL(ReKi) :: Pur_ih -REAL(ReKi) :: Pur_il -REAL(ReKi) :: Pvr_ih -REAL(ReKi) :: Pvr_il -REAL(ReKi) :: Pwr_ih -REAL(ReKi) :: Pwr_il -REAL(ReKi) :: q -REAL(ReKi) :: UDen ! -REAL(ReKi) :: UDen2 ! -REAL(ReKi) :: Ustar2 ! Ustar**2 -REAL(ReKi) :: Ustar2F ! Ustar**2 / Frequency -REAL(ReKi) :: VDen ! -REAL(ReKi) :: VDen2 ! -REAL(ReKi) :: X ! Temporary variable -REAL(ReKi) :: ZInL ! ZI / -L -- used to avoid recalculation -REAL(ReKi) :: ZIU ! ZI / Ucmp -REAL(ReKi), PARAMETER :: ZI_UVlimit = 1350.0 -REAL(ReKi), PARAMETER :: ZI_Wlimit = 1600.0 -REAL(ReKi), PARAMETER :: ZL_MaxObs = 0.15 -REAL(ReKi), PARAMETER :: ZL_MinObs = -1.00 - - -INTEGER :: I ! Loop counter - - -Ustar2 = p%met%Ustar*p%met%Ustar - -IF ( p%met%ZL < 0 ) THEN - ! BEGIN UNSTABLE FLOW LOOP - - ! Unstable high-frequency range scaling... - - X = - MAX( p%met%ZL, ZL_MinObs) - - Num = 0.691114 + 0.0791666*X ! was "Original" Puo_ih = - Den = 0.77991 + 0.1761624 / ( 1.0 + EXP( -(X - 0.0405364) / (-0.0184402) ) ) ! was "Measured" Pum_ih = - Pur_ih = 0.10 * ( Num / Den ) - IF (p%met%ZI > ZI_UVlimit) Pur_ih = (p%met%ZI / ZI_UVlimit) * Pur_ih - - Num = 0.421958 * EXP( 0.20739895*X ) - Den = 0.5247865 + 0.0419204 / ( 1.0 + EXP( -(X - 0.0434172) / (-0.0179269) ) ) - Pvr_ih = Num / Den - - Num = 0.222875 + 0.1347188*X - Den = 0.3542331 + 0.0168806 / ( 1.0 + EXP( -(X - 0.0388899) / (-0.0220998) ) ) - Pwr_ih = 0.80 * ( Num / Den ) - - Num = 0.047465 + 0.0132692*X - Den = 0.0599494 - 0.0139033*EXP(-X / 0.02603846) - fur_ih = 1.75 * ( Num / Den ) - IF (p%met%ZI > ZI_UVlimit) fur_ih = (p%met%ZI / ZI_UVlimit)*fur_ih - - Num = 0.18377384 * EXP( 0.2995136*X ) - Den = 0.1581509 + 0.09501906*X - fvr_ih = 1.50 * ( Num / Den ) - IF (p%met%ZI > ZI_UVlimit) fvr_ih = (p%met%ZI / ZI_UVlimit)*fvr_ih - - Num = 0.3419874 + 0.24985029 * EXP(-X / 0.02619489) - Den = 0.451295 + 0.2355227*X - fwr_ih = 2.0 * ( Num / Den ) - IF (p%met%ZI > ZI_Wlimit) fwr_ih = 0.35*(p%met%ZI / ZI_Wlimit)*fwr_ih - - - ! Unstable low-frequency range scaling... - - Num = -0.436922 + 2.784789 / ( 1.0 + EXP( -(X - 0.104094) / 0.136708 ) ) - Den = 0.1392684 + 1.7396251*X - Pur_il = 2.00 * ( Num / Den ) - - Num = 0.467006 + (5.3032075*X)**1.1713260 - Den = 0.1425146 + 2.2011562*X - Pvr_il = 0.25 * ( Num / Den ) - - Num = 0.086908 + (2.3719755 *X)**1.3106297 - Den = 0.00251981 + (0.50642167*X)**0.6607754 - Pwr_il = Num / Den - - Num = 0.467962 + 0.9270681*EXP( -X / 0.02039003 ) - Den = 0.759259 - 0.1448362*X ! X < 5.24 - fur_il = Num / Den - - Num = 0.369625 + 1.0772852*EXP( -X / 0.0210098 ) - !Den = 0.759259 - 0.1448362*X calculated previously - fvr_il = 2.25 * ( Num / Den ) - IF (p%met%ZI > ZI_UVlimit) fvr_il = (p%met%ZI / ZI_UVlimit)*fvr_il - - Num = 3.39482 * EXP( 0.279914*X ) - Den = 4.59769 + 12.58881*EXP( -X / 0.03351852 ) - fwr_il = 2.25 * ( Num / Den ) - IF (p%met%ZI > ZI_Wlimit) fwr_il=4.0*(p%met%ZI / ZI_Wlimit)*fwr_il - - HtZI = Ht / p%met%ZI - HtZI2 = (1.0 - HtZI)**2 - ZInL = ( p%met%ZI / ( -p%met%L ) )**Exp2 - HtU = Ht / Ucmp - ZIU = p%met%ZI / Ucmp - UDen = 1.0 + 15.0*HtZI - VDen = 1.0 + 2.8*HtZI - UDen2 = HtZI2 / UDen**Exp2 - VDen2 = HtZI2 / VDen**Exp2 - - - DO I = 1,p%grid%NumFreq - - F = p%grid%Freq(I) * HtU - Fi = p%grid%Freq(I) * ZIU - - ! Bonnie: These () around 0.3 HtZI are incorrect as compared to the original SMOOTH model. (For now, leave as is since parameters were-supposedly-calculated with this formulation) - Fw = SQRT( (F**2 + (0.3*HtZI**2) ) / (F**2 + 0.0225) ) - - Ustar2F = Ustar2 / p%grid%Freq(I) - - ! CALCULATE UNSTABLE LONGITUDINAL SPECTRAL COMPONENT, nSu(n)/(u*)^2, then multiply by (u*)^2/n - - X = Fi / fur_il - Ps_l = Pur_il * ( (0.5*X) / (1.0 + 2.2 * X**Exp1) ) * ZInL - - X = F / (UDen * fur_ih) ! Fru = F / UDen - Ps_h = ( (105.0 * X) / (1.0 + 33.0 * X )**Exp1 ) * UDen2 - Ps_h = Ps_h*Pur_ih - - Spec(I,1) = ( Ps_l + Ps_h ) * Ustar2F - - ! CALCULATE UNSTABLE CROSSWIND SPECTRAL COMPONENT, nSv(n)/(u*)^2, then multiply by (u*)^2/n - - X = Fi / fvr_il - Ps_l = ( (0.95*X) / (1.0 + 2.0 * X)**Exp1 ) * ZInL - Ps_l = Ps_l*Pvr_il - - X = F / (VDen * fvr_ih) ! Frv = F / VDen - Ps_h = ( (17.0 * X) / (1.0 + 9.5*X)**Exp1 ) * VDen2 - Ps_h = Ps_h*Pvr_ih - - Spec(I,2) = ( Ps_l + Ps_h ) * Ustar2F - - ! CALCULATE UNSTABLE VERTICAL SPECTRAL COMPONENT, nSw(n)/(u*)^2, then multiply by (u*)^2/n - - X = Fi / fwr_il - Ps_l = Fw * ( (0.95*X) / (1.0 + 2.0*X)**Exp1 ) * ZInL - Ps_l = Ps_l*Pwr_il - - X = F / fwr_ih - Ps_h = ( (2.0*X) / (1.0 + 5.3 * X**Exp1) ) * HtZI2 - Ps_h = Ps_h * Pwr_ih - - Spec(I,3) = ( Ps_l + Ps_h ) * Ustar2F - - ENDDO - -ELSE ! ZL >= 0 ! BEGIN STABLE FLOW LOOP - - X = MIN(p%met%ZL, ZL_MaxObs) - - ! Get stable spectral peaks - - ! Calculate smooth terrain scaling functions - - phiE = (1.0 + 2.5 * X**0.6) **Exp3 - phiM = 1.0 + 4.7*X - - q = phiM - - ! Stable high-frequency (shear) range scaling ... - - Num = 0.8029768 + ( 1.708247*X )**3.669245 - Den = 1.5431 * EXP( 1.6379*X ) - Pur_ih = 0.01*( Num / Den ) - - Num = 0.419234 + ( 2.759119*X )**1.4483715 - Den = 0.89717 * EXP( 1.67034*X ) - Pvr_ih = 1.30 * ( Num / Den ) - - Num = 0.239692 + ( 2.3531204*X )**1.062937 - Den = 0.5324 * EXP( 1.6314*X ) - Pwr_ih = Num / Den - Pwr_ih = Pwr_ih - 2.0*X - IF ( Pwr_ih <= 0.0) Pwr_ih = 1.0 - Pwr_ih = 1.5*Pwr_ih - - Num = 0.042393 + ( 1.28175*X )**1.409066 - Den = 0.045 + 0.21137*X - fur_ih = 3.5 * ( Num / Den ) - - Num = 0.220831 + (0.630632*X)**0.8120686 - Den = 0.160 + 0.74876*X - fvr_ih = 1.25 * ( Num / Den ) - - Num = 0.382558 + (1.3640485*X)**1.524565 - Den = 0.350 + 1.638806*X - fwr_ih = 1.5 * ( Num / Den ) - - ! Low-frequency range scaling... - - Num = 0.88418 + (11.665367*X)**0.794753 - Den = 1.55288 * EXP( 1.56925*X ) - Pur_il = 1.50 * ( Num / Den ) - - Num = 0.4671733 + 4.3093084 * X**(0.859202) - Den = 0.90382 * EXP( 1.59076*X ) - Pvr_il = 0.75 * ( Num / Den ) - - Num = 0.076136 + 2.644456 * X**(1.207014) - Den = 0.533202 * EXP( 1.51415*X ) - Pwr_il = Num / Den - Pwr_il = Pwr_il - 1.75*X - - Num = 0.009709 + ( 0.4266236*X )**1.644925 - Den = 0.045 + 0.212038*X - fur_il = 2.00 * ( Num / Den ) - fur_il = ABS(fur_il - 3.0*X) - - Num = 0.0220509 + ( 0.93256713*X )**1.719292 - Den = 0.160 + 0.74985*X - fvr_il = 1.15 * ( Num / Den ) - - Num = 0.0351474 + ( 1.4410838*X )**1.833043 - Den = 0.350 + 1.645667*X - fwr_il = Num / Den - - - phiEQ = (phiE / q)**Exp2 - - DO I = 1,p%grid%NumFreq - - ! CALCULATE Reduced Frequency, f - - f = p%grid%Freq(I) * Ht / Ucmp - fq = f / q ! was XU = f/qu, XV = f/qv, XW = f/qw - - Ustar2F = Ustar2 / p%grid%Freq(I) - - ! CALCULATE NEUTRAL/STABLE LONGITUDINAL SPECTRAL COMPONENT, nSu(n)/(u*)^2, then multiply by (u*)^2/n - - X = fq / fur_ih - Ps_h = ( (79.0 * X) / (1.0 + 263.0 * X**Exp1) ) * phiEQ - Ps_h = Ps_h*Pur_ih - - X = fq / fur_il - Ps_l = ( (79.0 * X) / (1.0 + 263.0 * X**Exp1) ) * phiEQ - Ps_l = Ps_l*Pur_il - - Spec(I,1) = ( Ps_l + Ps_h ) * Ustar2F - - ! CALCULATE NEUTRAL/STABLE CROSSWIND SPECTRAL COMPONENT, nSv(n)/(u*)^2, then multiply by (u*)^2/n - - X = fq / fvr_ih - Ps_h = ( (13.0 * X) / (1.0 + 32.0 * X**Exp1) ) * phiEQ - Ps_h = Ps_h*Pvr_ih - - X = fq / fvr_il - Ps_l = ( (13.0 * X) / (1.0 + 32.0 * X**Exp1) ) * phiEQ - Ps_l = Ps_l*Pvr_il - - Spec(I,2) = ( Ps_h + Ps_l ) * Ustar2F - - ! CALCULATE NEUTRAL/STABLE VERTICAL SPECTRAL COMPONENT, nSw(n)/(u*)^2, then multiply by (u*)^2/n - - X = fq / fwr_ih - Ps_h = ( ( 3.5 * X) / (1.0 + 8.6 * X**Exp1) ) * phiEQ - Ps_h = Ps_h*Pwr_ih - - X = fq / fwr_il - Ps_l = ( ( 3.5 * X) / (1.0 + 8.6 * X**Exp1) ) * phiEQ - Ps_l = Ps_l*Pwr_il - - Spec(I,3) = ( Ps_l + Ps_h ) * Ustar2F - - ENDDO ! I - -ENDIF ! ZL < 0 - - -RETURN -END SUBROUTINE Spec_WF_UPW -!======================================================================= -!> This subroutine defines the 3-D turbulence spectrum that can be expected to exist (7 to 14 rotor diameters) -!! downstream of a large, multi-row wind park. The scaling is based on measurements made by the National -!! Renewable Energy Laboratory (NREL) in San Gorgonio Pass, California. -SUBROUTINE Spec_WF_DW ( p, Ht, Ucmp, Spec, ErrStat, ErrMsg ) - - -IMPLICIT NONE - - ! Passed variables - - TYPE(TurbSim_ParameterType) , INTENT(IN ) :: p !< Input: turbsim parameters - REAL(ReKi), INTENT(IN ) :: Ht !< Height ( input ) - REAL(ReKi), INTENT(IN ) :: Ucmp !< Velocity ( input ) - REAL(ReKi), INTENT( out) :: Spec (:,:) !< Target velocity spectra ( output ) - - INTEGER(IntKi), INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMsg - - - ! Internal variables - - REAL(ReKi) :: A0 - REAL(ReKi) :: A1 - REAL(ReKi) :: A2 - REAL(ReKi) :: A3 - REAL(ReKi), PARAMETER :: Exp1 = 5.0 / 3.0 - REAL(ReKi), PARAMETER :: Exp2 = 2.0 / 3.0 - REAL(ReKi), PARAMETER :: Exp3 = 3.0 / 2.0 - REAL(ReKi) :: den ! Denominator (replaces Pum_oh, Pum_ol, fum_oh, fum_ol, Pvm_oh) - REAL(ReKi) :: F ! Reduced frequency - REAL(ReKi) :: Fi - REAL(ReKi) :: fur_oh - REAL(ReKi) :: fur_ol - REAL(ReKi) :: fvr_oh - REAL(ReKi) :: fvr_ol - REAL(ReKi) :: fvr_wk - REAL(ReKi) :: Fw - REAL(ReKi) :: fwr_oh - REAL(ReKi) :: fwr_ol - REAL(ReKi) :: Fq ! reduced frequency / q - REAL(ReKi) :: HtZI ! Height / ZI -- used to avoid recalculation - REAL(ReKi) :: HtZI2 ! (1.0 - Height / ZI)^2 - REAL(ReKi) :: num ! Numerator (replaces Puo_oh, Puo_ol, fuo_oh, fuo_ol, Pvo_wk) - REAL(ReKi) :: phiE - REAL(ReKi) :: phiM - REAL(ReKi) :: Ps_h - REAL(ReKi) :: Ps_l - REAL(ReKi) :: Ps_wk - REAL(ReKi) :: Pur_oh ! High Frequency Range - REAL(ReKi) :: Pur_ol ! Low Frequency Range - REAL(ReKi) :: Pvr_oh - REAL(ReKi) :: Pvr_ol - REAL(ReKi) :: Pvr_wk - REAL(ReKi) :: Pwr_oh - REAL(ReKi) :: Pwr_ol - REAL(ReKi) :: q - REAL(ReKi) :: tmp ! holds calculation common to several formulae - REAL(ReKi) :: UDen ! - REAL(ReKi) :: UDen2 ! - REAL(ReKi) :: Ustar2 ! Ustar**2 - REAL(ReKi) :: Ustar2F ! Ustar**2 / Frequency - REAL(ReKi) :: VDen ! - REAL(ReKi) :: VDen2 ! - REAL(ReKi) :: X ! Temporary variable - REAL(ReKi) :: ZInL ! ZI / -L -- used to avoid recalculation - REAL(ReKi), PARAMETER :: ZL_MaxObs = 0.4 ! The largest z/L value where the spectral peak scaling should work. - REAL(ReKi), PARAMETER :: ZL_MinObs = -1.0 ! The smallest z/L value where the spectral peak scaling should work. - - INTEGER :: I ! Loop counter - - - ErrStat = ErrID_None - ErrMsg = "" - -Ustar2 = p%met%Ustar*p%met%Ustar - -IF (p%met%ZL < 0) THEN - - - ! Get Unstable spectral peaks - - ! Unstable high-frequency range scaling... - - X = - MAX( p%met%ZL, ZL_MinObs ) - - Num = 0.598894 + 0.282106 * EXP(-X / 0.0594047) - Den = 0.600977 + 9.137681 / (1.0 + EXP( -(X + 0.830756) / (-0.252026) )) - Pur_oh = 0.1 * (Num / Den) - - Num = 0.4830249 + 0.3703596 * EXP(-X / 0.0553952) - Den = 0.464604 + 1.900294 / (1.0 + EXP( -(X + 0.928719) / (-0.317242) )) - Pvr_oh = 5.0 * (Num / Den) - - Num = 0.320112 + 0.229540 * EXP(-X / 0.0126555) - Den = 0.331887 + 1.933535 / (1.0 + EXP( -(X + 1.19018 ) / (-0.3011064) )) - Pwr_oh = 1.25 * (Num / Den) - - Num = 0.049279 + EXP(0.245214 * X * 2.478923) ! was Num = 0.049279 + EXP(0.245214 * X)**2.478923 - Den = -2.333556 + 2.4111804 / (1.0 + EXP( -(X + 0.623439) / 0.1438076)) - fur_oh = 0.3 * (Num / Den) - - Num = -2.94362 + 3.155970 / (1.0 + EXP( -(X + 0.872698) / 0.245246)) - Den = 0.0171463 + 0.188081 / (1.0 + EXP( -(X + 0.711851) / 0.688910)) - fvr_oh = 2.0 * (Num / Den) - - Num = 0.7697576 * EXP( -X / 3.8408779 ) - 0.561527 * EXP( -X / 0.1684403 ) ! was Num = Beta4(X,A0,A1,A2,A3) - Den = 0.512356 - 0.044946 / (1.0 + EXP( -(X - 0.066061) / (-0.0121168) )) - fwr_oh = 1.75 * (Num / Den) - IF (p%met%ZI < 1350.0 ) fwr_oh = (p%met%ZI / 1350.0) * fwr_oh - - ! Unstable low-frequency range scaling ... - - Num = 0.796264 + 0.316895 / (1.0 + EXP( -(X - 0.082483) / 0.027480 )) - Den = 0.07616 + EXP(0.303919 * X * 0.390906) ! was Den = 0.07616 + EXP(0.303919*X)**0.390906 - Pur_ol = 4.0 * (Num / Den) - IF (p%met%ZI < 1600.0) Pur_ol = (p%met%ZI / 1600.0) * Pur_ol - - Num = 0.812483 + 0.1332134 * X - Den = 0.104132 + EXP(0.714674 * X * 0.495370) ! was Den = 0.104132 + EXP(0.714674*X)**0.495370 - Pvr_ol = Num / Den - Pvr_ol = (p%met%ZI / 1600.0)*Pvr_ol - - Num = 0.371298 + 0.0425447 * X - Den = 0.0004375 + EXP(0.4145751 * X * 0.6091557) ! was Den = 0.0004375 + EXP(0.4145751*X)**0.6091557 - Pwr_ol = 0.75 * (Num / Den) - - Num = 0.859809 * EXP(0.157999 * X) - Den = 0.81459 + 0.021942 * X - fur_ol = 1.5 * (Num / Den) - IF (p%met%ZI > 1850.0) fur_ol = 2.6 * (p%met%ZI / 1850.0) * fur_ol - - !A0 = 0.8121775 - !A1 = 4.122E+15 - !A2 = -0.594909 - !A3 = 0.0559581 - Num = 0.8121775 * EXP( -X / 4.122E+15 ) - 0.594909 * EXP( -X / 0.0559581 ) ! was Num = BETA4(X,A0,A1,A2,A3) - Den = 0.72535 - 0.0256291 * X - fvr_ol = 3.0 * (Num / Den) - fvr_ol = (p%met%ZI / 1600.0) * fvr_ol - - Num = 6.05669 * EXP(-0.97418 * X) - Den = 3.418386 + 9.58012 / (1.0 + EXP( -(X - 0.0480283) / (-0.022657) )) - fwr_ol = 0.9 * (Num / Den) - - ! Unstable Wake Range Scaling for v-component only - - Num = 0.247754 + 0.16703142 * EXP(-X / 0.1172513) - Den = 0.464604 + 1.900294 / (1.0 + EXP( -(X + 0.928719) / (-0.317242) )) - Pvr_wk = 0.05 * (Num / Den) - - !A0 = 0.72435 - !A1 = 0.0436448 - !A2 = 0.08527 - Num = 0.72435 / (1.0 + EXP( -(X - 0.0436448) / 0.08527 )) ! was Num = BETA5(X,A0,A1,A2) - Den = 0.0171463 + 0.188081 / (1.0 + EXP( -(X + 0.711851) / 0.688910)) - fvr_wk = 3.0 * (Num / Den) - - HtZI = Ht / p%met%ZI - HtZI2 = (1.0 - HtZI)**2 - ZInL = ( p%met%ZI / (-p%met%L) )**Exp2 - UDen = 1.0 + 15.0 * HtZI - VDen = 1.0 + 2.8 * HtZI - UDen2 = HtZI2 / UDen**Exp2 - VDen2 = HtZI2 / VDen**Exp2 - - DO I = 1,p%grid%NumFreq - - ! Calculate f,fi,fru,frv - - F = p%grid%Freq(I)*Ht / Ucmp - Fi = p%grid%Freq(I)*p%met%ZI / Ucmp - Fw = SQRT( (F**2 + (0.3*HtZI**2)) / (F**2 + 0.0225) ) - - Ustar2F = Ustar2 / p%grid%Freq(I) - - ! CALCULATE UNSTABLE LONGITUDINAL SPECTRAL COMPONENT, nSu(n)/(u*)^2, then multiply by (u*)^2/n - - ! No identifiable wake contribution was found in u-component - - X = Fi / fur_ol - Ps_l = ( (0.5*X) / (1.0 + 2.2 * X**Exp1) ) * ZInL - Ps_l = ABS(Ps_l*Pur_ol) - - X = F / (UDen * fur_oh) - Ps_h = ( (105.0 * X) / (1.0 + 33.0 * X)**Exp1 ) * UDen2 - Ps_h = Ps_h * Pur_oh - Spec(I,1) = ( Ps_l + Ps_h ) * Ustar2F - - ! CALCULATE UNSTABLE CROSSWIND SPECTRAL COMPONENT, nSv(n)/(u*)^2, then multiply by (u*)^2/n - - X = Fi / fvr_ol - Ps_l = ( (0.95*X) / (1.0 + 2.0*X)**Exp1 ) * ZInL -! Ps_l = ABS(Psv_l)*Pvr_ol - - X = F / (VDen * fvr_oh) - Ps_h = ( (17.0 * X) / (1.0 + 9.5*X)**Exp1 ) * VDen2 -! Ps_h = Ps_h*Pvr_oh - - ! Wake contribution for v-component only - X = F / (VDen * fvr_wk) - Ps_wk = ( (17.0 * X) / (1.0 + 9.5 * X)**Exp1 ) * VDen2 - Ps_wk = Ps_wk*Pvr_wk - Spec(I,2) = ( Ps_l + Ps_h + Ps_wk ) * Ustar2F - - ! CALCULATE UNSTABLE VERTICAL SPECTRAL COMPONENT, nSw(n)/(u*)^2, then multiply by (u*)^2/n - - ! No identifiable wake contribution was found in w-component - - X = Fi / fwr_ol - Ps_l = Fw*( (0.95 * X) / (1.0 + 2.0 * X)**Exp1 ) * ZInL - Ps_l = ABS(Ps_l)*Pwr_ol - - X = F / fwr_oh - Ps_h = ( (2.0 * X) / (1.0 + 5.3 * X**Exp1) ) * HtZI2 - Ps_h = Ps_h*Pwr_oh - - Spec(I,3) = ( Ps_l + Ps_h ) * Ustar2F - - ENDDO - -ELSE ! ZL >= 0 - - ! BEGIN STABLE FLOW LOOP... - - ! Get Stable spectral peaks - - ! Stable high-frequency (wake) range scaling... - - X = MIN( p%met%ZL, ZL_MaxObs ) - - Num = 0.149471 + 0.028528 * & - EXP( -EXP( -( (X - 0.003580) / 0.0018863 ) ) - ( (X - 0.0035802) / 0.0018863) + 1.0) - Den = 1.563166 * EXP(1.137965 * X) - Pur_oh = 0.35 * (Num / Den) - - A0 = 2.66666062 - A1 = 0.0034082 - A2 = 0.0229827 - Num = Beta3(X, A0, A1, A2) - A0 = 33.942268 - A1 = 0.0160732 - A2 = -0.008654 - A3 = 0.0053586 - Num = Num + Beta1(X, A0, A1, A2, A3) - Num = 1.0 / Num - Den = 0.9170783 * EXP(1.152393 * X) - Pvr_oh = 2.25 * (Num / Den) - - A0 = 0.1990569 - A1 = 0.0286048 - A2 = 0.006751 - Num = Beta3(X, A0, A1, A2) - A0 = 0.0435354 - A1 = 0.0599214 - A2 = 0.0520877 - Num = Num + Beta2(X, A0, A1, A2) - Den = 0.539112 * EXP(1.124104 * X) - Pwr_oh = 0.9 * (Num / Den) - - tmp = -(X - 0.037003738) / 0.01612278 - Num = 0.764910145 + 0.654370025 * EXP( -EXP(tmp) + tmp + 1.0 ) - Den = 0.045 + 0.209305 * X - fur_oh = Num / Den - - A0 = 0.5491507 - A1 = 0.0099211 - A2 = 0.0044011 - Num = Beta3(X, A0, A1, A2) - A0 = 0.0244484 - A1 = 0.0139515 - A2 = 0.0109543 - Num = Num + Beta2(X, A0, A1, A2) - Den = 0.160 + 0.7496606 * X - fvr_oh = 0.5 * (Num / Den) - - Num = 0.391962642 + 0.546722344*EXP( -0.5* ( (X - 0.023188588) / 0.018447575)**2 ) - Den = 0.350 + 1.6431833 * X - fwr_oh = 2.0 * (Num / Den) - - ! Stable low-frequency range scaling ... - - Num = 0.894383 + (1.55915 * X)**3.111778 - Den = 1.563317 * EXP(1.137965 * X) - Pur_ol = 0.9 * (Num / Den) - - Num = 0.747514 + (1.57011 * X)**1.681581 - Den = 0.910783 * EXP(1.1523931 * X) - Pvr_ol = 0.60 * (Num / Den - 1.75 * X) - - Num = 0.376008 * EXP(1.4807733* X) - Den = 0.539112 * EXP(1.124104 * X) - Pwr_ol = 0.6 * (Num / Den - 2.0 * X) - - Num = 0.023450 + (0.3088194 * X)**1.24710 - Den = 0.045 + 0.209305 * X - fur_ol = 1.5 * (Num / Den - X) - fur_ol = MAX( fur_ol, REAL( 0.1,ReKi ) ) ! We divide by this number so it should not get too small. - - Num = 0.051616 + (0.8950263 * X)**1.37514 - Den = 0.160 + 0.749661 * X - fvr_ol = 0.5 * (Num / Den) - - Num = 0.250375 - 0.690491 * X + 2.4329342 * X**2 - Den = 0.350 + 1.6431833 * X - fwr_ol = Num / Den - - ! Calculate smooth terrain scaling functions - - phiE = (1.0 + 2.5 * X**0.6)**Exp3 - phiM = 1.0 + 4.7 * X - q = phiM - - tmp = (phiE / q)**Exp2 - - DO I = 1,p%grid%NumFreq - - F = p%grid%Freq(I) * Ht / Ucmp ! Reduced frequency - - Fq = F / q - Ustar2F = Ustar2 / p%grid%Freq(I) - - ! CALCULATE NEUTRAL/STABLE LONGITUDINAL SPECTRAL COMPONENT, nSu(n)/(u*)^2, then multiply by (u*)^2/n - - X = Fq / fur_ol - Ps_l = ( (79.0 * X) / (1.0 + 263.0 * X**Exp1) ) * tmp - Ps_l = ABS(Ps_l * Pur_ol) - - X = Fq / fur_oh - Ps_h = ( (79.0 * X) / (1.0 + 263.0 * X**Exp1) ) * tmp - Ps_h = Ps_h * Pur_oh - - Spec(I,1) = (Ps_l + Ps_h) * Ustar2F - - ! CALCULATE NEUTRAL/STABLE CROSSWIND SPECTRAL COMPONENT, nSv(n)/(u*)^2, then multiply by (u*)^2/n - - X = Fq / fvr_ol - Ps_l = ( (13.0 * X) / (1.0 + 32.0 * X**Exp1) ) * tmp - Ps_l = ABS(Ps_l * Pvr_ol) - - X = Fq / fvr_oh - Ps_h = ( (13.0 * X) / (1.0 + 32.0 * X**Exp1) ) * tmp - Ps_h = Ps_h * Pvr_oh - - Spec(I,2) = (Ps_h + Ps_l) * Ustar2F - - ! CALCULATE NEUTRAL/STABLE VERTICAL SPECTRAL COMPONENT, nSw(n)/(u*)^2, then multiply by (u*)^2/n - - X = Fq / fwr_ol - Ps_l = ( (3.5 * X) / (1.0 + 8.6 * X**Exp1) ) * tmp - Ps_l = ABS(Ps_l * Pwr_ol) - - X = Fq / fwr_oh - Ps_h = ( (3.5 * X) / (1.0 + 8.6 * X**Exp1) ) * tmp - Ps_h = Ps_h * Pwr_oh - - Spec(I,3) = (Ps_l + Ps_h) * Ustar2F - - ENDDO - -ENDIF ! ZL < 0 - -RETURN - - -CONTAINS - !======================================================================= - FUNCTION Beta1( X, A0, A1, A2, A3 ) - - ! This function is used in the calculation of the Wind Farm models' PSD - - IMPLICIT NONE - - REAL(ReKi), INTENT(IN) :: X ! Function input - REAL(ReKi), INTENT(IN) :: A0 ! Function input - REAL(ReKi), INTENT(IN) :: A1 ! Function input - REAL(ReKi), INTENT(IN) :: A2 ! Function input - REAL(ReKi), INTENT(IN) :: A3 ! Function input - REAL(ReKi) :: Beta1 ! Function result - - REAL(ReKi) :: tmp1 ! temporary variable - REAL(ReKi) :: tmp2 ! temporary variable - - - tmp1 = X - A1 - tmp2 = A2 / 2.0 - - Beta1 = A0 / (1.0 + EXP( ( tmp1 + tmp2 ) / (-A3) )) * & - (1.0 - ( 1.0 / (1.0 + EXP( ( tmp1 - tmp2 ) / (-A3) )) )) - - - RETURN - END FUNCTION Beta1 - !======================================================================= - FUNCTION BETA2(X,A0,A1,A2) - - ! This function is used in the calculation of the Wind Farm models' PSD - - IMPLICIT NONE - - REAL(ReKi),INTENT(IN) :: X ! Function input - REAL(ReKi),INTENT(IN) :: A0 ! Function input - REAL(ReKi),INTENT(IN) :: A1 ! Function input - REAL(ReKi),INTENT(IN) :: A2 ! Function input - REAL(ReKi) :: Beta2 ! Function output - - - Beta2 = ( A0 / ( 2.50663 * A2 ) ) * EXP( -0.5 * ( (X-A1) / A2 )**2 ) - - RETURN - END FUNCTION Beta2 - !======================================================================= - FUNCTION BETA3(X,A0,A1,A2) - - ! This function is used in the calculation of the Wind Farm models' PSD - - IMPLICIT NONE - - REAL(ReKi) :: Beta3 ! Function output - REAL(ReKi),INTENT(IN) :: X ! Function input - REAL(ReKi),INTENT(IN) :: A0 ! Function input - REAL(ReKi),INTENT(IN) :: A1 ! Function input - REAL(ReKi),INTENT(IN) :: A2 ! Function input - - Beta3 = 0.5 * A0 * ( 1.0 + Beta10( (X-A1) / (1.414*A2) ) ) - - RETURN - END FUNCTION Beta3 - !======================================================================= - FUNCTION Beta4(X,A0,A1,A2,A3) - - ! This function is used in the calculation of the Wind Farm models' PSD - - IMPLICIT NONE - - REAL(ReKi) :: Beta4 ! Function output - REAL(ReKi),INTENT(IN) :: X ! Function input - REAL(ReKi),INTENT(IN) :: A0 ! Function input - REAL(ReKi),INTENT(IN) :: A1 ! Function input - REAL(ReKi),INTENT(IN) :: A2 ! Function input - REAL(ReKi),INTENT(IN) :: A3 ! Function input - - - Beta4 = A0 * EXP( -X/A1 ) + A2 * EXP( -X/A3 ) - - RETURN - END FUNCTION Beta4 - !======================================================================= - FUNCTION Beta5(X,A0,A1,A2) - - ! This function is used in the calculation of the Wind Farm models' PSD - - IMPLICIT NONE - - REAL(ReKi) :: Beta5 ! Function output - REAL(ReKi),INTENT(IN) :: X ! Function input - REAL(ReKi),INTENT(IN) :: A0 ! Function input - REAL(ReKi),INTENT(IN) :: A1 ! Function input - REAL(ReKi),INTENT(IN) :: A2 ! Function input - - Beta5 = A0 / ( 1.0 + EXP( -(X-A1) / A2 ) ) - - RETURN - END FUNCTION Beta5 - !======================================================================= - FUNCTION Beta6(A,X) - - ! This function is used in the calculation of the Wind Farm models' PSD - - IMPLICIT NONE - - REAL(ReKi) :: Beta6 ! Function output - REAL(ReKi),INTENT(IN) :: A ! Function input - REAL(ReKi),INTENT(IN) :: X ! Function input - - IF ( ( X < 0.0 ) .OR. ( A <= 0.0 ) ) THEN - CALL SetErrStat( ErrID_Fatal, 'Invalid X or A inputs.', ErrStat, ErrMsg, 'Beta6' ) - RETURN - ENDIF - - IF ( X < A + 1.0 ) THEN - CALL Beta8( Beta6, A, X ) - ! Beta6 = GAMSER - ELSE - CALL Beta7( Beta6, A, X) - Beta6 = 1.0 - Beta6 - ENDIF - - RETURN - END FUNCTION Beta6 - !======================================================================= - SUBROUTINE Beta7(GAMMCF, A, X ) - - ! This subroutine is used in the calculation of the Wind Farm models' PSD - - - IMPLICIT NONE - - REAL(ReKi),INTENT(OUT) :: GAMMCF ! Subroutine Output - REAL(ReKi),INTENT(IN) :: A ! Subroutine Input - REAL(ReKi),INTENT(IN) :: X ! Subroutine Input - - REAL(ReKi) :: GLN - REAL(ReKi) :: g - REAL(ReKi) :: gOld - REAL(ReKi) :: A0 - REAL(ReKi) :: A1 - REAL(ReKi) :: B0 - REAL(ReKi) :: B1 - REAL(ReKi) :: FAC - REAL(ReKi) :: AN - REAL(ReKi) :: ANA - REAL(ReKi) :: ANF - - REAL(ReKi), PARAMETER :: eps = 3.0E-7 - REAL(ReKi), PARAMETER :: ITmax = 100.0 - - LOGICAL :: continueIT - - - IF ( X <= 0.0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Input variable X must be positive.', ErrStat, ErrMsg, 'Beta7' ) - RETURN - ENDIF - - gOld = 0.0 - - A0 = 1.0 - A1 = X - B0 = 0.0 - B1 = 1.0 - FAC = 1.0 - - AN = 0.0 - continueIT = .TRUE. - - DO WHILE ( ( AN < ITmax ) .AND. continueIT ) - - AN = AN + 1.0 - - ANA = AN - A - A0 = ( A1 + A0*ANA )*FAC - B0 = ( B1 + B0*ANA )*FAC - - ANF = AN*FAC - A1 = X*A0 + ANF*A1 - B1 = X*B0 + ANF*B1 - - IF ( A1 /= 0.0 ) THEN - FAC = 1.0 / A1 - g = B1*FAC - - IF( ABS( ( g - gOld ) / g ) < eps) continueIT = .FALSE. - - gOld = g - ENDIF - - ENDDO - - IF ( continueIT ) THEN - CALL SetErrStat( ErrID_Fatal, 'Value of A is too large or ITMAX is too small.', ErrStat, ErrMsg, 'Beta7' ) - RETURN - ENDIF - - GLN = Beta9( A ) - IF (ErrStat >= AbortErrLev) RETURN - - GAMMCF = EXP( -X + A*LOG( X ) - GLN ) * G - - RETURN - END SUBROUTINE Beta7 - !======================================================================= - SUBROUTINE Beta8(GAMSER,A,X) - - ! This subroutine is used in the calculation of the Wind Farm models' PSD - - IMPLICIT NONE - - REAL(ReKi),INTENT(OUT) :: GAMSER ! Subroutine Output - REAL(ReKi),INTENT(IN) :: A ! Subroutine Input - REAL(ReKi),INTENT(IN) :: X ! Subroutine Input - - REAL(ReKi) :: GLN - REAL(ReKi) :: AP - REAL(ReKi) :: Sum - REAL(ReKi) :: del - - REAL(ReKi),PARAMETER :: eps = 3.0E-7 ! Tolerance - INTEGER,PARAMETER :: ITmax = 100 ! Maximum loop iterations - - - INTEGER :: N ! Loop counter - - LOGICAL :: continueIT - - - IF ( ( X > 0.0 ) .AND. ( A /= 0.0 ) ) THEN - continueIT = .TRUE. - - AP = A - Sum = 1.0 / A - del = Sum - - N = 1 - - DO WHILE ( ( N <= ITmax ) .AND. ( continueIT ) ) - AP = AP + 1.0 - del = del * X / AP - Sum = Sum + del - - IF( ABS(del) < ABS(Sum) * eps ) continueIT = .FALSE. - - N = N + 1 - ENDDO - - IF ( continueIT ) THEN - CALL SetErrStat( ErrID_Fatal, 'Value of A is too large or ITMAX is too small.', ErrStat, ErrMsg, 'BETA8' ) - RETURN - ENDIF - - GLN = Beta9( A ) - IF (ErrStat >= AbortErrLev) RETURN - - GAMSER = Sum * EXP( -X + A * LOG(X) - GLN) - - ELSEIF ( X == 0.0 ) THEN - - GAMSER = 0.0 - - ELSE ! ( X < 0.0 ) - CALL SetErrStat( ErrID_Fatal, 'Invalid input.', ErrStat, ErrMsg, 'BETA8' ) - RETURN - ENDIF - - RETURN - END SUBROUTINE Beta8 - !======================================================================= - FUNCTION Beta9(XX) - - ! This function is used in the calculation of the Wind Farm models' PSD - - IMPLICIT NONE - - REAL(ReKi) :: Beta9 ! Output value - REAL(ReKi),INTENT(IN) :: XX ! Input value - - REAL(ReKi) :: X - REAL(ReKi) :: Tmp - REAL(ReKi) :: SER - - REAL(ReKi), PARAMETER :: Cof(6) = (/ 76.18009173, -86.50532033, 24.01409822, -1.231739516, 0.120858003E-2, -0.536382E-5 /) - REAL(ReKi), PARAMETER :: STP = 2.50662827465 - - INTEGER :: J ! Loop counter - - IF ( XX <= -4.5 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Input variable XX must be larger than -4.5.', ErrStat, ErrMsg, 'Beta9' ) - RETURN - ENDIF - - - X = XX - 1.0 - Tmp = X + 5.5 - Tmp = ( X + 0.5 ) * LOG( Tmp ) - Tmp - - SER = 1.0 - - DO J = 1,6 - X = X + 1.0 - SER = SER + Cof(J) / X - ENDDO - - - IF ( SER <= 0.0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Variable SER must be larger than 0.0.', ErrStat, ErrMsg, 'Beta9' ) - RETURN - ENDIF - - - Beta9 = Tmp + LOG( STP*SER ) - - RETURN - END FUNCTION Beta9 - !======================================================================= - FUNCTION Beta10(X) - - ! This function is used in the calculation of the Wind Farm models' PSD - - IMPLICIT NONE - - REAL(ReKi) :: Beta10 - REAL(ReKi), INTENT(IN) :: X - REAL(ReKi), PARAMETER :: Tmp = 0.5 - - - IF ( X < 0.0 ) THEN - Beta10 = -Beta6(Tmp, X**2) - ELSE - Beta10 = Beta6(Tmp, X**2) - ENDIF - - RETURN - END FUNCTION Beta10 - !======================================================================= -END SUBROUTINE Spec_WF_DW - -!======================================================================= -END MODULE TS_VelocitySpectra diff --git a/OpenFAST/modules/version/CMakeLists.txt b/OpenFAST/modules/version/CMakeLists.txt deleted file mode 100644 index 1a1b0af02..000000000 --- a/OpenFAST/modules/version/CMakeLists.txt +++ /dev/null @@ -1,36 +0,0 @@ -# -# Copyright 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. -# - -# Allow the git-version information to be set externally for the -# package manager distributions (homebrew, conda, apt) that download -# the tarball source code rather than clone with git. -if( DEFINED GIT_DESCRIBE ) - message( WARNING - "Version information has been set as a CMake flag. This should only used when the git-version cannot be set automatically." - ) -else() - include(GetGitRevisionDescription) - git_describe(GIT_DESCRIBE) -endif() -add_definitions(-DGIT_VERSION_INFO="${GIT_DESCRIBE}") - -add_library(versioninfolib src/VersionInfo.f90) - -install(TARGETS versioninfolib - EXPORT "${CMAKE_PROJECT_NAME}Libraries" - RUNTIME DESTINATION bin - LIBRARY DESTINATION lib - ARCHIVE DESTINATION lib) diff --git a/OpenFAST/modules/version/README.md b/OpenFAST/modules/version/README.md deleted file mode 100644 index f2efaabd7..000000000 --- a/OpenFAST/modules/version/README.md +++ /dev/null @@ -1,20 +0,0 @@ -# Version Module - -## Overview -The Version module provides all driver and glue codes with the version based -on the git status. OpenFAST follows [semantic versioning](https://semver.org). -In summary, this means that with a version number as MAJOR.MINOR.PATCH, the -components will be incremented as follows: - -- MAJOR version when introducing incompatible API changes, -- MINOR version when adding functionality in a backwards-compatible manner, and -- PATCH version when making backwards-compatible bug fixes. - -For example, ``OpenFAST-v1.0.0-123-gabcd1234-dirty`` describes OpenFAST as: - -- v1.0.0 is the MAJOR.MINOR.PATCH numbering system and corresponds to a tagged - commit made by NREL on GitHub -- 123-g is the number of additional commits after the most recent tag for a - build [the ``-g`` is for ``git``] -- abcd1234 is the first 8 characters of the current commit hash -- dirty denotes that local changes have been made but not committed diff --git a/OpenFAST/modules/version/src/VersionInfo.f90 b/OpenFAST/modules/version/src/VersionInfo.f90 deleted file mode 100644 index 27dbc73e7..000000000 --- a/OpenFAST/modules/version/src/VersionInfo.f90 +++ /dev/null @@ -1,45 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2015-2016 National Renewable Energy Laboratory -! Copyright (C) 2016-2017 Envision Energy USA, LTD -! -! This file is part of the NWTC Subroutine Library. -! -! 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. -! -!********************************************************************************************************************************** -MODULE VersionInfo - - implicit none - -contains - -FUNCTION QueryGitVersion() - - CHARACTER(200) :: QueryGitVersion - -! The Visual Studio project sets the path for where to find the header file with version info -#ifdef GIT_INCLUDE_FILE -#include GIT_INCLUDE_FILE -#endif - -#ifdef GIT_VERSION_INFO - QueryGitVersion = GIT_VERSION_INFO -#else - QueryGitVersion = 'unversioned' -#endif - - RETURN -END FUNCTION QueryGitVersion - -END MODULE diff --git a/OpenFAST/modules/wakedynamics/CMakeLists.txt b/OpenFAST/modules/wakedynamics/CMakeLists.txt deleted file mode 100644 index a298eec33..000000000 --- a/OpenFAST/modules/wakedynamics/CMakeLists.txt +++ /dev/null @@ -1,33 +0,0 @@ -# -# Copyright 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. -# -if (GENERATE_TYPES) - generate_f90_types(src/WakeDynamics_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/WakeDynamics_Types.f90 -noextrap) -endif() - -set(WD_LIBS_SOURCES - src/WakeDynamics.f90 - #src/WakeDynamics_IO.f90 - src/WakeDynamics_Types.f90 - ) - -add_library(wdlib ${WD_LIBS_SOURCES}) -target_link_libraries(wdlib nwtclibs) - -install(TARGETS wdlib - EXPORT "${CMAKE_PROJECT_NAME}Libraries" - RUNTIME DESTINATION bin - LIBRARY DESTINATION lib - ARCHIVE DESTINATION lib) diff --git a/OpenFAST/modules/wakedynamics/src/WakeDynamics.f90 b/OpenFAST/modules/wakedynamics/src/WakeDynamics.f90 deleted file mode 100644 index 289d9d124..000000000 --- a/OpenFAST/modules/wakedynamics/src/WakeDynamics.f90 +++ /dev/null @@ -1,1105 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2015-2016 National Renewable Energy Laboratory -! -! This file is part of WakeDynamics. -! -! 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. -! -!********************************************************************************************************************************** -! File last committed: $Date$ -! (File) Revision #: $Rev$ -! URL: $HeadURL$ -!********************************************************************************************************************************** -!> WakeDynamics is a time-domain module for modeling wake dynamics of one or more horizontal-axis wind turbines. -module WakeDynamics - - use NWTC_Library - use WakeDynamics_Types - - implicit none - - private - - type(ProgDesc), parameter :: WD_Ver = ProgDesc( 'WakeDynamics', '', '' ) - character(*), parameter :: WD_Nickname = 'WD' - - ! ..... Public Subroutines ................................................................................................... - - public :: WD_Init ! Initialization routine - public :: WD_End ! Ending routine (includes clean up) - public :: WD_UpdateStates ! Loose coupling routine for solving for constraint states, integrating - ! continuous states, and updating discrete states - public :: WD_CalcOutput ! Routine for computing outputs - public :: WD_CalcConstrStateResidual ! Tight coupling routine for returning the constraint state residual - - contains - -function WD_Interp ( yVal, xArr, yArr ) - real(ReKi) :: WD_Interp - real(ReKi), intent(in ) :: yVal - real(ReKi), intent(in ) :: xArr(:) - real(ReKi), intent(in ) :: yArr(:) - - integer(IntKi) :: i, nPts - real(ReKi) :: y1,y2,x1,x2,dy - - - nPts = size(xArr) - WD_Interp = 0.0_ReKi - y2 = yArr(nPts) - yVal - x2 = xArr(nPts) - do i=nPts-1,1,-1 - y1 = yArr(i) - yVal - x1 = xArr(i) - if( nint( sign(1.0_ReKi, y1) ) /= nint( sign(1.0_ReKi, y2) ) ) then - - dy = y2-y1 - if (EqualRealNos(dy,0.0_ReKi) ) then - WD_Interp = x2 - else - WD_Interp = (x2-x1)*(yVal-y1)/(dy) + x1 - end if - exit - - end if - - y2 = y1 - x2 = x1 - end do - -end function WD_Interp -!---------------------------------------------------------------------------------------------------------------------------------- -!> This function sets the nacelle-yaw-related directional term for the yaw correction deflection calculations -!! -function GetYawCorrection(yawErr, xhat_disk, dx, p, errStat, errMsg) - real(ReKi), dimension(3) :: GetYawCorrection - real(ReKi), intent(in ) :: yawErr !< Nacelle-yaw error at the wake planes - real(ReKi), intent(in ) :: xhat_disk(3) !< Orientation of rotor centerline, normal to disk - real(ReKi), intent(in ) :: dx !< Dot_product(xhat_plane,V_plane)*DT_low - type(WD_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 - - real(ReKi) :: xydisk(3),yxdisk(3),yydisk(3),xxdisk(3),xydisknorm - - errStat = ErrID_None - errMsg = '' - - xydisk = (/0.0_ReKi, xhat_disk(1), 0.0_ReKi/) - yxdisk = (/xhat_disk(2), 0.0_ReKi, 0.0_ReKi/) - yydisk = (/0.0_ReKi, xhat_disk(2), 0.0_ReKi/) - xxdisk = (/xhat_disk(1), 0.0_ReKi, 0.0_ReKi/) - xydisknorm = TwoNorm(xxdisk + yydisk) - - if (EqualRealNos(xydisknorm,0.0_ReKi)) then - ! TEST: E3 - call SetErrStat( ErrID_Fatal, 'Orientation of the rotor centerline at the rotor plane is directed vertically upward or downward, whereby the nacelle-yaw error and horizontal wake-deflection correction is undefined.', errStat, errMsg, 'GetYawCorrectionTermA' ) - return - end if - - if (EqualRealNos(dx,0.0_ReKi)) then - GetYawCorrection = ( p%C_HWkDfl_O + p%C_HWkDfl_OY*YawErr ) * ( ( xydisk - yxdisk ) / (xydisknorm) ) - else - GetYawCorrection = ( p%C_HWkDfl_x + p%C_HWkDfl_xY*yawErr ) * dx * ( ( xydisk - yxdisk ) / (xydisknorm) ) - end if - -end function GetYawCorrection - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine calculates the eddy viscosity filter functions, prepresenting the delay in the turbulent stress generated by -!! ambient turbulence or the development of turbulent stresses generated by the shear layer -real(ReKi) function EddyFilter(x_plane, D_rotor, C_Dmin, C_Dmax, C_Fmin, C_Exp) - - real(ReKi), intent(in ) :: x_plane !< Downwind distance from rotor to each wake plane (m) - real(ReKi), intent(in ) :: D_rotor !< Rotor diameter (m) - real(ReKi), intent(in ) :: C_Dmin !< Calibrated parameter defining the transitional diameter fraction between the minimum and exponential regions - real(ReKi), intent(in ) :: C_Dmax !< Calibrated parameter defining the transitional diameter fraction between the exponential and maximum regions - real(ReKi), intent(in ) :: C_Fmin !< Calibrated parameter defining the functional value in the minimum region - real(ReKi), intent(in ) :: C_Exp !< Calibrated parameter defining the exponent in the exponential region - - - ! Any errors due to invalid choices of the calibrated parameters have been raised when this module was initialized - - if ( x_plane <= C_Dmin*D_rotor ) then - EddyFilter = C_Fmin - else if (x_plane >= C_Dmax*D_rotor) then - EddyFilter = 1_ReKi - else - EddyFilter = C_Fmin + (1_ReKi-C_Fmin)*( ( (x_plane/D_rotor) - C_DMin ) / (C_Dmax-C_Dmin) )**C_Exp - end if - - -end function EddyFilter - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine calculates the wake diameter at a wake plane, based on one of four models -real(ReKi) function WakeDiam( Mod_WakeDiam, nr, dr, rArr, Vx_wake, Vx_wind_disk, D_rotor, C_WakeDiam) - - integer(intKi), intent(in ) :: Mod_WakeDiam !< Wake diameter calculation model [ 1=Rotor diameter, 2=Velocity, 3=Mass flux, 4=Momentum flux] - integer(intKi), intent(in ) :: nr !< Number of radii in the radial finite-difference grid - real(ReKi), intent(in ) :: dr !< Radial increment of radial finite-difference grid (m) - real(ReKi), intent(in ) :: rArr(0:) !< Discretization of radial finite-difference grid (m) - real(ReKi), intent(in ) :: Vx_wake(0:) !< Axial wake velocity deficit at a wake plane, distributed radially (m/s) - real(ReKi), intent(in ) :: Vx_wind_disk !< Rotor-disk-averaged ambient wind speed, normal to planes (m/s) - real(ReKi), intent(in ) :: D_rotor !< Rotor diameter (m) - real(ReKi), intent(in ) :: C_WakeDiam !< Calibrated parameter for wake diameter calculation - - integer(IntKi) :: ILo - real(ReKi) :: m(0:nr-1) - integer(IntKi) :: i - ILo = 0 - - ! Any errors due to invalid values of dr and C_WakeDiam have been raised when this module was initialized - - select case ( Mod_WakeDiam ) - case (WakeDiamMod_RotDiam) - - WakeDiam = D_rotor - - case (WakeDiamMod_Velocity) - - ! Ensure the wake diameter is at least as large as the rotor diameter - - WakeDiam = max(D_rotor, 2.0_ReKi*WD_Interp( (C_WakeDiam-1_ReKi)*Vx_wind_disk, rArr, Vx_wake ) ) - - case (WakeDiamMod_MassFlux) - - m(0) = 0.0 - do i = 1,nr-1 - m(i) = m(i-1) + pi*dr*(Vx_wake(i)*rArr(i) + Vx_wake(i-1)*rArr(i-1)) - end do - - WakeDiam = max(D_rotor, 2.0_ReKi*WD_Interp( C_WakeDiam*m(nr-1), rArr, m ) ) - - case (WakeDiamMod_MtmFlux) - - m(0) = 0.0 - do i = 1,nr-1 - m(i) = m(i-1) + pi*dr*( (Vx_wake(i)**2)*rArr(i) + (Vx_wake(i-1)**2)*rArr(i-1)) - end do - - WakeDiam = max(D_rotor, 2.0_ReKi*WD_Interp( C_WakeDiam*m(nr-1), rArr, m ) ) - - end select - - -end function WakeDiam - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine computes the near wake correction : Vx_wake -subroutine NearWakeCorrection( Ct_azavg_filt, Vx_rel_disk_filt, p, m, Vx_wake, D_rotor, errStat, errMsg ) - real(ReKi), intent(in ) :: Ct_azavg_filt(0:) !< Time-filtered azimuthally averaged thrust force coefficient (normal to disk), distributed radially - real(ReKi), intent(in ) :: D_rotor !< Rotor diameter - real(ReKi), intent(in ) :: Vx_rel_disk_filt !< Time-filtered rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk - type(WD_ParameterType), intent(in ) :: p !< Parameters - type(WD_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables - real(ReKi), intent(inout) :: Vx_wake(0:) !< Axial wake velocity deficit at first plane - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if errStat /= ErrID_None - real(ReKi) :: alpha - real(ReKi) :: Ct_avg ! Rotor-disk averaged Ct - integer(IntKi) :: j, errStat2 - character(*), parameter :: RoutineName = 'NearWakeCorrection' - real(ReKi), parameter :: Ct_low = 0.96_ReKi, Ct_high = 1.10_ReKi ! Limits for blending - - errStat = ErrID_None - errMsg = '' - - ! Computing average Ct = \int r Ct dr / \int r dr = 2/R^2 \int r Ct dr using trapz - ! NOTE: r goes beyond the rotor (works since Ct=0 beyond that) - Ct_avg = 0.0_ReKi - do j=1,p%NumRadii-1 - Ct_avg = Ct_avg + 0.5_ReKi * (p%r(j) * Ct_azavg_filt(j) + p%r(j-1) * Ct_azavg_filt(j-1)) * p%dr - enddo - Ct_avg = 8.0_ReKi*Ct_avg/(D_rotor*D_rotor) - - if (Ct_avg > 2.0_ReKi ) then - ! THROW ERROR because we are in the prop-brake region - ! TEST: E5 - call SetErrStat(ErrID_FATAL, 'Wake model is not valid in the propeller-brake region, i.e., Ct > 2.0.', errStat, errMsg, RoutineName) - return - - else if ( Ct_avg < Ct_low ) then - ! Low Ct region - call Vx_low_Ct(Vx_wake, p%r) ! Compute Vx_wake at p%r - - else if ( Ct_avg > Ct_high ) then - ! high Ct region - call Vx_high_Ct(Vx_wake, p%r, Ct_avg) ! Compute Vx_wake at p%r - ! m%r_wake = p%r ! No distinction between r_wake and r, r_wake is just a temp variable anyway - - else - ! Blending Ct region between Ct_low and Ct_high - call Vx_low_Ct (Vx_wake, p%r) ! Evaluate Vx_wake (Ct_low) at p%r - call Vx_high_Ct(m%Vx_high, p%r, Ct_avg) ! Evaluate Vx_high (Ct_high) at p%r - - alpha = 1.0_ReKi - (Ct_avg - Ct_low) / (Ct_high-Ct_low) ! linear blending coefficient - do j=0,p%NumRadii-1 - Vx_wake(j) = alpha*Vx_wake(j)+(1.0_ReKi-alpha)*m%Vx_high(j) ! Blended CT velocity - end do - end if - -contains - - !> Compute the induced velocity distribution in the wake for low thrust region - subroutine Vx_low_Ct(Vx, r_eval) - real(ReKi), dimension(0:), intent(out) :: Vx !< Wake induced velocity (<0) - real(ReKi), dimension(0:), intent(in ) :: r_eval !< Radial position where velocity is to be evaluated - integer(IntKi) :: ILo ! index for interpolation - real(ReKi) :: a_interp - - ! compute r_wake and m%a using Ct_azavg_filt - m%r_wake(0) = 0.0_ReKi - do j=0,p%NumRadii-1 - ! NOTE: Ct clipped instead of (2.0_ReKi + 3.0_ReKi*sqrt(14.0_ReKi*Ct_azavg_filt(j)-12.0_ReKi))/14.0_ReKi - m%a(j) = 0.5_ReKi - 0.5_ReKi*sqrt( 1.0_ReKi-min(Ct_azavg_filt(j),24.0_ReKi/25.0_ReKi)) - if (j > 0) then - m%r_wake(j) = sqrt(m%r_wake(j-1)**2.0_ReKi + p%dr*( ((1.0_ReKi - m%a(j))*p%r(j)) / (1.0_ReKi-p%C_NearWake*m%a(j)) + ((1.0_ReKi - m%a(j-1))*p%r(j-1)) / (1.0_ReKi-p%C_NearWake*m%a(j-1)) ) ) - end if - end do - ! Use a and rw to determine Vx - Vx(0) = -Vx_rel_disk_filt*p%C_Nearwake*m%a(0) - ILo = 0 - do j=1,p%NumRadii-1 - ! given r_wake and m%a at p%dr increments, find value of m%a(r_wake) using interpolation - a_interp = InterpBin( r_eval(j), m%r_wake, m%a, ILo, p%NumRadii ) !( XVal, XAry, YAry, ILo, AryLen ) - Vx(j) = -Vx_rel_disk_filt*p%C_NearWake*a_interp !! Low CT velocity - end do - end subroutine Vx_low_Ct - - !> Compute the induced velocity distribution in the wake for high thrust region - subroutine Vx_high_Ct(Vx, r_eval, Ct_avg) - real(ReKi), dimension(0:), intent(out) :: Vx !< Wake induced velocity (<0) - real(ReKi), dimension(0:), intent(in ) :: r_eval !< Wake radial coordinate - real(ReKi), intent(in ) :: Ct_avg !< Rotor-disk averaged Ct - real(ReKi) :: mu, sigma ! Gaussian shape parameters for high thrust region - real(ReKi), parameter :: x_bar=4._ReKi ! dimensionless downstream distance used to tune the model - mu = (3._ReKi/(2._ReKi*Ct_avg*Ct_avg-1._ReKi) + 4._ReKi -0.5_ReKi*x_bar) /10._ReKi - sigma = D_rotor* (0.5_ReKi*Ct_avg + x_bar/(25._ReKi)) - do j=0,p%NumRadii-1 - Vx(j) = -Vx_rel_disk_filt*mu*exp(-r_eval(j)*r_eval(j)/(sigma*sigma)) !! High CT Velocity - end do - end subroutine Vx_high_Ct - -end subroutine NearWakeCorrection - - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine solves the tridiagonal linear system for x() using the Thomas algorithm -subroutine ThomasAlgorithm(nr, a, b, c, d, x, errStat, errMsg) - - integer(IntKi), intent(in ) :: nr !< Number of radii in the radial finite-difference grid - real(ReKi), intent(inout) :: a(0:) !< Sub diagonal - real(ReKi), intent(inout) :: b(0:) !< Main diagonal - real(ReKi), intent(inout) :: c(0:) !< Super diagonal - real(ReKi), intent(inout) :: d(0:) !< Right-hand side - real(ReKi), intent(inout) :: x(0:) !< Solution of the linear solve - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if errStat /= ErrID_None - real(ReKi) :: m - integer(IntKi) :: i - character(*), parameter :: RoutineName = 'ThomasAlgorithm' - - errStat = ErrID_None - errMsg = '' - - ! Assumes all arrays are the same length - - ! Check that tridiagonal matrix is not diagonally dominant - if ( abs(b(0)) <= abs(c(0)) ) then - ! TEST: E16 - call SetErrStat( ErrID_Fatal, 'Tridiagonal matrix is not diagonally dominant, i.e., abs(b(0)) <= abs(c(0)). Try reducing the FAST.Farm timestep.', errStat, errMsg, RoutineName ) - return - end if - do i = 1,nr-2 - if ( abs(b(i)) <= ( abs(a(i))+abs(c(i)) ) ) then - ! TEST: E17 - call SetErrStat( ErrID_Fatal, 'Tridiagonal matrix is not diagonally dominant, i.e., abs(b(i)) <= ( abs(a(i))+abs(c(i)) ). Try reducing the FAST.Farm timestep.', errStat, errMsg, RoutineName ) - return - end if - end do - if ( abs(b(nr-1)) <= abs(a(nr-1)) ) then - ! TEST: E18 - call SetErrStat( ErrID_Fatal, 'Tridiagonal matrix is not diagonally dominant, i.e., abs(b(nr-1)) <= abs(a(nr-1)). Try reducing the FAST.Farm timestep.', errStat, errMsg, RoutineName ) - return - end if - - do i = 1,nr-1 - m = -a(i)/b(i-1) - b(i) = b(i) + m*c(i-1) - d(i) = d(i) + m*d(i-1) - end do - - x(nr-1) = d(nr-1)/b(nr-1) - do i = nr-2,0, -1 - x(i) = ( d(i) - c(i)*x(i+1) ) / b(i) - end do - -end subroutine ThomasAlgorithm - -!---------------------------------------------------------------------------------------------------------------------------------- -!> 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 WD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, errStat, errMsg ) -!.................................................................................................................................. - - type(WD_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine - type(WD_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined - type(WD_ParameterType), intent( out) :: p !< Parameters - type(WD_ContinuousStateType), intent( out) :: x !< Initial continuous states - type(WD_DiscreteStateType), intent( out) :: xd !< Initial discrete states - type(WD_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states - type(WD_OtherStateType), intent( out) :: OtherState !< Initial other states - type(WD_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated; - !! only the output mesh is initialized) - type(WD_MiscVarType), intent( out) :: m !< Initial misc/optimization variables - real(DbKi), intent(in ) :: interval !< Coupling interval in seconds: the rate that - !! (1) WD_UpdateStates() is called in loose coupling & - !! (2) WD_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. - type(WD_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 - integer(IntKi) :: i ! loop counter - - integer(IntKi) :: errStat2 ! temporary error status of the operation - character(ErrMsgLen) :: errMsg2 ! temporary error message - character(*), parameter :: RoutineName = 'WD_Init' - - - ! Initialize variables for this routine - - errStat = ErrID_None - errMsg = "" - - ! Initialize the NWTC Subroutine Library - - call NWTC_Init( EchoLibVer=.FALSE. ) - - - ! Display the module information - - if (InitInp%TurbNum <= 1) call DispNVD( WD_Ver ) - - ! Validate the initialization inputs - call ValidateInitInputData( interval, InitInp, InitInp%InputFileData, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, errStat, errMsg, RoutineName ) - if (errStat >= AbortErrLev) return - - !............................................................................................ - ! Define parameters - !............................................................................................ - - - - ! set the rest of the parameters - p%DT_low = interval - p%NumPlanes = InitInp%InputFileData%NumPlanes - p%NumRadii = InitInp%InputFileData%NumRadii - p%dr = InitInp%InputFileData%dr - p%C_HWkDfl_O = InitInp%InputFileData%C_HWkDfl_O - p%C_HWkDfl_OY = InitInp%InputFileData%C_HWkDfl_OY - p%C_HWkDfl_x = InitInp%InputFileData%C_HWkDfl_x - p%C_HWkDfl_xY = InitInp%InputFileData%C_HWkDfl_xY - p%C_NearWake = InitInp%InputFileData%C_NearWake - p%C_vAmb_DMin = InitInp%InputFileData%C_vAmb_DMin - p%C_vAmb_DMax = InitInp%InputFileData%C_vAmb_DMax - p%C_vAmb_FMin = InitInp%InputFileData%C_vAmb_FMin - p%C_vAmb_Exp = InitInp%InputFileData%C_vAmb_Exp - p%C_vShr_DMin = InitInp%InputFileData%C_vShr_DMin - p%C_vShr_DMax = InitInp%InputFileData%C_vShr_DMax - p%C_vShr_FMin = InitInp%InputFileData%C_vShr_FMin - p%C_vShr_Exp = InitInp%InputFileData%C_vShr_Exp - p%k_vAmb = InitInp%InputFileData%k_vAmb - p%k_vShr = InitInp%InputFileData%k_vShr - p%Mod_WakeDiam = InitInp%InputFileData%Mod_WakeDiam - p%C_WakeDiam = InitInp%InputFileData%C_WakeDiam - - allocate( p%r(0:p%NumRadii-1),stat=errStat2) - if (errStat2 /= 0) then - call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for p%r.', errStat, errMsg, RoutineName ) - return - end if - - do i = 0,p%NumRadii-1 - p%r(i) = p%dr*i - end do - - p%filtParam = exp(-2.0_ReKi*pi*p%dt_low*InitInp%InputFileData%f_c) - p%oneMinusFiltParam = 1.0_ReKi - p%filtParam - !............................................................................................ - ! Define and initialize inputs here - !............................................................................................ - - allocate( u%V_plane (3,0:p%NumPlanes-1),stat=errStat2) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for u%V_plane.', errStat, errMsg, RoutineName ) - allocate( u%Ct_azavg ( 0:p%NumRadii-1 ),stat=errStat2) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for u%Ct_azavg.', errStat, errMsg, RoutineName ) - if (errStat /= ErrID_None) return - - - - - !............................................................................................ - ! Define outputs here - !............................................................................................ - - - - !............................................................................................ - ! Initialize states and misc vars : Note these are not the correct initializations because - ! that would require valid input data, which we do not have here. Instead we will check for - ! an firstPass flag on the miscVars and if it is false we will properly initialize these state - ! in CalcOutput or UpdateStates, as necessary. - !............................................................................................ - - allocate ( xd%xhat_plane (3, 0:p%NumPlanes-1) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for xd%xhat_plane.', errStat, errMsg, RoutineName ) - allocate ( xd%p_plane (3, 0:p%NumPlanes-1) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for xd%p_plane.', errStat, errMsg, RoutineName ) - allocate ( xd%V_plane_filt (3, 0:p%NumPlanes-1) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for xd%V_plane_filt.', errStat, errMsg, RoutineName ) - allocate ( xd%Vx_wind_disk_filt(0:p%NumPlanes-1) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for xd%Vx_wind_disk_filt.', errStat, errMsg, RoutineName ) - allocate ( xd%x_plane (0:p%NumPlanes-1) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for xd%x_plane.', errStat, errMsg, RoutineName ) - allocate ( xd%YawErr_filt (0:p%NumPlanes-1) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for xd%YawErr_filt.', errStat, errMsg, RoutineName ) - allocate ( xd%TI_amb_filt (0:p%NumPlanes-1) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for xd%TI_amb_filt.', errStat, errMsg, RoutineName ) - allocate ( xd%D_rotor_filt (0:p%NumPlanes-1) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for xd%D_rotor_filt.', errStat, errMsg, RoutineName ) - allocate ( xd%Ct_azavg_filt (0:p%NumRadii-1) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for xd%Ct_azavg_filt.', errStat, errMsg, RoutineName ) - allocate ( xd%Vx_wake (0:p%NumRadii-1,0:p%NumPlanes-1) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for xd%Vx_wake.', errStat, errMsg, RoutineName ) - allocate ( xd%Vr_wake (0:p%NumRadii-1,0:p%NumPlanes-1) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for xd%Vr_wake.', errStat, errMsg, RoutineName ) - if (errStat /= ErrID_None) return - - xd%xhat_plane = 0.0_ReKi - xd%p_plane = 0.0_ReKi - xd%x_plane = 0.0_ReKi - xd%Vx_wake = 0.0_ReKi - xd%Vr_wake = 0.0_ReKi - xd%V_plane_filt = 0.0_ReKi - xd%Vx_wind_disk_filt = 0.0_ReKi - xd%TI_amb_filt = 0.0_ReKi - xd%D_rotor_filt = 0.0_ReKi - xd%Vx_rel_disk_filt = 0.0_ReKi - xd%Ct_azavg_filt = 0.0_ReKi - OtherState%firstPass = .true. - - ! miscvars to avoid the allocation per timestep - allocate ( m%dvdr(0:p%NumRadii-1 ) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%dvdr.', errStat, errMsg, RoutineName ) - allocate ( m%dvtdr(0:p%NumRadii-1 ) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%dvtdr.', errStat, errMsg, RoutineName ) - allocate ( m%vt_tot(0:p%NumRadii-1,0:p%NumPlanes-1 ) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%vt_tot.', errStat, errMsg, RoutineName ) - allocate ( m%vt_amb(0:p%NumRadii-1,0:p%NumPlanes-1 ) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%vt_amb.', errStat, errMsg, RoutineName ) - allocate ( m%vt_shr(0:p%NumRadii-1,0:p%NumPlanes-1 ) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%vt_shr.', errStat, errMsg, RoutineName ) - - allocate ( m%a(0:p%NumRadii-1 ) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%a.', errStat, errMsg, RoutineName ) - allocate ( m%b(0:p%NumRadii-1 ) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%b.', errStat, errMsg, RoutineName ) - allocate ( m%c(0:p%NumRadii-1 ) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%c.', errStat, errMsg, RoutineName ) - allocate ( m%d(0:p%NumRadii-1 ) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%d.', errStat, errMsg, RoutineName ) - allocate ( m%r_wake(0:p%NumRadii-1 ) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%r_wake.', errStat, errMsg, RoutineName ) - allocate ( m%Vx_high(0:p%NumRadii-1 ) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%Vx_high.', errStat, errMsg, RoutineName ) - if (errStat /= ErrID_None) return - - !............................................................................................ - ! Define initialization output here - !............................................................................................ - - InitOut%Ver = WD_Ver - - allocate ( y%xhat_plane(3,0:p%NumPlanes-1), STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for y%xhat_plane.', errStat, errMsg, RoutineName ) - allocate ( y%p_plane (3,0:p%NumPlanes-1), STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for y%p_plane.', errStat, errMsg, RoutineName ) - allocate ( y%Vx_wake (0:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for y%Vx_wake.', errStat, errMsg, RoutineName ) - allocate ( y%Vr_wake (0:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for y%Vr_wake.', errStat, errMsg, RoutineName ) - allocate ( y%D_wake (0:p%NumPlanes-1), STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for y%D_wake.', errStat, errMsg, RoutineName ) - allocate ( y%x_plane (0:p%NumPlanes-1), STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for y%x_plane.', errStat, errMsg, RoutineName ) - if (errStat /= ErrID_None) return - - y%xhat_plane = 0.0_Reki - y%p_plane = 0.0_Reki - y%Vx_wake = 0.0_Reki - y%Vr_wake = 0.0_Reki - y%D_wake = 0.0_Reki - y%x_plane = 0.0_Reki - - -end subroutine WD_Init - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is called at the end of the simulation. -subroutine WD_End( u, p, x, xd, z, OtherState, y, m, errStat, errMsg ) -!.................................................................................................................................. - - type(WD_InputType), intent(inout) :: u !< System inputs - type(WD_ParameterType), intent(inout) :: p !< Parameters - type(WD_ContinuousStateType), intent(inout) :: x !< Continuous states - type(WD_DiscreteStateType), intent(inout) :: xd !< Discrete states - type(WD_ConstraintStateType), intent(inout) :: z !< Constraint states - type(WD_OtherStateType), intent(inout) :: OtherState !< Other states - type(WD_OutputType), intent(inout) :: y !< System outputs - type(WD_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 - - errStat = ErrID_None - errMsg = "" - - - ! Place any last minute operations or calculations here: - - - ! Close files here: - - - - ! Destroy the input data: - - call WD_DestroyInput( u, errStat, errMsg ) - - - ! Destroy the parameter data: - - call WD_DestroyParam( p, errStat, errMsg ) - - - ! Destroy the state data: - - call WD_DestroyContState( x, errStat, errMsg ) - call WD_DestroyDiscState( xd, errStat, errMsg ) - call WD_DestroyConstrState( z, errStat, errMsg ) - call WD_DestroyOtherState( OtherState, errStat, errMsg ) - call WD_DestroyMisc( m, errStat, errMsg ) - - ! Destroy the output data: - - call WD_DestroyOutput( y, errStat, errMsg ) - - - - -end subroutine WD_End -!---------------------------------------------------------------------------------------------------------------------------------- -!> Loose coupling routine for solving for constraint states, integrating continuous states, and updating discrete and other states. -!! Continuous, constraint, discrete, and other states are updated for t + Interval -subroutine WD_UpdateStates( t, n, u, p, x, xd, z, OtherState, m, 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(WD_InputType), intent(in ) :: u !< Inputs at utimes (out only for mesh record-keeping in ExtrapInterp routine) - ! real(DbKi), intent(in ) :: utimes !< Times associated with u(:), in seconds - type(WD_ParameterType), intent(in ) :: p !< Parameters - type(WD_ContinuousStateType), intent(inout) :: x !< Input: Continuous states at t; - !! Output: Continuous states at t + Interval - type(WD_DiscreteStateType), intent(inout) :: xd !< Input: Discrete states at t; - !! Output: Discrete states at t + Interval - type(WD_ConstraintStateType), intent(inout) :: z !< Input: Constraint states at t; - !! Output: Constraint states at t+dt - type(WD_OtherStateType), intent(inout) :: OtherState !< Input: Other states at t; - !! Output: Other states at t+dt - type(WD_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 - - ! local variables - type(WD_InputType) :: uInterp ! Interpolated/Extrapolated input - integer(intKi) :: errStat2 ! temporary Error status - character(ErrMsgLen) :: errMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'WD_UpdateStates' - real(ReKi) :: dx, absdx, norm2_xhat_plane - real(ReKi) :: dy_HWkDfl(3), EddyTermA, EddyTermB, lstar, Vx_wake_min - integer(intKi) :: i,j, maxPln - - errStat = ErrID_None - errMsg = "" - - - if ( EqualRealNos(u%D_Rotor,0.0_ReKi) .or. u%D_Rotor < 0.0_ReKi ) then - ! TEST: E7 - call SetErrStat(ErrID_Fatal, 'Rotor diameter must be greater than zero.', errStat, errMsg, RoutineName) - return - end if - - ! Check if we are fully initialized - if ( OtherState%firstPass ) then - call InitStatesWithInputs(p%NumPlanes, p%NumRadii, u, p, xd, m, errStat2, errMsg2) - call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) - OtherState%firstPass = .false. - if (errStat >= AbortErrLev) then - ! TEST: E3 - return - end if - - end if - - - ! Update V_plane_filt to [n+1]: - - maxPln = min(n,p%NumPlanes-2) - do i = 0,maxPln - xd%V_plane_filt(:,i ) = xd%V_plane_filt(:,i)*p%filtParam + u%V_plane(:,i )*p%oneMinusFiltParam - end do - xd%V_plane_filt (:,maxPln+1) = u%V_plane(:,maxPln+1) - - - maxPln = min(n+2,p%NumPlanes-1) - - ! create eddy viscosity info for most downstream plane - i = maxPln+1 - lstar = WakeDiam( p%Mod_WakeDiam, p%numRadii, p%dr, p%r, xd%Vx_wake(:,i-1), xd%Vx_wind_disk_filt(i-1), xd%D_rotor_filt(i-1), p%C_WakeDiam) / 2.0_ReKi - - Vx_wake_min = huge(ReKi) - do j = 0,p%NumRadii-1 - Vx_wake_min = min(Vx_wake_min, xd%Vx_wake(j,i-1)) - end do - - EddyTermA = EddyFilter(xd%x_plane(i-1),xd%D_rotor_filt(i-1), p%C_vAmb_DMin, p%C_vAmb_DMax, p%C_vAmb_FMin, p%C_vAmb_Exp) * p%k_vAmb * xd%TI_amb_filt(i-1) * xd%Vx_wind_disk_filt(i-1) * xd%D_rotor_filt(i-1)/2.0_ReKi - EddyTermB = EddyFilter(xd%x_plane(i-1),xd%D_rotor_filt(i-1), p%C_vShr_DMin, p%C_vShr_DMax, p%C_vShr_FMin, p%C_vShr_Exp) * p%k_vShr - do j = 0,p%NumRadii-1 - if ( j == 0 ) then - m%dvdr(j) = 0.0_ReKi - elseif (j <= p%NumRadii-2) then - m%dvdr(j) = ( xd%Vx_wake(j+1,i-1) - xd%Vx_wake(j-1,i-1) ) / (2_ReKi*p%dr) - else - m%dvdr(j) = - xd%Vx_wake(j-1,i-1) / (2_ReKi*p%dr) - end if - ! All of the following states are at [n] - m%vt_amb(j,i-1) = EddyTermA - m%vt_shr(j,i-1) = EddyTermB * max( (lstar**2)*abs(m%dvdr(j)) , lstar*(xd%Vx_wind_disk_filt(i-1) + Vx_wake_min ) ) - m%vt_tot(j,i-1) = m%vt_amb(j,i-1) + m%vt_shr(j,i-1) - end do - - ! We are going to update Vx_Wake - ! The quantities in these loops are all at time [n], so we need to compute prior to updating the states to [n+1] - do i = maxPln, 1, -1 - - lstar = WakeDiam( p%Mod_WakeDiam, p%numRadii, p%dr, p%r, xd%Vx_wake(:,i-1), xd%Vx_wind_disk_filt(i-1), xd%D_rotor_filt(i-1), p%C_WakeDiam) / 2.0_ReKi - - ! The following two quantities need to be for the time increments: - ! [n+1] [n] - ! dx = xd%x_plane(i) - xd%x_plane(i-1) - ! This is equivalent to - - dx = dot_product(xd%xhat_plane(:,i-1),xd%V_plane_filt(:,i-1))*p%DT_low - absdx = abs(dx) - if ( EqualRealNos( dx, 0.0_ReKi ) ) absdx = 1.0_ReKi ! This is to avoid division by zero problems in the formation of m%b and m%d below, which are not used when dx=0; the value of unity is arbitrary - - Vx_wake_min = huge(ReKi) - do j = 0,p%NumRadii-1 - Vx_wake_min = min(Vx_wake_min, xd%Vx_wake(j,i-1)) - end do - - EddyTermA = EddyFilter(xd%x_plane(i-1),xd%D_rotor_filt(i-1), p%C_vAmb_DMin, p%C_vAmb_DMax, p%C_vAmb_FMin, p%C_vAmb_Exp) * p%k_vAmb * xd%TI_amb_filt(i-1) * xd%Vx_wind_disk_filt(i-1) * xd%D_rotor_filt(i-1)/2.0_ReKi - EddyTermB = EddyFilter(xd%x_plane(i-1),xd%D_rotor_filt(i-1), p%C_vShr_DMin, p%C_vShr_DMax, p%C_vShr_FMin, p%C_vShr_Exp) * p%k_vShr - do j = 0,p%NumRadii-1 - if ( j == 0 ) then - m%dvdr(j) = 0.0_ReKi - elseif (j <= p%NumRadii-2) then - m%dvdr(j) = ( xd%Vx_wake(j+1,i-1) - xd%Vx_wake(j-1,i-1) ) / (2_ReKi*p%dr) - else - m%dvdr(j) = - xd%Vx_wake(j-1,i-1) / (2_ReKi*p%dr) - end if - ! All of the following states are at [n] - m%vt_amb(j,i-1) = EddyTermA - m%vt_shr(j,i-1) = EddyTermB * max( (lstar**2)*abs(m%dvdr(j)) , lstar*(xd%Vx_wind_disk_filt(i-1) + Vx_wake_min ) ) - m%vt_tot(j,i-1) = m%vt_amb(j,i-1) + m%vt_shr(j,i-1) - end do - - ! All of the m%a,m%b,m%c,m%d vectors use states at time increment [n] - ! These need to be inside another radial loop because m%dvtdr depends on the j+1 and j-1 indices of m%vt() - - m%dvtdr(0) = 0.0_ReKi - m%a(0) = 0.0_ReKi - m%b(0) = p%dr * ( xd%Vx_wind_disk_filt(i-1) + xd%Vx_wake(0,i-1)) / absdx + m%vt_tot(0,i-1)/p%dr - m%c(0) = -m%vt_tot(0,i-1)/p%dr - m%c(p%NumRadii-1) = 0.0_ReKi - m%d(0) = (p%dr * (xd%Vx_wind_disk_filt(i-1) + xd%Vx_wake(0,i-1)) / absdx - m%vt_tot(0,i-1)/p%dr ) * xd%Vx_wake(0,i-1) + ( m%vt_tot(0,i-1)/p%dr ) * xd%Vx_wake(1,i-1) - - do j = p%NumRadii-1, 1, -1 - - if (j <= p%NumRadii-2) then - m%dvtdr(j) = ( m%vt_tot(j+1,i-1) - m%vt_tot(j-1,i-1) ) / (2_ReKi*p%dr) - m%c(j) = real(j,ReKi)*xd%Vr_wake(j,i-1)/4.0_ReKi - (1_ReKi+2_ReKi*real(j,ReKi))*m%vt_tot(j,i-1)/(4.0_ReKi*p%dr) - real(j,ReKi)*m%dvtdr(j)/4.0_ReKi - m%d(j) = ( real(j,ReKi)*xd%Vr_wake(j,i-1)/4.0_ReKi - (1_ReKi-2_ReKi*real(j,ReKi))*m%vt_tot(j,i-1)/(4.0_ReKi*p%dr) - real(j,ReKi)*m%dvtdr(j)/4.0_ReKi) * xd%Vx_wake(j-1,i-1) & - + ( p%r(j)*( xd%Vx_wind_disk_filt(i-1) + xd%Vx_wake(j,i-1) )/absdx - real(j,ReKi)*m%vt_tot(j,i-1)/p%dr ) * xd%Vx_wake(j,i-1) & - + (-real(j,ReKi)*xd%Vr_wake(j,i-1)/4.0_ReKi + (1_ReKi+2_ReKi*real(j,ReKi))*m%vt_tot(j,i-1)/(4.0_ReKi*p%dr) + real(j,ReKi)*m%dvtdr(j)/4.0_ReKi ) * xd%Vx_wake(j+1,i-1) - - else - m%dvtdr(j) = 0.0_ReKi - m%d(j) = ( real(j,ReKi)*xd%Vr_wake(j,i-1)/4.0_ReKi - (1_ReKi-2_ReKi*real(j,ReKi))*m%vt_tot(j,i-1)/(4.0_ReKi*p%dr) - real(j,ReKi)*m%dvtdr(j)/4.0_ReKi) * xd%Vx_wake(j-1,i-1) & - + ( p%r(j)*( xd%Vx_wind_disk_filt(i-1) + xd%Vx_wake(j,i-1) )/absdx - real(j,ReKi)*m%vt_tot(j,i-1)/p%dr ) * xd%Vx_wake(j,i-1) - - end if - - m%a(j) = -real(j,ReKi)*xd%Vr_wake(j,i-1)/4.0_ReKi + (1.0_ReKi-2.0_ReKi*real(j,ReKi))*m%vt_tot(j,i-1)/(4.0_ReKi*p%dr) + real(j,ReKi)*m%dvtdr(j)/4.0_ReKi - m%b(j) = p%r(j) * ( xd%Vx_wind_disk_filt(i-1) + xd%Vx_wake(j,i-1) ) / absdx + real(j,ReKi)*m%vt_tot(j,i-1)/p%dr - - - end do ! j = 1,p%NumRadii-1 - - ! Update these states to [n+1] - - xd%x_plane (i) = xd%x_plane (i-1) + abs(dx) ! dx = dot_product(xd%xhat_plane(:,i-1),xd%V_plane_filt(:,i-1))*p%DT_low ; don't use absdx here - xd%YawErr_filt (i) = xd%YawErr_filt(i-1) - xd%xhat_plane(:,i) = xd%xhat_plane(:,i-1) - - ! The function state-related arguments must be at time [n+1], so we must update YawErr_filt and xhat_plane before computing the deflection - - dy_HWkDfl = GetYawCorrection(xd%YawErr_filt(i), xd%xhat_plane(:,i), dx, p, errStat2, errMsg2) - call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) - if (errStat >= AbortErrLev) then - ! TEST: E3 - call Cleanup() - return - end if - xd%p_plane (:,i) = xd%p_plane(:,i-1) + xd%xhat_plane(:,i-1)*dx + dy_HWkDfl & - + ( u%V_plane(:,i-1) - xd%xhat_plane(:,i-1)*dot_product(xd%xhat_plane(:,i-1),u%V_plane(:,i-1)) )*p%DT_low - - xd%Vx_wind_disk_filt(i) = xd%Vx_wind_disk_filt(i-1) - xd%TI_amb_filt (i) = xd%TI_amb_filt(i-1) - xd%D_rotor_filt (i) = xd%D_rotor_filt(i-1) - - ! Update Vx_wake and Vr_wake to [n+1] - if ( EqualRealNos( dx, 0.0_ReKi ) ) then - xd%Vx_wake(:,i) = xd%Vx_wake(:,i-1) - xd%Vr_wake(:,i) = xd%Vr_wake(:,i-1) - else - call ThomasAlgorithm(p%NumRadii, m%a, m%b, m%c, m%d, xd%Vx_wake(:,i), errStat2, errMsg2) - call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) - if (errStat >= AbortErrLev) then - ! TEST: E16, E17, or E18 - call Cleanup() - return - end if - do j = 1,p%NumRadii-1 - ! NOTE: xd%Vr_wake(0,:) was initialized to 0 and remains 0. - xd%Vr_wake(j,i) = real( j-1,ReKi)*( xd%Vr_wake(j-1,i) )/real(j,ReKi) & - ! Vx_wake is for the [n+1] , [n+1] , [n] , and [n] increments - - real(2*j-1,ReKi)*p%dr * ( xd%Vx_wake(j,i) + xd%Vx_wake(j-1,i) - xd%Vx_wake(j,i-1) - xd%Vx_wake(j-1,i-1) ) / ( real(4*j,ReKi) * absdx ) - end do - end if - end do ! i = 1,min(n+2,p%NumPlanes-1) - - - - ! Update states at disk-plane to [n+1] - - xd%xhat_plane (:,0) = xd%xhat_plane(:,0)*p%filtParam + u%xhat_disk(:)*p%oneMinusFiltParam ! 2-step calculation for xhat_plane at disk - norm2_xhat_plane = TwoNorm( xd%xhat_plane(:,0) ) - if ( EqualRealNos(norm2_xhat_plane, 0.0_ReKi) ) then - ! TEST: E1 - call SetErrStat(ErrID_FATAL, 'The nacelle-yaw has rotated 180 degrees between time steps, i.e., the L2 norm of xd%xhat_plane(:,0)*p%filtParam + u%xhat_disk(:)*(1-p%filtParam) is zero.', errStat, errMsg, RoutineName) - call Cleanup() - return - end if - - xd%xhat_plane (:,0) = xd%xhat_plane(:,0) / norm2_xhat_plane - - xd%YawErr_filt (0) = xd%YawErr_filt(0)*p%filtParam + u%YawErr*p%oneMinusFiltParam - - if ( EqualRealNos(abs(xd%YawErr_filt(0)), pi/2) .or. abs(xd%YawErr_filt(0)) > pi/2 ) then - ! TEST: E4 - call SetErrStat(ErrID_FATAL, 'The time-filtered nacelle-yaw error has reached +/- pi/2.', errStat, errMsg, RoutineName) - call Cleanup() - return - end if - - ! The function state-related arguments must be at time [n+1], so we must update YawErr_filt and xhat_plane before computing the deflection - 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 - ! TEST: E3 - call Cleanup() - return - end if - - ! NOTE: xd%x_plane(0) was already initialized to zero - - xd%p_plane (:,0) = xd%p_plane(:,0)*p%filtParam + ( u%p_hub(:) + dy_HWkDfl(:) )*p%oneMinusFiltParam - xd%Vx_wind_disk_filt(0) = xd%Vx_wind_disk_filt(0)*p%filtParam + u%Vx_wind_disk*p%oneMinusFiltParam - xd%TI_amb_filt (0) = xd%TI_amb_filt(0)*p%filtParam + u%TI_amb*p%oneMinusFiltParam - xd%D_rotor_filt (0) = xd%D_rotor_filt(0)*p%filtParam + u%D_rotor*p%oneMinusFiltParam - xd%Vx_rel_disk_filt = xd%Vx_rel_disk_filt*p%filtParam + u%Vx_rel_disk*p%oneMinusFiltParam - - - ! filtered, azimuthally-averaged Ct values at each radial station - xd%Ct_azavg_filt (:) = xd%Ct_azavg_filt(:)*p%filtParam + u%Ct_azavg(:)*p%oneMinusFiltParam - - call NearWakeCorrection( xd%Ct_azavg_filt, xd%Vx_rel_disk_filt, p, m, xd%Vx_wake(:,0), xd%D_rotor_filt(0), errStat, errMsg ) - - !Used for debugging: write(51,'(I5,100(1x,ES10.2E2))') n, xd%x_plane(n), xd%x_plane(n)/xd%D_rotor_filt(n), xd%Vx_wind_disk_filt(n) + xd%Vx_wake(:,n), xd%Vr_wake(:,n) - - call Cleanup() - -contains - subroutine Cleanup() - - - - end subroutine Cleanup - -end subroutine WD_UpdateStates -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine for computing outputs, used in both loose and tight coupling. -!! 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 WD_CalcOutput( t, u, p, x, xd, z, 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. -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(WD_InputType), INTENT(IN ) :: u !< Inputs at Time t - TYPE(WD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(WD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(WD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(WD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t - TYPE(WD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(WD_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- - !! nectivity information does not have to be recalculated) - type(WD_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, parameter :: indx = 1 - integer(intKi) :: n, i - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'WD_CalcOutput' - real(ReKi) :: correction(3) - errStat = ErrID_None - errMsg = "" - - n = nint(t/p%DT_low) - - ! Check if we are fully initialized - if ( OtherState%firstPass ) then - - correction = 0.0_ReKi - do i = 0, 1 - y%x_plane(i) = u%Vx_rel_disk*real(i,ReKi)*real(p%DT_low,ReKi) - - correction = correction + GetYawCorrection(u%YawErr, u%xhat_disk, y%x_plane(i), p, errStat2, errMsg2) - call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) - if (errStat >= AbortErrLev) then - ! TEST: E3 - return - end if - - y%p_plane (:,i) = u%p_hub(:) + y%x_plane(i)*u%xhat_disk(:) + correction - y%xhat_plane(:,i) = u%xhat_disk(:) - - - ! NOTE: Since we are in firstPass=T, then xd%Vx_wake is already set to zero, so just pass that into WakeDiam - y%D_wake(i) = WakeDiam( p%Mod_WakeDiam, p%NumRadii, p%dr, p%r, xd%Vx_wake(:,i), u%Vx_wind_disk, u%D_rotor, p%C_WakeDiam) - end do - - ! Initialze Vx_wake; Vr_wake is already initialized to zero, so, we don't need to do that here. - call NearWakeCorrection( u%Ct_azavg, u%Vx_rel_disk, p, m, y%Vx_wake(:,0), u%D_rotor, errStat, errMsg ) - if (errStat > AbortErrLev) return - y%Vx_wake(:,1) = y%Vx_wake(:,0) - - return - - else - y%x_plane = xd%x_plane - y%p_plane = xd%p_plane - y%xhat_plane = xd%xhat_plane - y%Vx_wake = xd%Vx_wake - y%Vr_wake = xd%Vr_wake - do i = 0, min(n+1,p%NumPlanes-1) - - y%D_wake(i) = WakeDiam( p%Mod_WakeDiam, p%NumRadii, p%dr, p%r, xd%Vx_wake(:,i), xd%Vx_wind_disk_filt(i), xd%D_rotor_filt(i), p%C_WakeDiam) - - end do - end if - -end subroutine WD_CalcOutput - -!---------------------------------------------------------------------------------------------------------------------------------- -!> Tight coupling routine for solving for the residual of the constraint state equations -subroutine WD_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_residual, errStat, errMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(WD_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(WD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(WD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(WD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time - TYPE(WD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time (possibly a guess) - TYPE(WD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time - TYPE(WD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - TYPE(WD_ConstraintStateType), INTENT(INOUT) :: Z_residual !< Residual of the constraint state equations using - !! the input values described above - INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: errMsg !< Error message if errStat /= ErrID_None - - - - ! Local variables - integer, parameter :: indx = 1 - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'WD_CalcConstrStateResidual' - - - - errStat = ErrID_None - errMsg = "" - - - - -end subroutine WD_CalcConstrStateResidual - -subroutine InitStatesWithInputs(numPlanes, numRadii, u, p, xd, m, errStat, errMsg) - - integer(IntKi), intent(in ) :: numPlanes - integer(IntKi), intent(in ) :: numRadii - TYPE(WD_InputType), intent(in ) :: u !< Inputs at Time - TYPE(WD_ParameterType), intent(in ) :: p !< Parameters - TYPE(WD_DiscreteStateType), intent(inout) :: xd !< Discrete states at Time - type(WD_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 - character(*), parameter :: RoutineName = 'InitStatesWithInputs' - integer(IntKi) :: i - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - real(ReKi) :: correction(3) - ! Note, all of these states will have been set to zero in the WD_Init routine - - - ErrStat = ErrID_None - ErrMsg = "" - - - correction = 0.0_ReKi - do i = 0, 1 - xd%x_plane (i) = u%Vx_rel_disk*real(i,ReKi)*real(p%DT_low,ReKi) - xd%YawErr_filt (i) = u%YawErr - - correction = correction + GetYawCorrection(u%YawErr, u%xhat_disk, xd%x_plane(i), p, errStat2, errMsg2) - call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) - if (errStat >= AbortErrLev) then - ! TEST: E3 - return - end if - - !correction = ( p%C_HWkDfl_x + p%C_HWkDfl_xY*u%YawErr )*xd%x_plane(i) + correctionA - - xd%p_plane (:,i) = u%p_hub(:) + xd%x_plane(i)*u%xhat_disk(:) + correction - xd%xhat_plane(:,i) = u%xhat_disk(:) - xd%V_plane_filt(:,i) = u%V_plane(:,i) - xd%Vx_wind_disk_filt(i) = u%Vx_wind_disk - xd%TI_amb_filt (i) = u%TI_amb - xd%D_rotor_filt (i) = u%D_rotor - - - end do - - xd%Vx_rel_disk_filt = u%Vx_rel_disk - - ! Initialze Ct_azavg_filt and Vx_wake; Vr_wake is already initialized to zero, so, we don't need to do that here. - xd%Ct_azavg_filt (:) = u%Ct_azavg(:) - - call NearWakeCorrection( xd%Ct_azavg_filt, xd%Vx_rel_disk_filt, p, m, xd%Vx_wake(:,0), xd%D_rotor_filt(0), errStat, errMsg ) - xd%Vx_wake(:,1) = xd%Vx_wake(:,0) - -end subroutine InitStatesWithInputs - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine validates the inputs from the WakeDynamics input files. -SUBROUTINE ValidateInitInputData( DT_low, InitInp, InputFileData, errStat, errMsg ) -!.................................................................................................................................. - - ! Passed variables: - real(DbKi), intent(in ) :: DT_low !< requested simulation time step size (s) - type(WD_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine - type(WD_InputFileType), intent(in) :: InputFileData !< All the data in the WakeDynamics input file - integer(IntKi), intent(out) :: errStat !< Error status - character(*), intent(out) :: errMsg !< Error message - - - ! local variables - integer(IntKi) :: k ! Blade number - integer(IntKi) :: j ! node number - character(*), parameter :: RoutineName = 'ValidateInitInputData' - - errStat = ErrID_None - errMsg = "" - - - ! TODO: Talk to Bonnie about whether we want to convert <= or >= checks to EqualRealNos() .or. > checks, etc. GJH - ! TEST: E13, - !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 ( DT_low <= 0.0) call SetErrStat ( ErrID_Fatal, 'DT_low must be greater than zero.', errStat, errMsg, RoutineName ) - if ( InputFileData%NumPlanes < 2 ) call SetErrStat ( ErrID_Fatal, 'Number of wake planes must be greater than one.', ErrSTat, errMsg, RoutineName ) - if ( InputFileData%NumRadii < 2 ) call SetErrStat ( ErrID_Fatal, 'Number of radii in the radial finite-difference grid must be greater than one.', ErrSTat, errMsg, RoutineName ) - if ( InputFileData%dr <= 0.0) call SetErrStat ( ErrID_Fatal, 'dr must be greater than zero.', errStat, errMsg, RoutineName ) - if ( InputFileData%f_c <= 0.0) call SetErrStat ( ErrID_Fatal, 'f_c must be greater than or equal to zero.', errStat, errMsg, RoutineName ) - if ( (InputFileData%C_NearWake <= 1.0) .or. (InputFileData%C_NearWake >= 2.5)) call SetErrStat ( ErrID_Fatal, 'C_NearWake must be greater than 1.0 and less than 2.5.', errStat, errMsg, RoutineName ) - if ( InputFileData%k_vAmb < 0.0) call SetErrStat ( ErrID_Fatal, 'k_vAmb must be greater than or equal to zero.', errStat, errMsg, RoutineName ) - if ( InputFileData%k_vShr < 0.0) call SetErrStat ( ErrID_Fatal, 'k_vShr must be greater than or equal to zero.', errStat, errMsg, RoutineName ) - if ( InputFileData%C_vAmb_DMin < 0.0) call SetErrStat ( ErrID_Fatal, 'C_vAmb_DMin must be greater than or equal to zero.', errStat, errMsg, RoutineName ) - if ( InputFileData%C_vAmb_DMax <= InputFileData%C_vAmb_DMin) call SetErrStat ( ErrID_Fatal, 'C_vAmb_DMax must be greater than C_vAmb_DMin.', errStat, errMsg, RoutineName ) - if ( (InputFileData%C_vAmb_FMin < 0.0) .or. (InputFileData%C_vAmb_FMin > 1.0) ) call SetErrStat ( ErrID_Fatal, 'C_vAmb_FMin must be greater than or equal to zero and less than or equal to 1.0.', errStat, errMsg, RoutineName ) - if ( InputFileData%C_vAmb_Exp <= 0.0) call SetErrStat ( ErrID_Fatal, 'C_vAmb_Exp must be greater than zero.', errStat, errMsg, RoutineName ) - if ( InputFileData%C_vShr_DMin < 0.0) call SetErrStat ( ErrID_Fatal, 'C_vShr_DMin must be greater than or equal to zero.', errStat, errMsg, RoutineName ) - if ( InputFileData%C_vShr_DMax <= InputFileData%C_vShr_DMin) call SetErrStat ( ErrID_Fatal, 'C_vShr_DMax must be greater than C_vShr_DMin.', errStat, errMsg, RoutineName ) - if ( (InputFileData%C_vShr_FMin < 0.0) .or. (InputFileData%C_vShr_FMin > 1.0) ) call SetErrStat ( ErrID_Fatal, 'C_vShr_FMin must be greater than or equal to zero and less than or equal to 1.0.', errStat, errMsg, RoutineName ) - if ( InputFileData%C_vShr_Exp <= 0.0) call SetErrStat ( ErrID_Fatal, 'C_vShr_Exp must be greater than zero.', errStat, errMsg, RoutineName ) - if (.not. ((InputFileData%Mod_WakeDiam == 1) .or. (InputFileData%Mod_WakeDiam == 2) .or. (InputFileData%Mod_WakeDiam == 3) .or. (InputFileData%Mod_WakeDiam == 4)) ) call SetErrStat ( ErrID_Fatal, 'Mod_WakeDiam must be equal to 1, 2, 3, or 4.', errStat, errMsg, RoutineName ) - if ( (.not. (InputFileData%Mod_WakeDiam == 1)) .and.( (InputFileData%C_WakeDiam <= 0.0) .or. (InputFileData%C_WakeDiam >= 1.0)) ) call SetErrStat ( ErrID_Fatal, 'When Mod_WakeDiam is not equal to 1, then C_WakeDiam must be greater than zero and less than 1.0.', errStat, errMsg, RoutineName ) - -END SUBROUTINE ValidateInitInputData - -end module WakeDynamics diff --git a/OpenFAST/modules/wakedynamics/src/WakeDynamics_Registry.txt b/OpenFAST/modules/wakedynamics/src/WakeDynamics_Registry.txt deleted file mode 100644 index e5e3b7831..000000000 --- a/OpenFAST/modules/wakedynamics/src/WakeDynamics_Registry.txt +++ /dev/null @@ -1,149 +0,0 @@ -################################################################################################################################### -# Registry for FAST.Farm's WakeDynamics module in the FAST Modularization Framework -# This Registry file is used to create MODULE WakeDynamics_Types, which contains all of the user-defined types needed in WakeDynamics. -# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. -# -# Entries are of the form -# keyword -# -# Use ^ as a shortcut for the value from the previous line. -# See NWTC Programmer's Handbook at https://nwtc.nrel.gov/FAST-Developers for further information on the format/contents of this file. -################################################################################################################################### - -# ...... Include files (definitions from NWTC Library) ............................................................................ -include Registry_NWTC_Library.txt - -# ..... Constants ....................................................................................................... -param WakeDynamics/WD - INTEGER WakeDiamMod_RotDiam - 1 - "Wake diameter calculation model: rotor diameter" - -param ^ - INTEGER WakeDiamMod_Velocity - 2 - "Wake diameter calculation model: velocity-based" - -param ^ - INTEGER WakeDiamMod_MassFlux - 3 - "Wake diameter calculation model: mass-flux based" - -param ^ - INTEGER WakeDiamMod_MtmFlux - 4 - "Wake diameter calculation model: momentum-flux based" - - -# ..... InputFile Data ....................................................................................................... -typedef ^ WD_InputFileType ReKi dr - - - "Radial increment of radial finite-difference grid [>0.0]" m -typedef ^ WD_InputFileType IntKi NumRadii - - - "Number of radii in the radial finite-difference grid [>=2]" - -typedef ^ WD_InputFileType IntKi NumPlanes - - - "Number of wake planes [>=2]" - -typedef ^ WD_InputFileType ReKi f_c - - - "Cut-off frequency of the low-pass time-filter for the wake advection, deflection, and meandering model [>0.0]" Hz -typedef ^ WD_InputFileType ReKi C_HWkDfl_O - - - "Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor" m -typedef ^ WD_InputFileType ReKi C_HWkDfl_OY - - - "Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor scaled with yaw error" m/rad -typedef ^ WD_InputFileType ReKi C_HWkDfl_x - - - "Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance" - -typedef ^ WD_InputFileType ReKi C_HWkDfl_xY - - - "Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance and yaw error" 1/rad -typedef ^ WD_InputFileType ReKi C_NearWake - - - "Calibrated parameter for the near-wake correction [>-1.0]" - -typedef ^ WD_InputFileType ReKi k_vAmb - - - "Calibrated parameter for the influence of ambient turbulence in the eddy viscosity [>=0.0]" - -typedef ^ WD_InputFileType ReKi k_vShr - - - "Calibrated parameter for the influence of the shear layer in the eddy viscosity [>=0.0]" - -typedef ^ WD_InputFileType ReKi C_vAmb_DMin - - - "Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the minimum and exponential regions [>=0.0 ]" - -typedef ^ WD_InputFileType ReKi C_vAmb_DMax - - - "Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the exponential and maximum regions [> C_vAmb_DMin]" - -typedef ^ WD_InputFileType ReKi C_vAmb_FMin - - - "Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the value in the minimum region [>=0.0 and <=1.0]" - -typedef ^ WD_InputFileType ReKi C_vAmb_Exp - - - "Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the exponent in the exponential region [> 0.0]" - -typedef ^ WD_InputFileType ReKi C_vShr_DMin - - - "Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the minimum and exponential regions [>=0.0]" - -typedef ^ WD_InputFileType ReKi C_vShr_DMax - - - "Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the exponential and maximum regions [> C_vShr_DMin]" - -typedef ^ WD_InputFileType ReKi C_vShr_FMin - - - "Calibrated parameter in the eddy viscosity filter function for the shear layer defining the value in the minimum region [>=0.0 and <=1.0]" - -typedef ^ WD_InputFileType ReKi C_vShr_Exp - - - "Calibrated parameter in the eddy viscosity filter function for the shear layer defining the exponent in the exponential region [> 0.0]" - -typedef ^ WD_InputFileType IntKi Mod_WakeDiam - - - "Wake diameter calculation model {1: rotor diameter, 2: velocity-based, 3: mass-flux based, 4: momentum-flux based} [DEFAULT=1]" - -typedef ^ WD_InputFileType ReKi C_WakeDiam - - - "Calibrated parameter for wake diameter calculation [>0.0 and <1.0] [unused for Mod_WakeDiam=1]" - - - -# ..... Initialization data ....................................................................................................... -# Define inputs that the initialization routine may need here: -# e.g., the name of the input file, the file root name, etc. -typedef ^ InitInputType WD_InputFileType InputFileData - - - "FAST.Farm input-file data for wake dynamics" - -typedef ^ InitInputType IntKi TurbNum - 0 - "Turbine ID number (start with 1; end with number of turbines)" - - - -# Define outputs from the initialization routine here: -typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - -typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - -typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - - - -# ..... States .................................................................................................................... -# Define continuous (differentiable) states here: -typedef ^ ContinuousStateType ReKi DummyContState - - - "Remove this variable if you have continuous states" - - -# Define discrete (nondifferentiable) states here: -typedef ^ DiscreteStateType ReKi xhat_plane {:}{:} - - "Orientations of wake planes, normal to wake planes" - -typedef ^ DiscreteStateType ReKi p_plane {:}{:} - - "Center positions of wake planes" m -typedef ^ DiscreteStateType ReKi x_plane {:} - - "Downwind distance from rotor to each wake plane" m -typedef ^ DiscreteStateType ReKi Vx_wake {:}{:} - - "Axial wake velocity deficit at wake planes, distributed radially" m/s -typedef ^ DiscreteStateType ReKi Vr_wake {:}{:} - - "Radial wake velocity deficit at wake planes, distributed radially" m/s -typedef ^ DiscreteStateType ReKi V_plane_filt {:}{:} - - "Time-filtered advection, deflection, and meandering velocity of wake planes" m/s -typedef ^ DiscreteStateType ReKi Vx_wind_disk_filt {:} - - "Time-filtered rotor-disk-averaged ambient wind speed of wake planes, normal to planes" m/s -typedef ^ DiscreteStateType ReKi TI_amb_filt {:} - - "Time-filtered ambient turbulence intensity of wind at wake planes" - -typedef ^ DiscreteStateType ReKi D_rotor_filt {:} - - "Time-filtered rotor diameter associated with each wake plane" m -typedef ^ DiscreteStateType ReKi Vx_rel_disk_filt - - - "Time-filtered rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk" m/s -typedef ^ DiscreteStateType ReKi Ct_azavg_filt {:} - - "Time-filtered azimuthally averaged thrust force coefficient (normal to disk), distributed radially" - -typedef ^ DiscreteStateType ReKi YawErr_filt {:} - - "Time-filtered nacelle-yaw error at the wake planes" rad - -# Define constraint states here: -typedef ^ ConstraintStateType ReKi DummyConstrState - - - "Remove this variable if you have constraint states" - - -# Define any other states, including integer or logical states here: -typedef ^ OtherStateType LOGICAL firstPass - - - "Flag indicating whether or not the states have been initialized with proper inputs" - - -# ..... Misc/Optimization variables................................................................................................. -# 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 ReKi dvdr {:} - - "" -typedef ^ MiscVarType ReKi dvtdr {:} - - "" -typedef ^ MiscVarType ReKi vt_tot {:}{:} - - "" -typedef ^ MiscVarType ReKi vt_amb {:}{:} - - "" -typedef ^ MiscVarType ReKi vt_shr {:}{:} - - "" -typedef ^ MiscVarType ReKi a {:} - - "" -typedef ^ MiscVarType ReKi b {:} - - "" -typedef ^ MiscVarType ReKi c {:} - - "" -typedef ^ MiscVarType ReKi d {:} - - "" -typedef ^ MiscVarType ReKi r_wake {:} - - "" -typedef ^ MiscVarType ReKi Vx_high {:} - - "" - - -# ..... Parameters ................................................................................................................ -# Define parameters here: -# Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: -typedef ^ ParameterType DbKi dt_low - - - "Time interval for wake dynamics calculations {or default}" s -#typedef ^ ParameterType DbKi tmax - - - "Total run time" seconds -typedef ^ ParameterType IntKi NumPlanes - - - "Number of wake planes" - -typedef ^ ParameterType IntKi NumRadii - - - "Number of radii in the radial finite-difference grid" - -typedef ^ ParameterType ReKi dr - - - "Radial increment of radial finite-difference grid" m -typedef ^ ParameterType ReKi r {:} - - "Discretization of radial finite-difference grid" m -typedef ^ ParameterType ReKi filtParam - - - "Low-pass time-filter parameter, with a value between 0 (minimum filtering) and 1 (maximum filtering) (exclusive)" - -typedef ^ ParameterType ReKi oneMinusFiltParam - - - "1.0 - filtParam" - -typedef ^ ParameterType ReKi C_HWkDfl_O - - - "Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor" m -typedef ^ ParameterType ReKi C_HWkDfl_OY - - - "Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor scaled with yaw error" m/rad -typedef ^ ParameterType ReKi C_HWkDfl_x - - - "Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance" - -typedef ^ ParameterType ReKi C_HWkDfl_xY - - - "Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance and yaw error" 1/rad -typedef ^ ParameterType ReKi C_NearWake - - - "Calibrated parameter for near-wake correction" - -typedef ^ ParameterType ReKi C_vAmb_DMin - - - "Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the minimum and exponential regions" - -typedef ^ ParameterType ReKi C_vAmb_DMax - - - "Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the exponential and maximum regions" - -typedef ^ ParameterType ReKi C_vAmb_FMin - - - "Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the functional value in the minimum region" - -typedef ^ ParameterType ReKi C_vAmb_Exp - - - "Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the exponent in the exponential region" - -typedef ^ ParameterType ReKi C_vShr_DMin - - - "Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the minimum and exponential regions" - -typedef ^ ParameterType ReKi C_vShr_DMax - - - "Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the exponential and maximum regions" - -typedef ^ ParameterType ReKi C_vShr_FMin - - - "Calibrated parameter in the eddy viscosity filter function for the shear layer defining the functional value in the minimum region" - -typedef ^ ParameterType ReKi C_vShr_Exp - - - "Calibrated parameter in the eddy viscosity filter function for the shear layer defining the exponent in the exponential region" - -typedef ^ ParameterType ReKi k_vAmb - - - "Calibrated parameter for the influence of ambient turbulence in the eddy viscosity" - -typedef ^ ParameterType ReKi k_vShr - - - "Calibrated parameter for the influence of the shear layer in the eddy viscosity" - -typedef ^ ParameterType IntKi Mod_WakeDiam - - - "Wake diameter calculation model" - -typedef ^ ParameterType ReKi C_WakeDiam - - - "Calibrated parameter for wake diameter calculation" - - -# ..... Inputs .................................................................................................................... -# Define inputs that are contained on the mesh here: -typedef ^ InputType ReKi xhat_disk {3} - - "Orientation of rotor centerline, normal to disk" - -typedef ^ InputType ReKi p_hub {3} - - "Center position of hub" m -typedef ^ InputType ReKi V_plane {:}{:} - - "Advection, deflection, and meandering velocity of wake planes" m/s -typedef ^ InputType ReKi Vx_wind_disk - - - "Rotor-disk-averaged ambient wind speed, normal to planes" m/s -typedef ^ InputType ReKi TI_amb - - - "Ambient turbulence intensity of wind at rotor disk" - -typedef ^ InputType ReKi D_rotor - - - "Rotor diameter" m -typedef ^ InputType ReKi Vx_rel_disk - - - "Rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk" m/s -typedef ^ InputType ReKi Ct_azavg {:} - - "Azimuthally averaged thrust force coefficient (normal to disk), distributed radially" - -typedef ^ InputType ReKi YawErr - - - "Nacelle-yaw error at the wake planes" rad - - -# ..... Outputs ................................................................................................................... -# Define outputs that are contained on the mesh here: -typedef ^ OutputType ReKi xhat_plane {:}{:} - - "Orientations of wake planes, normal to wake planes" - -typedef ^ OutputType ReKi p_plane {:}{:} - - "Center positions of wake planes" m -typedef ^ OutputType ReKi Vx_wake {:}{:} - - "Axial wake velocity deficit at wake planes, distributed radially" m/s -typedef ^ OutputType ReKi Vr_wake {:}{:} - - "Radial wake velocity deficit at wake planes, distributed radially" m/s -typedef ^ OutputType ReKi D_wake {:} - - "Wake diameters at wake planes" m -typedef ^ OutputType ReKi x_plane {:} - - "Downwind distance from rotor to each wake plane" m - diff --git a/OpenFAST/modules/wakedynamics/src/WakeDynamics_Types.f90 b/OpenFAST/modules/wakedynamics/src/WakeDynamics_Types.f90 deleted file mode 100644 index b5a9c60fe..000000000 --- a/OpenFAST/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ /dev/null @@ -1,3951 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'WakeDynamics_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 -!********************************************************************************************************************************* -! WakeDynamics_Types -!................................................................................................................................. -! This file is part of WakeDynamics. -! -! 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 WakeDynamics. 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 WakeDynamics_Types -!--------------------------------------------------------------------------------------------------------------------------------- -USE NWTC_Library -IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: WakeDiamMod_RotDiam = 1 ! Wake diameter calculation model: rotor diameter [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WakeDiamMod_Velocity = 2 ! Wake diameter calculation model: velocity-based [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WakeDiamMod_MassFlux = 3 ! Wake diameter calculation model: mass-flux based [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WakeDiamMod_MtmFlux = 4 ! Wake diameter calculation model: momentum-flux based [-] -! ========= WD_InputFileType ======= - TYPE, PUBLIC :: WD_InputFileType - REAL(ReKi) :: dr !< Radial increment of radial finite-difference grid [>0.0] [m] - INTEGER(IntKi) :: NumRadii !< Number of radii in the radial finite-difference grid [>=2] [-] - INTEGER(IntKi) :: NumPlanes !< Number of wake planes [>=2] [-] - REAL(ReKi) :: f_c !< Cut-off frequency of the low-pass time-filter for the wake advection, deflection, and meandering model [>0.0] [Hz] - REAL(ReKi) :: C_HWkDfl_O !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor [m] - REAL(ReKi) :: C_HWkDfl_OY !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor scaled with yaw error [m/rad] - REAL(ReKi) :: C_HWkDfl_x !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance [-] - REAL(ReKi) :: C_HWkDfl_xY !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance and yaw error [1/rad] - REAL(ReKi) :: C_NearWake !< Calibrated parameter for the near-wake correction [>-1.0] [-] - REAL(ReKi) :: k_vAmb !< Calibrated parameter for the influence of ambient turbulence in the eddy viscosity [>=0.0] [-] - REAL(ReKi) :: k_vShr !< Calibrated parameter for the influence of the shear layer in the eddy viscosity [>=0.0] [-] - REAL(ReKi) :: C_vAmb_DMin !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the minimum and exponential regions [>=0.0 ] [-] - REAL(ReKi) :: C_vAmb_DMax !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the exponential and maximum regions [> C_vAmb_DMin] [-] - REAL(ReKi) :: C_vAmb_FMin !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the value in the minimum region [>=0.0 and <=1.0] [-] - REAL(ReKi) :: C_vAmb_Exp !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the exponent in the exponential region [> 0.0] [-] - REAL(ReKi) :: C_vShr_DMin !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the minimum and exponential regions [>=0.0] [-] - REAL(ReKi) :: C_vShr_DMax !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the exponential and maximum regions [> C_vShr_DMin] [-] - REAL(ReKi) :: C_vShr_FMin !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the value in the minimum region [>=0.0 and <=1.0] [-] - REAL(ReKi) :: C_vShr_Exp !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the exponent in the exponential region [> 0.0] [-] - INTEGER(IntKi) :: Mod_WakeDiam !< Wake diameter calculation model {1: rotor diameter, 2: velocity-based, 3: mass-flux based, 4: momentum-flux based} [DEFAULT=1] [-] - REAL(ReKi) :: C_WakeDiam !< Calibrated parameter for wake diameter calculation [>0.0 and <1.0] [unused for Mod_WakeDiam=1] [-] - END TYPE WD_InputFileType -! ======================= -! ========= WD_InitInputType ======= - TYPE, PUBLIC :: WD_InitInputType - TYPE(WD_InputFileType) :: InputFileData !< FAST.Farm input-file data for wake dynamics [-] - INTEGER(IntKi) :: TurbNum = 0 !< Turbine ID number (start with 1; end with number of turbines) [-] - END TYPE WD_InitInputType -! ======================= -! ========= WD_InitOutputType ======= - TYPE, PUBLIC :: WD_InitOutputType - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] - TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - END TYPE WD_InitOutputType -! ======================= -! ========= WD_ContinuousStateType ======= - TYPE, PUBLIC :: WD_ContinuousStateType - REAL(ReKi) :: DummyContState !< Remove this variable if you have continuous states [-] - END TYPE WD_ContinuousStateType -! ======================= -! ========= WD_DiscreteStateType ======= - TYPE, PUBLIC :: WD_DiscreteStateType - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: xhat_plane !< Orientations of wake planes, normal to wake planes [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: p_plane !< Center positions of wake planes [m] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: x_plane !< Downwind distance from rotor to each wake plane [m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vx_wake !< Axial wake velocity deficit at wake planes, distributed radially [m/s] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vr_wake !< Radial wake velocity deficit at wake planes, distributed radially [m/s] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: V_plane_filt !< Time-filtered advection, deflection, and meandering velocity of wake planes [m/s] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Vx_wind_disk_filt !< Time-filtered rotor-disk-averaged ambient wind speed of wake planes, normal to planes [m/s] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TI_amb_filt !< Time-filtered ambient turbulence intensity of wind at wake planes [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: D_rotor_filt !< Time-filtered rotor diameter associated with each wake plane [m] - REAL(ReKi) :: Vx_rel_disk_filt !< Time-filtered rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk [m/s] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Ct_azavg_filt !< Time-filtered azimuthally averaged thrust force coefficient (normal to disk), distributed radially [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: YawErr_filt !< Time-filtered nacelle-yaw error at the wake planes [rad] - END TYPE WD_DiscreteStateType -! ======================= -! ========= WD_ConstraintStateType ======= - TYPE, PUBLIC :: WD_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] - END TYPE WD_ConstraintStateType -! ======================= -! ========= WD_OtherStateType ======= - TYPE, PUBLIC :: WD_OtherStateType - LOGICAL :: firstPass !< Flag indicating whether or not the states have been initialized with proper inputs [-] - END TYPE WD_OtherStateType -! ======================= -! ========= WD_MiscVarType ======= - TYPE, PUBLIC :: WD_MiscVarType - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dvdr !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dvtdr !< [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: vt_tot !< [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: vt_amb !< [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: vt_shr !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: a !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: b !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: c !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: d !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: r_wake !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Vx_high !< [-] - END TYPE WD_MiscVarType -! ======================= -! ========= WD_ParameterType ======= - TYPE, PUBLIC :: WD_ParameterType - REAL(DbKi) :: dt_low !< Time interval for wake dynamics calculations {or default} [s] - INTEGER(IntKi) :: NumPlanes !< Number of wake planes [-] - INTEGER(IntKi) :: NumRadii !< Number of radii in the radial finite-difference grid [-] - REAL(ReKi) :: dr !< Radial increment of radial finite-difference grid [m] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: r !< Discretization of radial finite-difference grid [m] - REAL(ReKi) :: filtParam !< Low-pass time-filter parameter, with a value between 0 (minimum filtering) and 1 (maximum filtering) (exclusive) [-] - REAL(ReKi) :: oneMinusFiltParam !< 1.0 - filtParam [-] - REAL(ReKi) :: C_HWkDfl_O !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor [m] - REAL(ReKi) :: C_HWkDfl_OY !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor scaled with yaw error [m/rad] - REAL(ReKi) :: C_HWkDfl_x !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance [-] - REAL(ReKi) :: C_HWkDfl_xY !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance and yaw error [1/rad] - REAL(ReKi) :: C_NearWake !< Calibrated parameter for near-wake correction [-] - REAL(ReKi) :: C_vAmb_DMin !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the minimum and exponential regions [-] - REAL(ReKi) :: C_vAmb_DMax !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the exponential and maximum regions [-] - REAL(ReKi) :: C_vAmb_FMin !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the functional value in the minimum region [-] - REAL(ReKi) :: C_vAmb_Exp !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the exponent in the exponential region [-] - REAL(ReKi) :: C_vShr_DMin !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the minimum and exponential regions [-] - REAL(ReKi) :: C_vShr_DMax !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the exponential and maximum regions [-] - REAL(ReKi) :: C_vShr_FMin !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the functional value in the minimum region [-] - REAL(ReKi) :: C_vShr_Exp !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the exponent in the exponential region [-] - REAL(ReKi) :: k_vAmb !< Calibrated parameter for the influence of ambient turbulence in the eddy viscosity [-] - REAL(ReKi) :: k_vShr !< Calibrated parameter for the influence of the shear layer in the eddy viscosity [-] - INTEGER(IntKi) :: Mod_WakeDiam !< Wake diameter calculation model [-] - REAL(ReKi) :: C_WakeDiam !< Calibrated parameter for wake diameter calculation [-] - END TYPE WD_ParameterType -! ======================= -! ========= WD_InputType ======= - TYPE, PUBLIC :: WD_InputType - REAL(ReKi) , DIMENSION(1:3) :: xhat_disk !< Orientation of rotor centerline, normal to disk [-] - REAL(ReKi) , DIMENSION(1:3) :: p_hub !< Center position of hub [m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: V_plane !< Advection, deflection, and meandering velocity of wake planes [m/s] - REAL(ReKi) :: Vx_wind_disk !< Rotor-disk-averaged ambient wind speed, normal to planes [m/s] - REAL(ReKi) :: TI_amb !< Ambient turbulence intensity of wind at rotor disk [-] - REAL(ReKi) :: D_rotor !< Rotor diameter [m] - REAL(ReKi) :: Vx_rel_disk !< Rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk [m/s] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Ct_azavg !< Azimuthally averaged thrust force coefficient (normal to disk), distributed radially [-] - REAL(ReKi) :: YawErr !< Nacelle-yaw error at the wake planes [rad] - END TYPE WD_InputType -! ======================= -! ========= WD_OutputType ======= - TYPE, PUBLIC :: WD_OutputType - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: xhat_plane !< Orientations of wake planes, normal to wake planes [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: p_plane !< Center positions of wake planes [m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vx_wake !< Axial wake velocity deficit at wake planes, distributed radially [m/s] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vr_wake !< Radial wake velocity deficit at wake planes, distributed radially [m/s] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: D_wake !< Wake diameters at wake planes [m] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: x_plane !< Downwind distance from rotor to each wake plane [m] - END TYPE WD_OutputType -! ======================= -CONTAINS - SUBROUTINE WD_CopyInputFileType( SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_InputFileType), INTENT(IN) :: SrcInputFileTypeData - TYPE(WD_InputFileType), INTENT(INOUT) :: DstInputFileTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyInputFileType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileTypeData%dr = SrcInputFileTypeData%dr - DstInputFileTypeData%NumRadii = SrcInputFileTypeData%NumRadii - DstInputFileTypeData%NumPlanes = SrcInputFileTypeData%NumPlanes - DstInputFileTypeData%f_c = SrcInputFileTypeData%f_c - DstInputFileTypeData%C_HWkDfl_O = SrcInputFileTypeData%C_HWkDfl_O - DstInputFileTypeData%C_HWkDfl_OY = SrcInputFileTypeData%C_HWkDfl_OY - DstInputFileTypeData%C_HWkDfl_x = SrcInputFileTypeData%C_HWkDfl_x - DstInputFileTypeData%C_HWkDfl_xY = SrcInputFileTypeData%C_HWkDfl_xY - DstInputFileTypeData%C_NearWake = SrcInputFileTypeData%C_NearWake - DstInputFileTypeData%k_vAmb = SrcInputFileTypeData%k_vAmb - DstInputFileTypeData%k_vShr = SrcInputFileTypeData%k_vShr - DstInputFileTypeData%C_vAmb_DMin = SrcInputFileTypeData%C_vAmb_DMin - DstInputFileTypeData%C_vAmb_DMax = SrcInputFileTypeData%C_vAmb_DMax - DstInputFileTypeData%C_vAmb_FMin = SrcInputFileTypeData%C_vAmb_FMin - DstInputFileTypeData%C_vAmb_Exp = SrcInputFileTypeData%C_vAmb_Exp - DstInputFileTypeData%C_vShr_DMin = SrcInputFileTypeData%C_vShr_DMin - DstInputFileTypeData%C_vShr_DMax = SrcInputFileTypeData%C_vShr_DMax - DstInputFileTypeData%C_vShr_FMin = SrcInputFileTypeData%C_vShr_FMin - DstInputFileTypeData%C_vShr_Exp = SrcInputFileTypeData%C_vShr_Exp - DstInputFileTypeData%Mod_WakeDiam = SrcInputFileTypeData%Mod_WakeDiam - DstInputFileTypeData%C_WakeDiam = SrcInputFileTypeData%C_WakeDiam - END SUBROUTINE WD_CopyInputFileType - - SUBROUTINE WD_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg ) - TYPE(WD_InputFileType), INTENT(INOUT) :: InputFileTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyInputFileType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE WD_DestroyInputFileType - - SUBROUTINE WD_PackInputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_InputFileType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackInputFileType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! dr - Int_BufSz = Int_BufSz + 1 ! NumRadii - Int_BufSz = Int_BufSz + 1 ! NumPlanes - Re_BufSz = Re_BufSz + 1 ! f_c - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_O - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_OY - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_x - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_xY - Re_BufSz = Re_BufSz + 1 ! C_NearWake - Re_BufSz = Re_BufSz + 1 ! k_vAmb - Re_BufSz = Re_BufSz + 1 ! k_vShr - Re_BufSz = Re_BufSz + 1 ! C_vAmb_DMin - Re_BufSz = Re_BufSz + 1 ! C_vAmb_DMax - Re_BufSz = Re_BufSz + 1 ! C_vAmb_FMin - Re_BufSz = Re_BufSz + 1 ! C_vAmb_Exp - Re_BufSz = Re_BufSz + 1 ! C_vShr_DMin - Re_BufSz = Re_BufSz + 1 ! C_vShr_DMax - Re_BufSz = Re_BufSz + 1 ! C_vShr_FMin - Re_BufSz = Re_BufSz + 1 ! C_vShr_Exp - Int_BufSz = Int_BufSz + 1 ! Mod_WakeDiam - Re_BufSz = Re_BufSz + 1 ! C_WakeDiam - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%dr - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumRadii - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPlanes - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%f_c - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_O - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_OY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_x - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_xY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_NearWake - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_vAmb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_vShr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_DMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_DMax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_FMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_Exp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_DMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_DMax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_FMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_Exp - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Mod_WakeDiam - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_WakeDiam - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_PackInputFileType - - SUBROUTINE WD_UnPackInputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_InputFileType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackInputFileType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumRadii = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumPlanes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%f_c = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_O = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_OY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_x = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_xY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_NearWake = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k_vAmb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k_vShr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_DMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_DMax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_FMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_Exp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_DMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_DMax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_FMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_Exp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Mod_WakeDiam = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_WakeDiam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_UnPackInputFileType - - SUBROUTINE WD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(WD_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL WD_Copyinputfiletype( SrcInitInputData%InputFileData, DstInitInputData%InputFileData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%TurbNum = SrcInitInputData%TurbNum - END SUBROUTINE WD_CopyInitInput - - SUBROUTINE WD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(WD_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyInitInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - CALL WD_Destroyinputfiletype( InitInputData%InputFileData, ErrStat, ErrMsg ) - END SUBROUTINE WD_DestroyInitInput - - SUBROUTINE WD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! InputFileData: size of buffers for each call to pack subtype - CALL WD_Packinputfiletype( Re_Buf, Db_Buf, Int_Buf, InData%InputFileData, ErrStat2, ErrMsg2, .TRUE. ) ! InputFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InputFileData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InputFileData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InputFileData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! TurbNum - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL WD_Packinputfiletype( Re_Buf, Db_Buf, Int_Buf, InData%InputFileData, ErrStat2, ErrMsg2, OnlySize ) ! InputFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%TurbNum - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE WD_PackInitInput - - SUBROUTINE WD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WD_Unpackinputfiletype( Re_Buf, Db_Buf, Int_Buf, OutData%InputFileData, ErrStat2, ErrMsg2 ) ! InputFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%TurbNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE WD_UnPackInitInput - - SUBROUTINE WD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(WD_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WD_CopyInitOutput - - SUBROUTINE WD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(WD_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyInitOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, ErrMsg ) - END SUBROUTINE WD_DestroyInitOutput - - SUBROUTINE WD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE WD_PackInitOutput - - SUBROUTINE WD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE WD_UnPackInitOutput - - SUBROUTINE WD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(WD_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE WD_CopyContState - - SUBROUTINE WD_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(WD_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyContState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE WD_DestroyContState - - SUBROUTINE WD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyContState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_PackContState - - SUBROUTINE WD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyContState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_UnPackContState - - SUBROUTINE WD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(WD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%xhat_plane)) THEN - i1_l = LBOUND(SrcDiscStateData%xhat_plane,1) - i1_u = UBOUND(SrcDiscStateData%xhat_plane,1) - i2_l = LBOUND(SrcDiscStateData%xhat_plane,2) - i2_u = UBOUND(SrcDiscStateData%xhat_plane,2) - IF (.NOT. ALLOCATED(DstDiscStateData%xhat_plane)) THEN - ALLOCATE(DstDiscStateData%xhat_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%xhat_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%xhat_plane = SrcDiscStateData%xhat_plane -ENDIF -IF (ALLOCATED(SrcDiscStateData%p_plane)) THEN - i1_l = LBOUND(SrcDiscStateData%p_plane,1) - i1_u = UBOUND(SrcDiscStateData%p_plane,1) - i2_l = LBOUND(SrcDiscStateData%p_plane,2) - i2_u = UBOUND(SrcDiscStateData%p_plane,2) - IF (.NOT. ALLOCATED(DstDiscStateData%p_plane)) THEN - ALLOCATE(DstDiscStateData%p_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%p_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%p_plane = SrcDiscStateData%p_plane -ENDIF -IF (ALLOCATED(SrcDiscStateData%x_plane)) THEN - i1_l = LBOUND(SrcDiscStateData%x_plane,1) - i1_u = UBOUND(SrcDiscStateData%x_plane,1) - IF (.NOT. ALLOCATED(DstDiscStateData%x_plane)) THEN - ALLOCATE(DstDiscStateData%x_plane(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%x_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%x_plane = SrcDiscStateData%x_plane -ENDIF -IF (ALLOCATED(SrcDiscStateData%Vx_wake)) THEN - i1_l = LBOUND(SrcDiscStateData%Vx_wake,1) - i1_u = UBOUND(SrcDiscStateData%Vx_wake,1) - i2_l = LBOUND(SrcDiscStateData%Vx_wake,2) - i2_u = UBOUND(SrcDiscStateData%Vx_wake,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Vx_wake)) THEN - ALLOCATE(DstDiscStateData%Vx_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vx_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Vx_wake = SrcDiscStateData%Vx_wake -ENDIF -IF (ALLOCATED(SrcDiscStateData%Vr_wake)) THEN - i1_l = LBOUND(SrcDiscStateData%Vr_wake,1) - i1_u = UBOUND(SrcDiscStateData%Vr_wake,1) - i2_l = LBOUND(SrcDiscStateData%Vr_wake,2) - i2_u = UBOUND(SrcDiscStateData%Vr_wake,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Vr_wake)) THEN - ALLOCATE(DstDiscStateData%Vr_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vr_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Vr_wake = SrcDiscStateData%Vr_wake -ENDIF -IF (ALLOCATED(SrcDiscStateData%V_plane_filt)) THEN - i1_l = LBOUND(SrcDiscStateData%V_plane_filt,1) - i1_u = UBOUND(SrcDiscStateData%V_plane_filt,1) - i2_l = LBOUND(SrcDiscStateData%V_plane_filt,2) - i2_u = UBOUND(SrcDiscStateData%V_plane_filt,2) - IF (.NOT. ALLOCATED(DstDiscStateData%V_plane_filt)) THEN - ALLOCATE(DstDiscStateData%V_plane_filt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%V_plane_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%V_plane_filt = SrcDiscStateData%V_plane_filt -ENDIF -IF (ALLOCATED(SrcDiscStateData%Vx_wind_disk_filt)) THEN - i1_l = LBOUND(SrcDiscStateData%Vx_wind_disk_filt,1) - i1_u = UBOUND(SrcDiscStateData%Vx_wind_disk_filt,1) - IF (.NOT. ALLOCATED(DstDiscStateData%Vx_wind_disk_filt)) THEN - ALLOCATE(DstDiscStateData%Vx_wind_disk_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vx_wind_disk_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Vx_wind_disk_filt = SrcDiscStateData%Vx_wind_disk_filt -ENDIF -IF (ALLOCATED(SrcDiscStateData%TI_amb_filt)) THEN - i1_l = LBOUND(SrcDiscStateData%TI_amb_filt,1) - i1_u = UBOUND(SrcDiscStateData%TI_amb_filt,1) - IF (.NOT. ALLOCATED(DstDiscStateData%TI_amb_filt)) THEN - ALLOCATE(DstDiscStateData%TI_amb_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TI_amb_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%TI_amb_filt = SrcDiscStateData%TI_amb_filt -ENDIF -IF (ALLOCATED(SrcDiscStateData%D_rotor_filt)) THEN - i1_l = LBOUND(SrcDiscStateData%D_rotor_filt,1) - i1_u = UBOUND(SrcDiscStateData%D_rotor_filt,1) - IF (.NOT. ALLOCATED(DstDiscStateData%D_rotor_filt)) THEN - ALLOCATE(DstDiscStateData%D_rotor_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%D_rotor_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%D_rotor_filt = SrcDiscStateData%D_rotor_filt -ENDIF - DstDiscStateData%Vx_rel_disk_filt = SrcDiscStateData%Vx_rel_disk_filt -IF (ALLOCATED(SrcDiscStateData%Ct_azavg_filt)) THEN - i1_l = LBOUND(SrcDiscStateData%Ct_azavg_filt,1) - i1_u = UBOUND(SrcDiscStateData%Ct_azavg_filt,1) - IF (.NOT. ALLOCATED(DstDiscStateData%Ct_azavg_filt)) THEN - ALLOCATE(DstDiscStateData%Ct_azavg_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Ct_azavg_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Ct_azavg_filt = SrcDiscStateData%Ct_azavg_filt -ENDIF -IF (ALLOCATED(SrcDiscStateData%YawErr_filt)) THEN - i1_l = LBOUND(SrcDiscStateData%YawErr_filt,1) - i1_u = UBOUND(SrcDiscStateData%YawErr_filt,1) - IF (.NOT. ALLOCATED(DstDiscStateData%YawErr_filt)) THEN - ALLOCATE(DstDiscStateData%YawErr_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%YawErr_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%YawErr_filt = SrcDiscStateData%YawErr_filt -ENDIF - END SUBROUTINE WD_CopyDiscState - - SUBROUTINE WD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(WD_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyDiscState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(DiscStateData%xhat_plane)) THEN - DEALLOCATE(DiscStateData%xhat_plane) -ENDIF -IF (ALLOCATED(DiscStateData%p_plane)) THEN - DEALLOCATE(DiscStateData%p_plane) -ENDIF -IF (ALLOCATED(DiscStateData%x_plane)) THEN - DEALLOCATE(DiscStateData%x_plane) -ENDIF -IF (ALLOCATED(DiscStateData%Vx_wake)) THEN - DEALLOCATE(DiscStateData%Vx_wake) -ENDIF -IF (ALLOCATED(DiscStateData%Vr_wake)) THEN - DEALLOCATE(DiscStateData%Vr_wake) -ENDIF -IF (ALLOCATED(DiscStateData%V_plane_filt)) THEN - DEALLOCATE(DiscStateData%V_plane_filt) -ENDIF -IF (ALLOCATED(DiscStateData%Vx_wind_disk_filt)) THEN - DEALLOCATE(DiscStateData%Vx_wind_disk_filt) -ENDIF -IF (ALLOCATED(DiscStateData%TI_amb_filt)) THEN - DEALLOCATE(DiscStateData%TI_amb_filt) -ENDIF -IF (ALLOCATED(DiscStateData%D_rotor_filt)) THEN - DEALLOCATE(DiscStateData%D_rotor_filt) -ENDIF -IF (ALLOCATED(DiscStateData%Ct_azavg_filt)) THEN - DEALLOCATE(DiscStateData%Ct_azavg_filt) -ENDIF -IF (ALLOCATED(DiscStateData%YawErr_filt)) THEN - DEALLOCATE(DiscStateData%YawErr_filt) -ENDIF - END SUBROUTINE WD_DestroyDiscState - - SUBROUTINE WD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! xhat_plane allocated yes/no - IF ( ALLOCATED(InData%xhat_plane) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xhat_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%xhat_plane) ! xhat_plane - END IF - Int_BufSz = Int_BufSz + 1 ! p_plane allocated yes/no - IF ( ALLOCATED(InData%p_plane) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! p_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%p_plane) ! p_plane - END IF - Int_BufSz = Int_BufSz + 1 ! x_plane allocated yes/no - IF ( ALLOCATED(InData%x_plane) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%x_plane) ! x_plane - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_wake allocated yes/no - IF ( ALLOCATED(InData%Vx_wake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vx_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_wake) ! Vx_wake - END IF - Int_BufSz = Int_BufSz + 1 ! Vr_wake allocated yes/no - IF ( ALLOCATED(InData%Vr_wake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vr_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vr_wake) ! Vr_wake - END IF - Int_BufSz = Int_BufSz + 1 ! V_plane_filt allocated yes/no - IF ( ALLOCATED(InData%V_plane_filt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! V_plane_filt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%V_plane_filt) ! V_plane_filt - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_wind_disk_filt allocated yes/no - IF ( ALLOCATED(InData%Vx_wind_disk_filt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vx_wind_disk_filt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_wind_disk_filt) ! Vx_wind_disk_filt - END IF - Int_BufSz = Int_BufSz + 1 ! TI_amb_filt allocated yes/no - IF ( ALLOCATED(InData%TI_amb_filt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TI_amb_filt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI_amb_filt) ! TI_amb_filt - END IF - Int_BufSz = Int_BufSz + 1 ! D_rotor_filt allocated yes/no - IF ( ALLOCATED(InData%D_rotor_filt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! D_rotor_filt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D_rotor_filt) ! D_rotor_filt - END IF - Re_BufSz = Re_BufSz + 1 ! Vx_rel_disk_filt - Int_BufSz = Int_BufSz + 1 ! Ct_azavg_filt allocated yes/no - IF ( ALLOCATED(InData%Ct_azavg_filt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Ct_azavg_filt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Ct_azavg_filt) ! Ct_azavg_filt - END IF - Int_BufSz = Int_BufSz + 1 ! YawErr_filt allocated yes/no - IF ( ALLOCATED(InData%YawErr_filt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! YawErr_filt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%YawErr_filt) ! YawErr_filt - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%xhat_plane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xhat_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xhat_plane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xhat_plane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xhat_plane,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xhat_plane,2), UBOUND(InData%xhat_plane,2) - DO i1 = LBOUND(InData%xhat_plane,1), UBOUND(InData%xhat_plane,1) - ReKiBuf(Re_Xferred) = InData%xhat_plane(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%p_plane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_plane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p_plane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_plane,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%p_plane,2), UBOUND(InData%p_plane,2) - DO i1 = LBOUND(InData%p_plane,1), UBOUND(InData%p_plane,1) - ReKiBuf(Re_Xferred) = InData%p_plane(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%x_plane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_plane,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_plane,1), UBOUND(InData%x_plane,1) - ReKiBuf(Re_Xferred) = InData%x_plane(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_wake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vx_wake,2), UBOUND(InData%Vx_wake,2) - DO i1 = LBOUND(InData%Vx_wake,1), UBOUND(InData%Vx_wake,1) - ReKiBuf(Re_Xferred) = InData%Vx_wake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vr_wake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vr_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vr_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vr_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vr_wake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vr_wake,2), UBOUND(InData%Vr_wake,2) - DO i1 = LBOUND(InData%Vr_wake,1), UBOUND(InData%Vr_wake,1) - ReKiBuf(Re_Xferred) = InData%Vr_wake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%V_plane_filt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_plane_filt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_plane_filt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_plane_filt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_plane_filt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%V_plane_filt,2), UBOUND(InData%V_plane_filt,2) - DO i1 = LBOUND(InData%V_plane_filt,1), UBOUND(InData%V_plane_filt,1) - ReKiBuf(Re_Xferred) = InData%V_plane_filt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_wind_disk_filt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wind_disk_filt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wind_disk_filt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vx_wind_disk_filt,1), UBOUND(InData%Vx_wind_disk_filt,1) - ReKiBuf(Re_Xferred) = InData%Vx_wind_disk_filt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TI_amb_filt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI_amb_filt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_amb_filt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TI_amb_filt,1), UBOUND(InData%TI_amb_filt,1) - ReKiBuf(Re_Xferred) = InData%TI_amb_filt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D_rotor_filt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D_rotor_filt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_rotor_filt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%D_rotor_filt,1), UBOUND(InData%D_rotor_filt,1) - ReKiBuf(Re_Xferred) = InData%D_rotor_filt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Vx_rel_disk_filt - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Ct_azavg_filt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ct_azavg_filt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ct_azavg_filt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Ct_azavg_filt,1), UBOUND(InData%Ct_azavg_filt,1) - ReKiBuf(Re_Xferred) = InData%Ct_azavg_filt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%YawErr_filt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%YawErr_filt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%YawErr_filt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%YawErr_filt,1), UBOUND(InData%YawErr_filt,1) - ReKiBuf(Re_Xferred) = InData%YawErr_filt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE WD_PackDiscState - - SUBROUTINE WD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xhat_plane not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xhat_plane)) DEALLOCATE(OutData%xhat_plane) - ALLOCATE(OutData%xhat_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xhat_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xhat_plane,2), UBOUND(OutData%xhat_plane,2) - DO i1 = LBOUND(OutData%xhat_plane,1), UBOUND(OutData%xhat_plane,1) - OutData%xhat_plane(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p_plane not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%p_plane)) DEALLOCATE(OutData%p_plane) - ALLOCATE(OutData%p_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%p_plane,2), UBOUND(OutData%p_plane,2) - DO i1 = LBOUND(OutData%p_plane,1), UBOUND(OutData%p_plane,1) - OutData%p_plane(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_plane not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x_plane)) DEALLOCATE(OutData%x_plane) - ALLOCATE(OutData%x_plane(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_plane,1), UBOUND(OutData%x_plane,1) - OutData%x_plane(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_wake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vx_wake)) DEALLOCATE(OutData%Vx_wake) - ALLOCATE(OutData%Vx_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vx_wake,2), UBOUND(OutData%Vx_wake,2) - DO i1 = LBOUND(OutData%Vx_wake,1), UBOUND(OutData%Vx_wake,1) - OutData%Vx_wake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vr_wake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vr_wake)) DEALLOCATE(OutData%Vr_wake) - ALLOCATE(OutData%Vr_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vr_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vr_wake,2), UBOUND(OutData%Vr_wake,2) - DO i1 = LBOUND(OutData%Vr_wake,1), UBOUND(OutData%Vr_wake,1) - OutData%Vr_wake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V_plane_filt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%V_plane_filt)) DEALLOCATE(OutData%V_plane_filt) - ALLOCATE(OutData%V_plane_filt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_plane_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%V_plane_filt,2), UBOUND(OutData%V_plane_filt,2) - DO i1 = LBOUND(OutData%V_plane_filt,1), UBOUND(OutData%V_plane_filt,1) - OutData%V_plane_filt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_wind_disk_filt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vx_wind_disk_filt)) DEALLOCATE(OutData%Vx_wind_disk_filt) - ALLOCATE(OutData%Vx_wind_disk_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wind_disk_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vx_wind_disk_filt,1), UBOUND(OutData%Vx_wind_disk_filt,1) - OutData%Vx_wind_disk_filt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI_amb_filt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TI_amb_filt)) DEALLOCATE(OutData%TI_amb_filt) - ALLOCATE(OutData%TI_amb_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_amb_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TI_amb_filt,1), UBOUND(OutData%TI_amb_filt,1) - OutData%TI_amb_filt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_rotor_filt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D_rotor_filt)) DEALLOCATE(OutData%D_rotor_filt) - ALLOCATE(OutData%D_rotor_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_rotor_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%D_rotor_filt,1), UBOUND(OutData%D_rotor_filt,1) - OutData%D_rotor_filt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Vx_rel_disk_filt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ct_azavg_filt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Ct_azavg_filt)) DEALLOCATE(OutData%Ct_azavg_filt) - ALLOCATE(OutData%Ct_azavg_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ct_azavg_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Ct_azavg_filt,1), UBOUND(OutData%Ct_azavg_filt,1) - OutData%Ct_azavg_filt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! YawErr_filt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%YawErr_filt)) DEALLOCATE(OutData%YawErr_filt) - ALLOCATE(OutData%YawErr_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%YawErr_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%YawErr_filt,1), UBOUND(OutData%YawErr_filt,1) - OutData%YawErr_filt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE WD_UnPackDiscState - - SUBROUTINE WD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(WD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE WD_CopyConstrState - - SUBROUTINE WD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(WD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyConstrState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE WD_DestroyConstrState - - SUBROUTINE WD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_PackConstrState - - SUBROUTINE WD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_UnPackConstrState - - SUBROUTINE WD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(WD_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%firstPass = SrcOtherStateData%firstPass - END SUBROUTINE WD_CopyOtherState - - SUBROUTINE WD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(WD_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyOtherState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE WD_DestroyOtherState - - SUBROUTINE WD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! firstPass - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = TRANSFER(InData%firstPass, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE WD_PackOtherState - - SUBROUTINE WD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%firstPass = TRANSFER(IntKiBuf(Int_Xferred), OutData%firstPass) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE WD_UnPackOtherState - - SUBROUTINE WD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(WD_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%dvdr)) THEN - i1_l = LBOUND(SrcMiscData%dvdr,1) - i1_u = UBOUND(SrcMiscData%dvdr,1) - IF (.NOT. ALLOCATED(DstMiscData%dvdr)) THEN - ALLOCATE(DstMiscData%dvdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dvdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dvdr = SrcMiscData%dvdr -ENDIF -IF (ALLOCATED(SrcMiscData%dvtdr)) THEN - i1_l = LBOUND(SrcMiscData%dvtdr,1) - i1_u = UBOUND(SrcMiscData%dvtdr,1) - IF (.NOT. ALLOCATED(DstMiscData%dvtdr)) THEN - ALLOCATE(DstMiscData%dvtdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dvtdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dvtdr = SrcMiscData%dvtdr -ENDIF -IF (ALLOCATED(SrcMiscData%vt_tot)) THEN - i1_l = LBOUND(SrcMiscData%vt_tot,1) - i1_u = UBOUND(SrcMiscData%vt_tot,1) - i2_l = LBOUND(SrcMiscData%vt_tot,2) - i2_u = UBOUND(SrcMiscData%vt_tot,2) - IF (.NOT. ALLOCATED(DstMiscData%vt_tot)) THEN - ALLOCATE(DstMiscData%vt_tot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_tot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vt_tot = SrcMiscData%vt_tot -ENDIF -IF (ALLOCATED(SrcMiscData%vt_amb)) THEN - i1_l = LBOUND(SrcMiscData%vt_amb,1) - i1_u = UBOUND(SrcMiscData%vt_amb,1) - i2_l = LBOUND(SrcMiscData%vt_amb,2) - i2_u = UBOUND(SrcMiscData%vt_amb,2) - IF (.NOT. ALLOCATED(DstMiscData%vt_amb)) THEN - ALLOCATE(DstMiscData%vt_amb(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_amb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vt_amb = SrcMiscData%vt_amb -ENDIF -IF (ALLOCATED(SrcMiscData%vt_shr)) THEN - i1_l = LBOUND(SrcMiscData%vt_shr,1) - i1_u = UBOUND(SrcMiscData%vt_shr,1) - i2_l = LBOUND(SrcMiscData%vt_shr,2) - i2_u = UBOUND(SrcMiscData%vt_shr,2) - IF (.NOT. ALLOCATED(DstMiscData%vt_shr)) THEN - ALLOCATE(DstMiscData%vt_shr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_shr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vt_shr = SrcMiscData%vt_shr -ENDIF -IF (ALLOCATED(SrcMiscData%a)) THEN - i1_l = LBOUND(SrcMiscData%a,1) - i1_u = UBOUND(SrcMiscData%a,1) - IF (.NOT. ALLOCATED(DstMiscData%a)) THEN - ALLOCATE(DstMiscData%a(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%a.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%a = SrcMiscData%a -ENDIF -IF (ALLOCATED(SrcMiscData%b)) THEN - i1_l = LBOUND(SrcMiscData%b,1) - i1_u = UBOUND(SrcMiscData%b,1) - IF (.NOT. ALLOCATED(DstMiscData%b)) THEN - ALLOCATE(DstMiscData%b(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%b.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%b = SrcMiscData%b -ENDIF -IF (ALLOCATED(SrcMiscData%c)) THEN - i1_l = LBOUND(SrcMiscData%c,1) - i1_u = UBOUND(SrcMiscData%c,1) - IF (.NOT. ALLOCATED(DstMiscData%c)) THEN - ALLOCATE(DstMiscData%c(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%c = SrcMiscData%c -ENDIF -IF (ALLOCATED(SrcMiscData%d)) THEN - i1_l = LBOUND(SrcMiscData%d,1) - i1_u = UBOUND(SrcMiscData%d,1) - IF (.NOT. ALLOCATED(DstMiscData%d)) THEN - ALLOCATE(DstMiscData%d(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%d.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%d = SrcMiscData%d -ENDIF -IF (ALLOCATED(SrcMiscData%r_wake)) THEN - i1_l = LBOUND(SrcMiscData%r_wake,1) - i1_u = UBOUND(SrcMiscData%r_wake,1) - IF (.NOT. ALLOCATED(DstMiscData%r_wake)) THEN - ALLOCATE(DstMiscData%r_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%r_wake = SrcMiscData%r_wake -ENDIF -IF (ALLOCATED(SrcMiscData%Vx_high)) THEN - i1_l = LBOUND(SrcMiscData%Vx_high,1) - i1_u = UBOUND(SrcMiscData%Vx_high,1) - IF (.NOT. ALLOCATED(DstMiscData%Vx_high)) THEN - ALLOCATE(DstMiscData%Vx_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vx_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vx_high = SrcMiscData%Vx_high -ENDIF - END SUBROUTINE WD_CopyMisc - - SUBROUTINE WD_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(WD_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyMisc' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(MiscData%dvdr)) THEN - DEALLOCATE(MiscData%dvdr) -ENDIF -IF (ALLOCATED(MiscData%dvtdr)) THEN - DEALLOCATE(MiscData%dvtdr) -ENDIF -IF (ALLOCATED(MiscData%vt_tot)) THEN - DEALLOCATE(MiscData%vt_tot) -ENDIF -IF (ALLOCATED(MiscData%vt_amb)) THEN - DEALLOCATE(MiscData%vt_amb) -ENDIF -IF (ALLOCATED(MiscData%vt_shr)) THEN - DEALLOCATE(MiscData%vt_shr) -ENDIF -IF (ALLOCATED(MiscData%a)) THEN - DEALLOCATE(MiscData%a) -ENDIF -IF (ALLOCATED(MiscData%b)) THEN - DEALLOCATE(MiscData%b) -ENDIF -IF (ALLOCATED(MiscData%c)) THEN - DEALLOCATE(MiscData%c) -ENDIF -IF (ALLOCATED(MiscData%d)) THEN - DEALLOCATE(MiscData%d) -ENDIF -IF (ALLOCATED(MiscData%r_wake)) THEN - DEALLOCATE(MiscData%r_wake) -ENDIF -IF (ALLOCATED(MiscData%Vx_high)) THEN - DEALLOCATE(MiscData%Vx_high) -ENDIF - END SUBROUTINE WD_DestroyMisc - - SUBROUTINE WD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! dvdr allocated yes/no - IF ( ALLOCATED(InData%dvdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dvdr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dvdr) ! dvdr - END IF - Int_BufSz = Int_BufSz + 1 ! dvtdr allocated yes/no - IF ( ALLOCATED(InData%dvtdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dvtdr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dvtdr) ! dvtdr - END IF - Int_BufSz = Int_BufSz + 1 ! vt_tot allocated yes/no - IF ( ALLOCATED(InData%vt_tot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! vt_tot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vt_tot) ! vt_tot - END IF - Int_BufSz = Int_BufSz + 1 ! vt_amb allocated yes/no - IF ( ALLOCATED(InData%vt_amb) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! vt_amb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vt_amb) ! vt_amb - END IF - Int_BufSz = Int_BufSz + 1 ! vt_shr allocated yes/no - IF ( ALLOCATED(InData%vt_shr) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! vt_shr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vt_shr) ! vt_shr - END IF - Int_BufSz = Int_BufSz + 1 ! a allocated yes/no - IF ( ALLOCATED(InData%a) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! a upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%a) ! a - END IF - Int_BufSz = Int_BufSz + 1 ! b allocated yes/no - IF ( ALLOCATED(InData%b) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! b upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%b) ! b - END IF - Int_BufSz = Int_BufSz + 1 ! c allocated yes/no - IF ( ALLOCATED(InData%c) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! c upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%c) ! c - END IF - Int_BufSz = Int_BufSz + 1 ! d allocated yes/no - IF ( ALLOCATED(InData%d) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! d upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%d) ! d - END IF - Int_BufSz = Int_BufSz + 1 ! r_wake allocated yes/no - IF ( ALLOCATED(InData%r_wake) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! r_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_wake) ! r_wake - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_high allocated yes/no - IF ( ALLOCATED(InData%Vx_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vx_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_high) ! Vx_high - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%dvdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dvdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dvdr,1), UBOUND(InData%dvdr,1) - ReKiBuf(Re_Xferred) = InData%dvdr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dvtdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dvtdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvtdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dvtdr,1), UBOUND(InData%dvtdr,1) - ReKiBuf(Re_Xferred) = InData%dvtdr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vt_tot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_tot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_tot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_tot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_tot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%vt_tot,2), UBOUND(InData%vt_tot,2) - DO i1 = LBOUND(InData%vt_tot,1), UBOUND(InData%vt_tot,1) - ReKiBuf(Re_Xferred) = InData%vt_tot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vt_amb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_amb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_amb,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_amb,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_amb,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%vt_amb,2), UBOUND(InData%vt_amb,2) - DO i1 = LBOUND(InData%vt_amb,1), UBOUND(InData%vt_amb,1) - ReKiBuf(Re_Xferred) = InData%vt_amb(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vt_shr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_shr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_shr,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_shr,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_shr,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%vt_shr,2), UBOUND(InData%vt_shr,2) - DO i1 = LBOUND(InData%vt_shr,1), UBOUND(InData%vt_shr,1) - ReKiBuf(Re_Xferred) = InData%vt_shr(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%a) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%a,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%a,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%a,1), UBOUND(InData%a,1) - ReKiBuf(Re_Xferred) = InData%a(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%b) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%b,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%b,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%b,1), UBOUND(InData%b,1) - ReKiBuf(Re_Xferred) = InData%b(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%c) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%c,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%c,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%c,1), UBOUND(InData%c,1) - ReKiBuf(Re_Xferred) = InData%c(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%d) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%d,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%d,1), UBOUND(InData%d,1) - ReKiBuf(Re_Xferred) = InData%d(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%r_wake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_wake,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%r_wake,1), UBOUND(InData%r_wake,1) - ReKiBuf(Re_Xferred) = InData%r_wake(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_high) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vx_high,1), UBOUND(InData%Vx_high,1) - ReKiBuf(Re_Xferred) = InData%Vx_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE WD_PackMisc - - SUBROUTINE WD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dvdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dvdr)) DEALLOCATE(OutData%dvdr) - ALLOCATE(OutData%dvdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dvdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dvdr,1), UBOUND(OutData%dvdr,1) - OutData%dvdr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dvtdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dvtdr)) DEALLOCATE(OutData%dvtdr) - ALLOCATE(OutData%dvtdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dvtdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dvtdr,1), UBOUND(OutData%dvtdr,1) - OutData%dvtdr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vt_tot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%vt_tot)) DEALLOCATE(OutData%vt_tot) - ALLOCATE(OutData%vt_tot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_tot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%vt_tot,2), UBOUND(OutData%vt_tot,2) - DO i1 = LBOUND(OutData%vt_tot,1), UBOUND(OutData%vt_tot,1) - OutData%vt_tot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vt_amb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%vt_amb)) DEALLOCATE(OutData%vt_amb) - ALLOCATE(OutData%vt_amb(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_amb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%vt_amb,2), UBOUND(OutData%vt_amb,2) - DO i1 = LBOUND(OutData%vt_amb,1), UBOUND(OutData%vt_amb,1) - OutData%vt_amb(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vt_shr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%vt_shr)) DEALLOCATE(OutData%vt_shr) - ALLOCATE(OutData%vt_shr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_shr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%vt_shr,2), UBOUND(OutData%vt_shr,2) - DO i1 = LBOUND(OutData%vt_shr,1), UBOUND(OutData%vt_shr,1) - OutData%vt_shr(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! a not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%a)) DEALLOCATE(OutData%a) - ALLOCATE(OutData%a(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%a.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%a,1), UBOUND(OutData%a,1) - OutData%a(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! b not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%b)) DEALLOCATE(OutData%b) - ALLOCATE(OutData%b(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%b.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%b,1), UBOUND(OutData%b,1) - OutData%b(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! c not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%c)) DEALLOCATE(OutData%c) - ALLOCATE(OutData%c(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%c,1), UBOUND(OutData%c,1) - OutData%c(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! d not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%d)) DEALLOCATE(OutData%d) - ALLOCATE(OutData%d(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%d.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%d,1), UBOUND(OutData%d,1) - OutData%d(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_wake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%r_wake)) DEALLOCATE(OutData%r_wake) - ALLOCATE(OutData%r_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%r_wake,1), UBOUND(OutData%r_wake,1) - OutData%r_wake(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_high not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vx_high)) DEALLOCATE(OutData%Vx_high) - ALLOCATE(OutData%Vx_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vx_high,1), UBOUND(OutData%Vx_high,1) - OutData%Vx_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE WD_UnPackMisc - - SUBROUTINE WD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(WD_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%dt_low = SrcParamData%dt_low - DstParamData%NumPlanes = SrcParamData%NumPlanes - DstParamData%NumRadii = SrcParamData%NumRadii - DstParamData%dr = SrcParamData%dr -IF (ALLOCATED(SrcParamData%r)) THEN - i1_l = LBOUND(SrcParamData%r,1) - i1_u = UBOUND(SrcParamData%r,1) - IF (.NOT. ALLOCATED(DstParamData%r)) THEN - ALLOCATE(DstParamData%r(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%r = SrcParamData%r -ENDIF - DstParamData%filtParam = SrcParamData%filtParam - DstParamData%oneMinusFiltParam = SrcParamData%oneMinusFiltParam - DstParamData%C_HWkDfl_O = SrcParamData%C_HWkDfl_O - DstParamData%C_HWkDfl_OY = SrcParamData%C_HWkDfl_OY - DstParamData%C_HWkDfl_x = SrcParamData%C_HWkDfl_x - DstParamData%C_HWkDfl_xY = SrcParamData%C_HWkDfl_xY - DstParamData%C_NearWake = SrcParamData%C_NearWake - DstParamData%C_vAmb_DMin = SrcParamData%C_vAmb_DMin - DstParamData%C_vAmb_DMax = SrcParamData%C_vAmb_DMax - DstParamData%C_vAmb_FMin = SrcParamData%C_vAmb_FMin - DstParamData%C_vAmb_Exp = SrcParamData%C_vAmb_Exp - DstParamData%C_vShr_DMin = SrcParamData%C_vShr_DMin - DstParamData%C_vShr_DMax = SrcParamData%C_vShr_DMax - DstParamData%C_vShr_FMin = SrcParamData%C_vShr_FMin - DstParamData%C_vShr_Exp = SrcParamData%C_vShr_Exp - DstParamData%k_vAmb = SrcParamData%k_vAmb - DstParamData%k_vShr = SrcParamData%k_vShr - DstParamData%Mod_WakeDiam = SrcParamData%Mod_WakeDiam - DstParamData%C_WakeDiam = SrcParamData%C_WakeDiam - END SUBROUTINE WD_CopyParam - - SUBROUTINE WD_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(WD_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyParam' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ParamData%r)) THEN - DEALLOCATE(ParamData%r) -ENDIF - END SUBROUTINE WD_DestroyParam - - SUBROUTINE WD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! dt_low - Int_BufSz = Int_BufSz + 1 ! NumPlanes - Int_BufSz = Int_BufSz + 1 ! NumRadii - Re_BufSz = Re_BufSz + 1 ! dr - Int_BufSz = Int_BufSz + 1 ! r allocated yes/no - IF ( ALLOCATED(InData%r) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! r upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r) ! r - END IF - Re_BufSz = Re_BufSz + 1 ! filtParam - Re_BufSz = Re_BufSz + 1 ! oneMinusFiltParam - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_O - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_OY - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_x - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_xY - Re_BufSz = Re_BufSz + 1 ! C_NearWake - Re_BufSz = Re_BufSz + 1 ! C_vAmb_DMin - Re_BufSz = Re_BufSz + 1 ! C_vAmb_DMax - Re_BufSz = Re_BufSz + 1 ! C_vAmb_FMin - Re_BufSz = Re_BufSz + 1 ! C_vAmb_Exp - Re_BufSz = Re_BufSz + 1 ! C_vShr_DMin - Re_BufSz = Re_BufSz + 1 ! C_vShr_DMax - Re_BufSz = Re_BufSz + 1 ! C_vShr_FMin - Re_BufSz = Re_BufSz + 1 ! C_vShr_Exp - Re_BufSz = Re_BufSz + 1 ! k_vAmb - Re_BufSz = Re_BufSz + 1 ! k_vShr - Int_BufSz = Int_BufSz + 1 ! Mod_WakeDiam - Re_BufSz = Re_BufSz + 1 ! C_WakeDiam - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%dt_low - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPlanes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumRadii - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dr - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%r) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) - ReKiBuf(Re_Xferred) = InData%r(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%filtParam - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%oneMinusFiltParam - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_O - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_OY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_x - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_xY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_NearWake - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_DMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_DMax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_FMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_Exp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_DMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_DMax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_FMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_Exp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_vAmb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_vShr - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Mod_WakeDiam - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_WakeDiam - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_PackParam - - SUBROUTINE WD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dt_low = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumPlanes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumRadii = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%r)) DEALLOCATE(OutData%r) - ALLOCATE(OutData%r(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) - OutData%r(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%filtParam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%oneMinusFiltParam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_O = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_OY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_x = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_xY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_NearWake = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_DMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_DMax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_FMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_Exp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_DMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_DMax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_FMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_Exp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k_vAmb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k_vShr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Mod_WakeDiam = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_WakeDiam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_UnPackParam - - SUBROUTINE WD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_InputType), INTENT(IN) :: SrcInputData - TYPE(WD_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputData%xhat_disk = SrcInputData%xhat_disk - DstInputData%p_hub = SrcInputData%p_hub -IF (ALLOCATED(SrcInputData%V_plane)) THEN - i1_l = LBOUND(SrcInputData%V_plane,1) - i1_u = UBOUND(SrcInputData%V_plane,1) - i2_l = LBOUND(SrcInputData%V_plane,2) - i2_u = UBOUND(SrcInputData%V_plane,2) - IF (.NOT. ALLOCATED(DstInputData%V_plane)) THEN - ALLOCATE(DstInputData%V_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%V_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%V_plane = SrcInputData%V_plane -ENDIF - DstInputData%Vx_wind_disk = SrcInputData%Vx_wind_disk - DstInputData%TI_amb = SrcInputData%TI_amb - DstInputData%D_rotor = SrcInputData%D_rotor - DstInputData%Vx_rel_disk = SrcInputData%Vx_rel_disk -IF (ALLOCATED(SrcInputData%Ct_azavg)) THEN - i1_l = LBOUND(SrcInputData%Ct_azavg,1) - i1_u = UBOUND(SrcInputData%Ct_azavg,1) - IF (.NOT. ALLOCATED(DstInputData%Ct_azavg)) THEN - ALLOCATE(DstInputData%Ct_azavg(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Ct_azavg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Ct_azavg = SrcInputData%Ct_azavg -ENDIF - DstInputData%YawErr = SrcInputData%YawErr - END SUBROUTINE WD_CopyInput - - SUBROUTINE WD_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(WD_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InputData%V_plane)) THEN - DEALLOCATE(InputData%V_plane) -ENDIF -IF (ALLOCATED(InputData%Ct_azavg)) THEN - DEALLOCATE(InputData%Ct_azavg) -ENDIF - END SUBROUTINE WD_DestroyInput - - SUBROUTINE WD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + SIZE(InData%xhat_disk) ! xhat_disk - Re_BufSz = Re_BufSz + SIZE(InData%p_hub) ! p_hub - Int_BufSz = Int_BufSz + 1 ! V_plane allocated yes/no - IF ( ALLOCATED(InData%V_plane) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! V_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%V_plane) ! V_plane - END IF - Re_BufSz = Re_BufSz + 1 ! Vx_wind_disk - Re_BufSz = Re_BufSz + 1 ! TI_amb - Re_BufSz = Re_BufSz + 1 ! D_rotor - Re_BufSz = Re_BufSz + 1 ! Vx_rel_disk - Int_BufSz = Int_BufSz + 1 ! Ct_azavg allocated yes/no - IF ( ALLOCATED(InData%Ct_azavg) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Ct_azavg upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Ct_azavg) ! Ct_azavg - END IF - Re_BufSz = Re_BufSz + 1 ! YawErr - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%xhat_disk,1), UBOUND(InData%xhat_disk,1) - ReKiBuf(Re_Xferred) = InData%xhat_disk(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%p_hub,1), UBOUND(InData%p_hub,1) - ReKiBuf(Re_Xferred) = InData%p_hub(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%V_plane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_plane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_plane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_plane,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%V_plane,2), UBOUND(InData%V_plane,2) - DO i1 = LBOUND(InData%V_plane,1), UBOUND(InData%V_plane,1) - ReKiBuf(Re_Xferred) = InData%V_plane(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Vx_wind_disk - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_amb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%D_rotor - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Vx_rel_disk - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Ct_azavg) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ct_azavg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ct_azavg,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Ct_azavg,1), UBOUND(InData%Ct_azavg,1) - ReKiBuf(Re_Xferred) = InData%Ct_azavg(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%YawErr - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_PackInput - - SUBROUTINE WD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%xhat_disk,1) - i1_u = UBOUND(OutData%xhat_disk,1) - DO i1 = LBOUND(OutData%xhat_disk,1), UBOUND(OutData%xhat_disk,1) - OutData%xhat_disk(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%p_hub,1) - i1_u = UBOUND(OutData%p_hub,1) - DO i1 = LBOUND(OutData%p_hub,1), UBOUND(OutData%p_hub,1) - OutData%p_hub(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V_plane not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%V_plane)) DEALLOCATE(OutData%V_plane) - ALLOCATE(OutData%V_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%V_plane,2), UBOUND(OutData%V_plane,2) - DO i1 = LBOUND(OutData%V_plane,1), UBOUND(OutData%V_plane,1) - OutData%V_plane(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%Vx_wind_disk = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_amb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%D_rotor = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Vx_rel_disk = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ct_azavg not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Ct_azavg)) DEALLOCATE(OutData%Ct_azavg) - ALLOCATE(OutData%Ct_azavg(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ct_azavg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Ct_azavg,1), UBOUND(OutData%Ct_azavg,1) - OutData%Ct_azavg(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%YawErr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_UnPackInput - - SUBROUTINE WD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_OutputType), INTENT(IN) :: SrcOutputData - TYPE(WD_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%xhat_plane)) THEN - i1_l = LBOUND(SrcOutputData%xhat_plane,1) - i1_u = UBOUND(SrcOutputData%xhat_plane,1) - i2_l = LBOUND(SrcOutputData%xhat_plane,2) - i2_u = UBOUND(SrcOutputData%xhat_plane,2) - IF (.NOT. ALLOCATED(DstOutputData%xhat_plane)) THEN - ALLOCATE(DstOutputData%xhat_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%xhat_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%xhat_plane = SrcOutputData%xhat_plane -ENDIF -IF (ALLOCATED(SrcOutputData%p_plane)) THEN - i1_l = LBOUND(SrcOutputData%p_plane,1) - i1_u = UBOUND(SrcOutputData%p_plane,1) - i2_l = LBOUND(SrcOutputData%p_plane,2) - i2_u = UBOUND(SrcOutputData%p_plane,2) - IF (.NOT. ALLOCATED(DstOutputData%p_plane)) THEN - ALLOCATE(DstOutputData%p_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%p_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%p_plane = SrcOutputData%p_plane -ENDIF -IF (ALLOCATED(SrcOutputData%Vx_wake)) THEN - i1_l = LBOUND(SrcOutputData%Vx_wake,1) - i1_u = UBOUND(SrcOutputData%Vx_wake,1) - i2_l = LBOUND(SrcOutputData%Vx_wake,2) - i2_u = UBOUND(SrcOutputData%Vx_wake,2) - IF (.NOT. ALLOCATED(DstOutputData%Vx_wake)) THEN - ALLOCATE(DstOutputData%Vx_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vx_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vx_wake = SrcOutputData%Vx_wake -ENDIF -IF (ALLOCATED(SrcOutputData%Vr_wake)) THEN - i1_l = LBOUND(SrcOutputData%Vr_wake,1) - i1_u = UBOUND(SrcOutputData%Vr_wake,1) - i2_l = LBOUND(SrcOutputData%Vr_wake,2) - i2_u = UBOUND(SrcOutputData%Vr_wake,2) - IF (.NOT. ALLOCATED(DstOutputData%Vr_wake)) THEN - ALLOCATE(DstOutputData%Vr_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vr_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vr_wake = SrcOutputData%Vr_wake -ENDIF -IF (ALLOCATED(SrcOutputData%D_wake)) THEN - i1_l = LBOUND(SrcOutputData%D_wake,1) - i1_u = UBOUND(SrcOutputData%D_wake,1) - IF (.NOT. ALLOCATED(DstOutputData%D_wake)) THEN - ALLOCATE(DstOutputData%D_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%D_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%D_wake = SrcOutputData%D_wake -ENDIF -IF (ALLOCATED(SrcOutputData%x_plane)) THEN - i1_l = LBOUND(SrcOutputData%x_plane,1) - i1_u = UBOUND(SrcOutputData%x_plane,1) - IF (.NOT. ALLOCATED(DstOutputData%x_plane)) THEN - ALLOCATE(DstOutputData%x_plane(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%x_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%x_plane = SrcOutputData%x_plane -ENDIF - END SUBROUTINE WD_CopyOutput - - SUBROUTINE WD_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(WD_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(OutputData%xhat_plane)) THEN - DEALLOCATE(OutputData%xhat_plane) -ENDIF -IF (ALLOCATED(OutputData%p_plane)) THEN - DEALLOCATE(OutputData%p_plane) -ENDIF -IF (ALLOCATED(OutputData%Vx_wake)) THEN - DEALLOCATE(OutputData%Vx_wake) -ENDIF -IF (ALLOCATED(OutputData%Vr_wake)) THEN - DEALLOCATE(OutputData%Vr_wake) -ENDIF -IF (ALLOCATED(OutputData%D_wake)) THEN - DEALLOCATE(OutputData%D_wake) -ENDIF -IF (ALLOCATED(OutputData%x_plane)) THEN - DEALLOCATE(OutputData%x_plane) -ENDIF - END SUBROUTINE WD_DestroyOutput - - SUBROUTINE WD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! xhat_plane allocated yes/no - IF ( ALLOCATED(InData%xhat_plane) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xhat_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%xhat_plane) ! xhat_plane - END IF - Int_BufSz = Int_BufSz + 1 ! p_plane allocated yes/no - IF ( ALLOCATED(InData%p_plane) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! p_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%p_plane) ! p_plane - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_wake allocated yes/no - IF ( ALLOCATED(InData%Vx_wake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vx_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_wake) ! Vx_wake - END IF - Int_BufSz = Int_BufSz + 1 ! Vr_wake allocated yes/no - IF ( ALLOCATED(InData%Vr_wake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vr_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vr_wake) ! Vr_wake - END IF - Int_BufSz = Int_BufSz + 1 ! D_wake allocated yes/no - IF ( ALLOCATED(InData%D_wake) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! D_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D_wake) ! D_wake - END IF - Int_BufSz = Int_BufSz + 1 ! x_plane allocated yes/no - IF ( ALLOCATED(InData%x_plane) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%x_plane) ! x_plane - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%xhat_plane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xhat_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xhat_plane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xhat_plane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xhat_plane,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xhat_plane,2), UBOUND(InData%xhat_plane,2) - DO i1 = LBOUND(InData%xhat_plane,1), UBOUND(InData%xhat_plane,1) - ReKiBuf(Re_Xferred) = InData%xhat_plane(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%p_plane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_plane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p_plane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_plane,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%p_plane,2), UBOUND(InData%p_plane,2) - DO i1 = LBOUND(InData%p_plane,1), UBOUND(InData%p_plane,1) - ReKiBuf(Re_Xferred) = InData%p_plane(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_wake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vx_wake,2), UBOUND(InData%Vx_wake,2) - DO i1 = LBOUND(InData%Vx_wake,1), UBOUND(InData%Vx_wake,1) - ReKiBuf(Re_Xferred) = InData%Vx_wake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vr_wake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vr_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vr_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vr_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vr_wake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vr_wake,2), UBOUND(InData%Vr_wake,2) - DO i1 = LBOUND(InData%Vr_wake,1), UBOUND(InData%Vr_wake,1) - ReKiBuf(Re_Xferred) = InData%Vr_wake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D_wake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_wake,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%D_wake,1), UBOUND(InData%D_wake,1) - ReKiBuf(Re_Xferred) = InData%D_wake(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%x_plane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_plane,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_plane,1), UBOUND(InData%x_plane,1) - ReKiBuf(Re_Xferred) = InData%x_plane(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE WD_PackOutput - - SUBROUTINE WD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xhat_plane not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xhat_plane)) DEALLOCATE(OutData%xhat_plane) - ALLOCATE(OutData%xhat_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xhat_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xhat_plane,2), UBOUND(OutData%xhat_plane,2) - DO i1 = LBOUND(OutData%xhat_plane,1), UBOUND(OutData%xhat_plane,1) - OutData%xhat_plane(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p_plane not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%p_plane)) DEALLOCATE(OutData%p_plane) - ALLOCATE(OutData%p_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%p_plane,2), UBOUND(OutData%p_plane,2) - DO i1 = LBOUND(OutData%p_plane,1), UBOUND(OutData%p_plane,1) - OutData%p_plane(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_wake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vx_wake)) DEALLOCATE(OutData%Vx_wake) - ALLOCATE(OutData%Vx_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vx_wake,2), UBOUND(OutData%Vx_wake,2) - DO i1 = LBOUND(OutData%Vx_wake,1), UBOUND(OutData%Vx_wake,1) - OutData%Vx_wake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vr_wake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vr_wake)) DEALLOCATE(OutData%Vr_wake) - ALLOCATE(OutData%Vr_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vr_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vr_wake,2), UBOUND(OutData%Vr_wake,2) - DO i1 = LBOUND(OutData%Vr_wake,1), UBOUND(OutData%Vr_wake,1) - OutData%Vr_wake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_wake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D_wake)) DEALLOCATE(OutData%D_wake) - ALLOCATE(OutData%D_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%D_wake,1), UBOUND(OutData%D_wake,1) - OutData%D_wake(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_plane not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x_plane)) DEALLOCATE(OutData%x_plane) - ALLOCATE(OutData%x_plane(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_plane,1), UBOUND(OutData%x_plane,1) - OutData%x_plane(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE WD_UnPackOutput - -END MODULE WakeDynamics_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/OpenFAST/reg_tests/CMakeLists.txt b/OpenFAST/reg_tests/CMakeLists.txt deleted file mode 100644 index cd739e00e..000000000 --- a/OpenFAST/reg_tests/CMakeLists.txt +++ /dev/null @@ -1,160 +0,0 @@ -# -# 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. -# - -# ----------------------------------------------------------- -# -- OpenFAST Testing -# ----------------------------------------------------------- - -cmake_minimum_required(VERSION 2.8.12) -project(OpenFAST_RegressionTest Fortran) - -include(CTest) - -# Store the CTest build directory -set(CTEST_BINARY_DIR "${CMAKE_BINARY_DIR}/reg_tests") - -# Verify that the test data submodule exists -if(NOT EXISTS "${CMAKE_CURRENT_LIST_DIR}/r-test") - message(FATAL_ERROR "CMake cannot find the test data directory, r-test. Did you initialize the git submodule?" ) -endif() - -# Set the default plotting flag to OFF -option(CTEST_PLOT_ERRORS "Generate plots of regression test errors." OFF) - -# Set the OpenFAST executable configuration option and default -set(CTEST_OPENFAST_EXECUTABLE "${CMAKE_BINARY_DIR}/glue-codes/openfast/openfast" CACHE FILEPATH "Specify the OpenFAST executable to use in testing.") - -if(BUILD_OPENFAST_CPP_API) - # Set the OpenFAST executable configuration option and default - set(CTEST_OPENFASTCPP_EXECUTABLE "${CMAKE_BINARY_DIR}/glue-codes/openfast-cpp/openfastcpp" CACHE FILEPATH "Specify the OpenFAST C++ executable to use in testing.") -endif() - -# Set the FASTFarm executable configuration option and default -set(CTEST_FASTFARM_EXECUTABLE "${CMAKE_BINARY_DIR}/glue-codes/fast-farm/FAST.Farm" CACHE FILEPATH "Specify the FASTFarm executable to use in testing.") - -# Set the AeroDyn executable configuration option and default -set(CTEST_AERODYN_EXECUTABLE "${CMAKE_BINARY_DIR}/modules/aerodyn/aerodyn_driver" CACHE FILEPATH "Specify the AeroDyn driver executable to use in testing.") - -# Set the BeamDyn executable configuration option and default -set(CTEST_BEAMDYN_EXECUTABLE "${CMAKE_BINARY_DIR}/modules/beamdyn/beamdyn_driver" CACHE FILEPATH "Specify the BeamDyn driver executable to use in testing.") - -# Set the HydroDyn executable configuration option and default -set(CTEST_HYDRODYN_EXECUTABLE "${CMAKE_BINARY_DIR}/modules/hydrodyn/hydrodyn_driver" CACHE FILEPATH "Specify the HydroDyn driver executable to use in testing.") - -# Set the SubDyn executable configuration option and default -set(CTEST_SUBDYN_EXECUTABLE "${CMAKE_BINARY_DIR}/modules/subdyn/subdyn_driver" CACHE FILEPATH "Specify the SubDyn driver executable to use in testing.") - -# Set the python executable configuration option and default -if(NOT EXISTS ${PYTHON_EXECUTABLE}) - find_program(PYTHON_EXECUTABLE NAMES python3 python py) - if(NOT EXISTS ${PYTHON_EXECUTABLE}) - message(FATAL_ERROR "CMake cannot find a Python interpreter in your path. Python is required to run OpenFAST tests." ) - endif() -endif() - -# Set the testing tolerance -set(CTEST_REGRESSION_TOL "0.00001" CACHE STRING "Set the tolerance for the regression test. Leave empty to automatically set.") -if(NOT ${CTEST_REGRESSION_TOL} STREQUAL "") - set(TOLERANCE ${CTEST_REGRESSION_TOL}) -else(NOT ${CTEST_REGRESSION_TOL} STREQUAL "") - set(TOLERANCE 0.00001) -endif() - -# include the r-test cmake projects (servodyn controllers) -add_subdirectory("${CMAKE_CURRENT_LIST_DIR}/r-test") - -# build and seed the test directories with the data they need to run the tests -file(MAKE_DIRECTORY ${CTEST_BINARY_DIR}) -foreach(regTest glue-codes/openfast glue-codes/openfast-cpp modules/aerodyn modules/beamdyn modules/hydrodyn modules/subdyn) - file(MAKE_DIRECTORY ${CTEST_BINARY_DIR}/${regTest}) -endforeach() - -## openfast seed -foreach(turbineDirectory 5MW_Baseline AOC AWT27 SWRT UAE_VI WP_Baseline) - file(COPY "${CMAKE_CURRENT_LIST_DIR}/r-test/glue-codes/openfast/${turbineDirectory}" - DESTINATION "${CTEST_BINARY_DIR}/glue-codes/openfast/") -endforeach() - -foreach(turbineDirectory 5MW_Baseline) - file(COPY "${CMAKE_CURRENT_LIST_DIR}/r-test/glue-codes/openfast/${turbineDirectory}" - DESTINATION "${CTEST_BINARY_DIR}/glue-codes/python/") -endforeach() - -## fastfarm seed -foreach(turbineDirectory 5MW_Baseline) - file(COPY "${CMAKE_CURRENT_LIST_DIR}/r-test/glue-codes/fast-farm/${turbineDirectory}" - DESTINATION "${CTEST_BINARY_DIR}/glue-codes/fast-farm/") -endforeach() - -# add the tests -include(${CMAKE_CURRENT_LIST_DIR}/CTestList.cmake) - -# Copy the DISCON controllers to the 5MW turbine directories -set(src "${CMAKE_CURRENT_LIST_DIR}/r-test/glue-codes/openfast/5MW_Baseline/ServoData") - -set(of_dest "${CTEST_BINARY_DIR}/glue-codes/openfast/5MW_Baseline/ServoData/") -add_custom_command( - OUTPUT "${of_dest}/DISCON.dll" - DEPENDS DISCON - COMMAND "${CMAKE_COMMAND}" -E copy "${src}/DISCON/build/DISCON.dll" "${of_dest}" -) -add_custom_command( - OUTPUT "${of_dest}/DISCON_ITIBarge.dll" - DEPENDS DISCON_ITIBarge - COMMAND "${CMAKE_COMMAND}" -E copy "${src}/DISCON_ITI/build/DISCON_ITIBarge.dll" "${of_dest}" - ) -add_custom_command( - OUTPUT "${of_dest}/DISCON_OC3Hywind.dll" - DEPENDS DISCON_OC3Hywind - COMMAND "${CMAKE_COMMAND}" -E copy "${src}/DISCON_OC3/build/DISCON_OC3Hywind.dll" "${of_dest}" -) -set(ofpy_dest "${CTEST_BINARY_DIR}/glue-codes/python/5MW_Baseline/ServoData/") -add_custom_command( - OUTPUT "${ofpy_dest}/DISCON.dll" - DEPENDS DISCON - COMMAND "${CMAKE_COMMAND}" -E copy "${src}/DISCON/build/DISCON.dll" "${ofpy_dest}" -) - - -set(ff_dest "${CTEST_BINARY_DIR}/glue-codes/fast-farm/5MW_Baseline/ServoData/") -add_custom_command( - OUTPUT "${ff_dest}/DISCON_WT1.dll" - DEPENDS DISCON - COMMAND "${CMAKE_COMMAND}" -E copy "${src}/DISCON/build/DISCON.dll" "${ff_dest}/DISCON_WT1.dll" -) -add_custom_command( - OUTPUT "${ff_dest}/DISCON_WT2.dll" - DEPENDS DISCON - COMMAND "${CMAKE_COMMAND}" -E copy "${src}/DISCON/build/DISCON.dll" "${ff_dest}/DISCON_WT2.dll" -) -add_custom_command( - OUTPUT "${ff_dest}/DISCON_WT3.dll" - DEPENDS DISCON - COMMAND "${CMAKE_COMMAND}" -E copy "${src}/DISCON/build/DISCON.dll" "${ff_dest}/DISCON_WT3.dll" -) - -add_custom_target( - regression_tests - DEPENDS - openfast - "${of_dest}/DISCON.dll" - "${of_dest}/DISCON_ITIBarge.dll" - "${of_dest}/DISCON_OC3Hywind.dll" - "${ofpy_dest}/DISCON.dll" - "${ff_dest}/DISCON_WT1.dll" - "${ff_dest}/DISCON_WT2.dll" - "${ff_dest}/DISCON_WT3.dll" -) diff --git a/OpenFAST/reg_tests/CTestList.cmake b/OpenFAST/reg_tests/CTestList.cmake deleted file mode 100644 index 15359fec2..000000000 --- a/OpenFAST/reg_tests/CTestList.cmake +++ /dev/null @@ -1,232 +0,0 @@ -# -# 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. -# - -#=============================================================================== -# Generic test functions -#=============================================================================== - -function(regression TEST_SCRIPT EXECUTABLE SOURCE_DIRECTORY BUILD_DIRECTORY TESTNAME LABEL) - file(TO_NATIVE_PATH "${PYTHON_EXECUTABLE}" PYTHON_EXECUTABLE) - - file(TO_NATIVE_PATH "${EXECUTABLE}" EXECUTABLE) - file(TO_NATIVE_PATH "${TEST_SCRIPT}" TEST_SCRIPT) - file(TO_NATIVE_PATH "${SOURCE_DIRECTORY}" SOURCE_DIRECTORY) - file(TO_NATIVE_PATH "${BUILD_DIRECTORY}" BUILD_DIRECTORY) - - string(REPLACE "\\" "\\\\" EXECUTABLE ${EXECUTABLE}) - string(REPLACE "\\" "\\\\" TEST_SCRIPT ${TEST_SCRIPT}) - string(REPLACE "\\" "\\\\" SOURCE_DIRECTORY ${SOURCE_DIRECTORY}) - string(REPLACE "\\" "\\\\" BUILD_DIRECTORY ${BUILD_DIRECTORY}) - - set(PLOT_FLAG "") - if(CTEST_PLOT_ERRORS) - set(PLOT_FLAG "-p") - endif() - - add_test( - ${TESTNAME} ${PYTHON_EXECUTABLE} - ${TEST_SCRIPT} - ${TESTNAME} - ${EXECUTABLE} - ${SOURCE_DIRECTORY} # openfast source directory - ${BUILD_DIRECTORY} # build directory for test - ${TOLERANCE} - ${CMAKE_SYSTEM_NAME} # [Darwin,Linux,Windows] - ${CMAKE_Fortran_COMPILER_ID} # [Intel,GNU] - ${PLOT_FLAG} # empty or "-p" - ) - # limit each test to 90 minutes: 5400s - set_tests_properties(${TESTNAME} PROPERTIES TIMEOUT 5400 WORKING_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}" LABELS "${LABEL}") -endfunction(regression) - -#=============================================================================== -# Module specific regression test calls -#=============================================================================== - -# openfast -function(of_regression TESTNAME LABEL) - set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeOpenfastRegressionCase.py") - set(OPENFAST_EXECUTABLE "${CTEST_OPENFAST_EXECUTABLE}") - set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") - set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/glue-codes/openfast") - regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${TESTNAME} "${LABEL}") -endfunction(of_regression) - -# openfast aeroacoustic -function(of_regression_aeroacoustic TESTNAME LABEL) - set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeOpenfastAeroAcousticRegressionCase.py") - set(OPENFAST_EXECUTABLE "${CTEST_OPENFAST_EXECUTABLE}") - set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") - set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/glue-codes/openfast") - regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${TESTNAME} "${LABEL}") -endfunction(of_regression_aeroacoustic) - -# FAST Farm -function(ff_regression TESTNAME LABEL) - set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeFASTFarmRegressionCase.py") - set(FASTFARM_EXECUTABLE "${CTEST_FASTFARM_EXECUTABLE}") - set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") - set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/glue-codes/fast-farm") - regression(${TEST_SCRIPT} ${FASTFARM_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${TESTNAME} "${LABEL}") -endfunction(ff_regression) - -# openfast linearized -function(of_regression_linear TESTNAME LABEL) - set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeOpenfastLinearRegressionCase.py") - set(OPENFAST_EXECUTABLE "${CTEST_OPENFAST_EXECUTABLE}") - set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") - set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/glue-codes/openfast") - regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${TESTNAME} "${LABEL}") -endfunction(of_regression_linear) - -# openfast C++ interface -function(of_regression_cpp TESTNAME LABEL) - set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeOpenfastCppRegressionCase.py") - set(OPENFAST_CPP_EXECUTABLE "${CTEST_OPENFASTCPP_EXECUTABLE}") - set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") - set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/glue-codes/openfast-cpp") - regression(${TEST_SCRIPT} ${OPENFAST_CPP_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${TESTNAME} "${LABEL}") -endfunction(of_regression_cpp) - -# openfast Python-interface -function(of_regression_py TESTNAME LABEL) - set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executePythonRegressionCase.py") - set(EXECUTABLE "None") - set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") - set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/glue-codes/python") - regression(${TEST_SCRIPT} ${EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${TESTNAME} "${LABEL}") -endfunction(of_regression_py) - -# aerodyn -function(ad_regression TESTNAME LABEL) - set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeAerodynRegressionCase.py") - set(AERODYN_EXECUTABLE "${CTEST_AERODYN_EXECUTABLE}") - set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") - set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/aerodyn") - regression(${TEST_SCRIPT} ${AERODYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${TESTNAME} "${LABEL}") -endfunction(ad_regression) - -# beamdyn -function(bd_regression TESTNAME LABEL) - set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeBeamdynRegressionCase.py") - set(BEAMDYN_EXECUTABLE "${CTEST_BEAMDYN_EXECUTABLE}") - set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") - set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/beamdyn") - regression(${TEST_SCRIPT} ${BEAMDYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${TESTNAME} "${LABEL}") -endfunction(bd_regression) - -# hydrodyn -function(hd_regression TESTNAME LABEL) - set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeHydrodynRegressionCase.py") - set(HYDRODYN_EXECUTABLE "${CTEST_HYDRODYN_EXECUTABLE}") - set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") - set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/hydrodyn") - regression(${TEST_SCRIPT} ${HYDRODYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${TESTNAME} "${LABEL}") -endfunction(hd_regression) - -# subdyn -function(sd_regression TESTNAME LABEL) - set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeSubdynRegressionCase.py") - set(SUBDYN_EXECUTABLE "${CTEST_SUBDYN_EXECUTABLE}") - set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") - set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/subdyn") - regression(${TEST_SCRIPT} ${SUBDYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${TESTNAME} "${LABEL}") -endfunction(sd_regression) - -#=============================================================================== -# Regression tests -#=============================================================================== - -# OpenFAST regression tests -of_regression("AWT_YFix_WSt" "openfast;elastodyn;aerodyn14;servodyn") -of_regression("AWT_WSt_StartUp_HighSpShutDown" "openfast;elastodyn;aerodyn15;servodyn") -of_regression("AWT_YFree_WSt" "openfast;elastodyn;aerodyn15;servodyn") -of_regression("AWT_YFree_WTurb" "openfast;elastodyn;aerodyn14;servodyn") -of_regression("AWT_WSt_StartUpShutDown" "openfast;elastodyn;aerodyn15;servodyn") -of_regression("AOC_WSt" "openfast;elastodyn;aerodyn14;servodyn") -of_regression("AOC_YFree_WTurb" "openfast;elastodyn;aerodyn15;servodyn") -of_regression("AOC_YFix_WSt" "openfast;elastodyn;aerodyn15;servodyn") -of_regression("UAE_Dnwind_YRamp_WSt" "openfast;elastodyn;aerodyn14;servodyn") -of_regression("UAE_Upwind_Rigid_WRamp_PwrCurve" "openfast;elastodyn;aerodyn15;servodyn") -of_regression("WP_VSP_WTurb_PitchFail" "openfast;elastodyn;aerodyn14;servodyn") -of_regression("WP_VSP_ECD" "openfast;elastodyn;aerodyn15;servodyn") -of_regression("WP_VSP_WTurb" "openfast;elastodyn;aerodyn15;servodyn") -of_regression("SWRT_YFree_VS_EDG01" "openfast;elastodyn;aerodyn15;servodyn") -of_regression("SWRT_YFree_VS_EDC01" "openfast;elastodyn;aerodyn14;servodyn") -of_regression("SWRT_YFree_VS_WTurb" "openfast;elastodyn;aerodyn14;servodyn") -of_regression("5MW_Land_DLL_WTurb" "openfast;elastodyn;aerodyn15;servodyn") -of_regression("5MW_OC3Mnpl_DLL_WTurb_WavesIrr" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;subdyn;offshore") -of_regression("5MW_OC3Trpd_DLL_WSt_WavesReg" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;subdyn;offshore") -of_regression("5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;subdyn;offshore") -of_regression("5MW_ITIBarge_DLL_WTurb_WavesIrr" "openfast;elastodyn;aerodyn14;servodyn;hydrodyn;map;offshore") -of_regression("5MW_TLP_DLL_WTurb_WavesIrr_WavesMulti" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;map;offshore") -of_regression("5MW_OC3Spar_DLL_WTurb_WavesIrr" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;map;offshore") -of_regression("5MW_OC4Semi_WSt_WavesWN" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;moordyn;offshore") -of_regression("5MW_Land_BD_DLL_WTurb" "openfast;beamdyn;aerodyn15;servodyn") -of_regression("5MW_OC4Jckt_ExtPtfm" "openfast;elastodyn;extptfm") -of_regression("HelicalWake_OLAF" "openfast;aerodyn15;olaf") -of_regression("EllipticalWing_OLAF" "openfast;aerodyn15;olaf") -of_regression("StC_test_OC4Semi" "openfast;servodyn;hydrodyn;moordyn;offshore") - -# OpenFAST C++ API test -if(BUILD_OPENFAST_CPP_API) - of_regression_cpp("5MW_Land_DLL_WTurb_cpp" "openfast;openfastlib;cpp") -endif() - -# OpenFAST Python API test -of_regression_py("5MW_Land_DLL_WTurb_py" "openfast;openfastlib;python") - -# AeroAcoustic regression test -of_regression_aeroacoustic("IEA_LB_RWT-AeroAcoustics" "openfast;aerodyn15;aeroacoustics") - -# Linearized OpenFAST regression tests -of_regression_linear("WP_Stationary_Linear" "openfast;linear;elastodyn") -of_regression_linear("Ideal_Beam_Fixed_Free_Linear" "openfast;linear;beamdyn") -of_regression_linear("Ideal_Beam_Free_Free_Linear" "openfast;linear;beamdyn") -of_regression_linear("5MW_Land_BD_Linear" "openfast;linear;beamdyn;servodyn") -of_regression_linear("5MW_OC4Semi_Linear" "openfast;linear;hydrodyn;servodyn") - -# FAST Farm regression tests -if(BUILD_FASTFARM) - ff_regression("TSinflow" "fastfarm") - ff_regression("LESinflow" "fastfarm") -endif() - -# AeroDyn regression tests -ad_regression("ad_timeseries_shutdown" "aerodyn;bem") - -# BeamDyn regression tests -bd_regression("bd_5MW_dynamic" "beamdyn;dynamic") -bd_regression("bd_5MW_dynamic_gravity_Az00" "beamdyn;dynamic") -bd_regression("bd_5MW_dynamic_gravity_Az90" "beamdyn;dynamic") -bd_regression("bd_curved_beam" "beamdyn;static") -bd_regression("bd_isotropic_rollup" "beamdyn;static") -bd_regression("bd_static_cantilever_beam" "beamdyn;static") -bd_regression("bd_static_twisted_with_k1" "beamdyn;static") - -# HydroDyn regression tests -hd_regression("hd_OC3tripod_offshore_fixedbottom_wavesirr" "hydrodyn;offshore") -hd_regression("hd_5MW_ITIBarge_DLL_WTurb_WavesIrr" "hydrodyn;offshore") -hd_regression("hd_5MW_OC3Spar_DLL_WTurb_WavesIrr" "hydrodyn;offshore") -hd_regression("hd_5MW_OC4Semi_WSt_WavesWN" "hydrodyn;offshore") -hd_regression("hd_5MW_TLP_DLL_WTurb_WavesIrr_WavesMulti" "hydrodyn;offshore") -hd_regression("hd_TaperCylinderPitchMoment" "hydrodyn;offshore") - -# SubDyn regression tests -sd_regression("SD_Cable_5Joints" "subdyn;offshore") -sd_regression("SD_PendulumDamp" "subdyn;offshore") -sd_regression("SD_Rigid" "subdyn;offshore") -sd_regression("SD_SparHanging" "subdyn;offshore") diff --git a/OpenFAST/reg_tests/README.md b/OpenFAST/reg_tests/README.md deleted file mode 100644 index 12f84f2f0..000000000 --- a/OpenFAST/reg_tests/README.md +++ /dev/null @@ -1,88 +0,0 @@ -# openfast/reg_tests - -This directory contains the regression test suite for OpenFAST and its modules. Its contents are listed here and further described below. -- [r-test](https://github.com/openfast/r-test), a standalone repository containing the regression test data -- CMake/CTest configuration files -- Module specific regression test execution scripts -- A `lib` subdirectory with lower level python scripts - -Dependencies required to run the regression test suite are -- Python 3.7+ -- Numpy -- CMake and CTest -- Bokeh 1.4 (optional) - -## Execution -The automated regression test runs CTest and can be executed by running either of the commands `make test` or `ctest` from the build directory. If the entire OpenFAST package is to be built, CMake will configure CTest to find the new binary at `openfast/build/glue-codes/openfast/openfast`. However, if the intention is to build only the test suite, the OpenFAST binary should be specified in the CMake configuration under the `CTEST_OPENFAST_EXECUTABLE` flag. There is also a corresponding `CTEST_[MODULE]_NAME` flag for each module that is included in the regression test. - -The regression test can be executed manually with the included driver `manualRegressionTest.py`. Run `manualRegressionTest.py -h` for usage. - -In both modes of execution a subdirectory is created in the build directory called `reg_tests` where all of the input files for the test cases are copied and all of the locally generated outputs are stored. - -## r-test -This repository serves as a container for regression test data for system level and module level testing of OpenFAST. The repository contains: -- input files for test case execution -- baseline solutions for various machine and compiler combinations -- turbine specific inputs - -The baseline solutions serve as "gold standards" for the regression test suite and are updated periodically as OpenFAST and its modules are improved. - -r-test is brought into OpenFAST as a git submodule and should be initialized after cloning with `git submodule update --init --recursive` or updated with `git submodule update`. - -## CTest/CMake -The configuration files consist of -- CMakeLists.txt -- CTestList.cmake - -#### CMakeLists.txt -This is a CMake file which configures the regression test in the CMake build directory. It should be left untouched unless advanced configuration of CMake or CTest is required. - -#### CTestList.txt -This is the CTest configuration file which lists the test cases that run in the automated test. The test list can be modified as needed by commenting lines with a `#`, but the full regression test consists of all the tests listed in this file. - -## Python Scripts -The included Python scripts are used to execute various parts of the automated regression test, so they should remain in their current location with their current name. Each script can be executed independently. The syntax and options for using the scripts can be found by running each with the `-h` flag. - -#### executeOpenfastRegressionCase.py -This program executes OpenFAST and a regression test 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: `executeOpenfastRegressionCase.py -h` - -#### executeBeamdynRegressionCase.py -This program executes BeamDyn and a regression test 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: `executeBeamdynRegressionCase.py -h` - -#### manualRegressionTest.py -This program executes OpenFAST on all of the CertTest cases. It mimics the -regression test execution through CMake/CTest. All generated data goes into -`openfast/build/reg_tests`. - -Get usage with: `manualRegressionTest.py -h` - -#### lib/errorPlotting.py -This library provides tools for plotting the output channels over time of a -given solution attribute for two OpenFAST solutions, with the second solution -assumed to be the baseline for comparison. There are functions for solution -file I/O, plot creation, and html creation for navigating the plots. - -#### lib/fast_io.py -This program reads OpenFAST structured output files in binary or ascii format -and returns the data in a Numpy array. - -#### lib/openfastDrivers.py -This library provides tools for executing cases with drivers contained in the -OpenFAST framework. Any new drivers should have a corresponding public driver -function called `def run[NewDriver]Case()` in this library. - -#### lib/pass_fail.py -This library provides tools for comparing a test solution to a baseline solution -for any structured output file generated within the OpenFAST framework. - -#### lib/rtestlib.py -This library contains utility functions for the custom python programs making -up the regression test system. diff --git a/OpenFAST/reg_tests/executeAerodynRegressionCase.py b/OpenFAST/reg_tests/executeAerodynRegressionCase.py deleted file mode 100644 index 8bcd869d5..000000000 --- a/OpenFAST/reg_tests/executeAerodynRegressionCase.py +++ /dev/null @@ -1,138 +0,0 @@ -# -# 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 AeroDyn and a regression test 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: `executeAerodynRegressionCase.py -h` -""" - -import os -import sys -basepath = os.path.sep.join(sys.argv[0].split(os.path.sep)[:-1]) if os.path.sep in sys.argv[0] else "." -sys.path.insert(0, os.path.sep.join([basepath, "lib"])) -import argparse -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 OpenFAST and 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="AeroDyn-Driver", type=str, nargs=1, help="The path to the AeroDyn 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("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") -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] -tolerance = args.tolerance[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) - -### 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", "aerodyn") -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,"ad_*inp")): - filename = file.split(os.path.sep)[-1] - shutil.copy(os.path.join(inputsDirectory,filename), os.path.join(testBuildDirectory,filename)) - -### Run aerodyn on the test case -if not noExec: - caseInputFile = os.path.join(testBuildDirectory, "ad_driver.inp") - returnCode = openfastDrivers.runAerodynDriverCase(caseInputFile, executable) - if returnCode != 0: - rtl.exitWithError("") - -### Build the filesystem navigation variables for running the regression test -localOutFile = os.path.join(testBuildDirectory, "ad_driver.out") -baselineOutFile = os.path.join(targetOutputDirectory, "ad_driver.out") -rtl.validateFileOrExit(localOutFile) -rtl.validateFileOrExit(baselineOutFile) - -testData, testInfo, testPack = pass_fail.readFASTOut(localOutFile) -baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) -performance = pass_fail.calculateNorms(testData, baselineData) -normalizedNorm = performance[:, 1] - -# export all case summaries -results = list(zip(testInfo["attribute_names"], [*performance])) -results_max = performance.max(axis=0) -exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) - -# failing case -if not pass_fail.passRegressionTest(normalizedNorm, tolerance): - if plotError: - from errorPlotting import finalizePlotDirectory, plotOpenfastError - ixFailChannels = [i for i in range(len(testInfo["attribute_names"])) if normalizedNorm[i] > tolerance] - failChannels = [channel for i, channel in enumerate(testInfo["attribute_names"]) if i in ixFailChannels] - failResults = [res for i, res in enumerate(results) if i in ixFailChannels] - for channel in failChannels: - try: - plotOpenfastError(localOutFile, baselineOutFile, channel) - except: - error = sys.exc_info()[1] - print("Error generating plots: {}".format(error.msg)) - finalizePlotDirectory(localOutFile, failChannels, caseName) - sys.exit(1) - -# passing case -sys.exit(0) diff --git a/OpenFAST/reg_tests/executeBeamdynRegressionCase.py b/OpenFAST/reg_tests/executeBeamdynRegressionCase.py deleted file mode 100644 index 4aad3fb70..000000000 --- a/OpenFAST/reg_tests/executeBeamdynRegressionCase.py +++ /dev/null @@ -1,137 +0,0 @@ -# -# 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 BeamDyn and a regression test 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: `executeBeamdynRegressionCase.py -h` -""" - -import os -import sys -basepath = os.path.sep.join(sys.argv[0].split(os.path.sep)[:-1]) if os.path.sep in sys.argv[0] else "." -sys.path.insert(0, os.path.sep.join([basepath, "lib"])) -import argparse -import shutil -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 OpenFAST and 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="BeamDyn-Driver", type=str, nargs=1, help="The path to the BeamDyn 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("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") -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] -tolerance = args.tolerance[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) - -### 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", "beamdyn") -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) - shutil.copy(os.path.join(inputsDirectory,"bd_driver.inp"), os.path.join(testBuildDirectory,"bd_driver.inp")) - shutil.copy(os.path.join(inputsDirectory,"bd_primary.inp"), os.path.join(testBuildDirectory,"bd_primary.inp")) - shutil.copy(os.path.join(inputsDirectory,"beam_props.inp"), os.path.join(testBuildDirectory,"beam_props.inp")) - -### Run beamdyn on the test case -if not noExec: - caseInputFile = os.path.join(testBuildDirectory, "bd_driver.inp") - returnCode = openfastDrivers.runBeamdynDriverCase(caseInputFile, executable) - if returnCode != 0: - rtl.exitWithError("") - -### Build the filesystem navigation variables for running the regression test -localOutFile = os.path.join(testBuildDirectory, "bd_driver.out") -baselineOutFile = os.path.join(targetOutputDirectory, "bd_driver.out") -rtl.validateFileOrExit(localOutFile) -rtl.validateFileOrExit(baselineOutFile) - -testData, testInfo, testPack = pass_fail.readFASTOut(localOutFile) -baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) -performance = pass_fail.calculateNorms(testData, baselineData) -normalizedNorm = performance[:, 1] - -# export all case summaries -results = list(zip(testInfo["attribute_names"], [*performance])) -results_max = performance.max(axis=0) -exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) - -# failing case -if not pass_fail.passRegressionTest(normalizedNorm, tolerance): - if plotError: - from errorPlotting import finalizePlotDirectory, plotOpenfastError - ixFailChannels = [i for i in range(len(testInfo["attribute_names"])) if normalizedNorm[i] > tolerance] - failChannels = [channel for i, channel in enumerate(testInfo["attribute_names"]) if i in ixFailChannels] - failResults = [res for i, res in enumerate(results) if i in ixFailChannels] - for channel in failChannels: - try: - plotOpenfastError(localOutFile, baselineOutFile, channel) - except: - error = sys.exc_info()[1] - print("Error generating plots: {}".format(error.msg)) - finalizePlotDirectory(localOutFile, failChannels, caseName) - sys.exit(1) - -# passing case -sys.exit(0) diff --git a/OpenFAST/reg_tests/executeFASTFarmRegressionCase.py b/OpenFAST/reg_tests/executeFASTFarmRegressionCase.py deleted file mode 100644 index 34acdf28c..000000000 --- a/OpenFAST/reg_tests/executeFASTFarmRegressionCase.py +++ /dev/null @@ -1,179 +0,0 @@ -# -# 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 FASTFarm and a regression test 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: `executeFASTFarmRegressionCase.py -h` -""" - -import os -import sys -basepath = os.path.sep.join(sys.argv[0].split(os.path.sep)[:-1]) if os.path.sep in sys.argv[0] else "." -sys.path.insert(0, os.path.sep.join([basepath, "lib"])) -import argparse -import shutil -import subprocess -import rtestlib as rtl -import openfastDrivers -import pass_fail -from errorPlotting import exportCaseSummary - -##### Helper functions -def ignoreBaselineItems(directory, contents): - itemFilter = ['linux-intel', 'linux-gnu', 'macos-gnu', 'windows-intel'] - caught = [] - for c in contents: - if c in itemFilter: - caught.append(c) - return tuple(caught) - -##### Main program - -### Store the python executable for future python calls -pythonCommand = sys.executable - -### Verify input arguments -parser = argparse.ArgumentParser(description="Executes OpenFAST and 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="OpenFAST", type=str, nargs=1, help="The path to the OpenFAST 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("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") -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] -tolerance = args.tolerance[0] -systemName = args.systemName[0] -compilerId = args.compilerId[0] -plotError = args.plot -noExec = args.noExec -verbose = args.verbose - -# validate inputs -rtl.validateExeOrExit(executable) -rtl.validateDirOrExit(sourceDirectory) -if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) - -### Map the system and compiler configurations to a solution set -# Internal names -> Human readable names -systemName_map = { - "darwin": "macos", - "linux": "linux", - "windows": "windows" -} -compilerId_map = { - "gnu": "gnu", - "intel": "intel" -} -# Build the target output directory name or choose the default -supportedBaselines = ["macos-gnu", "linux-intel", "linux-gnu", "windows-intel"] -targetSystem = systemName_map.get(systemName.lower(), "") -targetCompiler = compilerId_map.get(compilerId.lower(), "") -outputType = os.path.join(targetSystem+"-"+targetCompiler) -if outputType not in supportedBaselines: - outputType = supportedBaselines[0] -print("-- Using gold standard files with machine-compiler type {}".format(outputType)) - -### Build the filesystem navigation variables for running openfast on 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", "fast-farm") -inputsDirectory = os.path.join(moduleDirectory, caseName) -targetOutputDirectory = os.path.join(inputsDirectory) #, outputType) -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 -dst = os.path.join(buildDirectory, "5MW_Baseline") -src = os.path.join(moduleDirectory, "5MW_Baseline") -if not os.path.isdir(dst): - shutil.copytree(src, dst) -else: - names = os.listdir(src) - for name in names: - if name == "ServoData": - continue - srcname = os.path.join(src, name) - dstname = os.path.join(dst, name) - if os.path.isdir(srcname): - if not os.path.isdir(dstname): - shutil.copytree(srcname, dstname) - else: - shutil.copy2(srcname, dstname) - -if not os.path.isdir(testBuildDirectory): - shutil.copytree(inputsDirectory, testBuildDirectory, ignore=ignoreBaselineItems) - -### Run openfast on the test case -if not noExec: - caseInputFile = os.path.join(testBuildDirectory, caseName + ".fstf") - returnCode = openfastDrivers.runOpenfastCase(caseInputFile, executable) - if returnCode != 0: - rtl.exitWithError("") - -### Build the filesystem navigation variables for running the regression test -localOutFile = os.path.join(testBuildDirectory, caseName + ".out") -baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".out") -rtl.validateFileOrExit(localOutFile) -rtl.validateFileOrExit(baselineOutFile) - -testData, testInfo, testPack = pass_fail.readFASTOut(localOutFile) -baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) -performance = pass_fail.calculateNorms(testData, baselineData) -normalizedNorm = performance[:, 1] - -# export all case summaries -results = list(zip(testInfo["attribute_names"], [*performance])) -results_max = performance.max(axis=0) -exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) - -# failing case -if not pass_fail.passRegressionTest(normalizedNorm, tolerance): - if plotError: - from errorPlotting import finalizePlotDirectory, plotOpenfastError - for channel in testInfo["attribute_names"]: - try: - plotOpenfastError(localOutFile, baselineOutFile, channel) - except: - error = sys.exc_info()[1] - print("Error generating plots: {}".format(error)) - finalizePlotDirectory(localOutFile, testInfo["attribute_names"], caseName) - - sys.exit(1) - -# passing case -sys.exit(0) diff --git a/OpenFAST/reg_tests/executeHydrodynRegressionCase.py b/OpenFAST/reg_tests/executeHydrodynRegressionCase.py deleted file mode 100644 index 1f559a6a5..000000000 --- a/OpenFAST/reg_tests/executeHydrodynRegressionCase.py +++ /dev/null @@ -1,141 +0,0 @@ -# -# 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 HydroDyn and a regression test 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: `executeHydrodynRegressionCase.py -h` -""" - -import os -import sys -basepath = os.path.sep.join(sys.argv[0].split(os.path.sep)[:-1]) if os.path.sep in sys.argv[0] else "." -sys.path.insert(0, os.path.sep.join([basepath, "lib"])) -import argparse -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 HydroDyn and 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="HydroDyn-Driver", type=str, nargs=1, help="The path to the HydroDyn 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("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") -parser.add_argument("-p", "-plot", dest="plot", default=False, metavar="Plotting-Flag", type=bool, nargs="?", help="bool to include matplotlib plots in failed cases") -parser.add_argument("-n", "-no-exec", dest="noExec", default=False, metavar="No-Execution", type=bool, nargs="?", help="bool to prevent execution of the test cases") -parser.add_argument("-v", "-verbose", dest="verbose", default=False, metavar="Verbose-Flag", type=bool, nargs="?", 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] -tolerance = args.tolerance[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) - -### 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", "hydrodyn") -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,"hd_*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 HydroDyn on the test case -if not noExec: - caseInputFile = os.path.join(testBuildDirectory, "hd_driver.inp") - returnCode = openfastDrivers.runHydrodynDriverCase(caseInputFile, executable) - if returnCode != 0: - rtl.exitWithError("") - -### Build the filesystem navigation variables for running the regression test -localOutFile = os.path.join(testBuildDirectory, "driver.HD.out") -baselineOutFile = os.path.join(targetOutputDirectory, "driver.HD.out") -rtl.validateFileOrExit(localOutFile) -rtl.validateFileOrExit(baselineOutFile) - -testData, testInfo, testPack = pass_fail.readFASTOut(localOutFile) -baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) -performance = pass_fail.calculateNorms(testData, baselineData) -normalizedNorm = performance[:, 1] - -# export all case summaries -results = list(zip(testInfo["attribute_names"], [*performance])) -results_max = performance.max(axis=0) -exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) - -# failing case -if not pass_fail.passRegressionTest(normalizedNorm, tolerance): - if plotError: - from errorPlotting import finalizePlotDirectory, plotOpenfastError - ixFailChannels = [i for i in range(len(testInfo["attribute_names"])) if normalizedNorm[i] > tolerance] - failChannels = [channel for i, channel in enumerate(testInfo["attribute_names"]) if i in ixFailChannels] - failResults = [res for i, res in enumerate(results) if i in ixFailChannels] - for channel in failChannels: - try: - plotOpenfastError(localOutFile, baselineOutFile, channel) - except: - error = sys.exc_info()[1] - print("Error generating plots: {}".format(error.msg)) - finalizePlotDirectory(localOutFile, failChannels, caseName) - sys.exit(1) - -# passing case -sys.exit(0) diff --git a/OpenFAST/reg_tests/executeOpenfastAeroAcousticRegressionCase.py b/OpenFAST/reg_tests/executeOpenfastAeroAcousticRegressionCase.py deleted file mode 100644 index ccb9de8cd..000000000 --- a/OpenFAST/reg_tests/executeOpenfastAeroAcousticRegressionCase.py +++ /dev/null @@ -1,169 +0,0 @@ -# -# 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 OpenFAST and a regression test for a single test case with - the aero-acoustics module in AeroDyn15. - 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: `executeOpenfastAeroAcousticRegressionCase.py -h` -""" - -import os -import sys -basepath = os.path.sep.join(sys.argv[0].split(os.path.sep)[:-1]) if os.path.sep in sys.argv[0] else "." -sys.path.insert(0, os.path.sep.join([basepath, "lib"])) -import argparse -import shutil -import subprocess -import rtestlib as rtl -import openfastDrivers -import pass_fail -from errorPlotting import exportCaseSummary - -##### Helper functions -def ignoreBaselineItems(directory, contents): - itemFilter = ['linux-intel', 'linux-gnu', 'macos-gnu', 'windows-intel'] - caught = [] - for c in contents: - if c in itemFilter: - caught.append(c) - return tuple(caught) - -##### Main program - -### Store the python executable for future python calls -pythonCommand = sys.executable - -### Verify input arguments -parser = argparse.ArgumentParser(description="Executes OpenFAST and 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="OpenFAST", type=str, nargs=1, help="The path to the OpenFAST 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("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") -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] -tolerance = args.tolerance[0] -systemName = args.systemName[0] -compilerId = args.compilerId[0] -plotError = args.plot -noExec = args.noExec -verbose = args.verbose - -# validate inputs -rtl.validateExeOrExit(executable) -rtl.validateDirOrExit(sourceDirectory) -if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) - -### Map the system and compiler configurations to a solution set -# Internal names -> Human readable names -systemName_map = { - "darwin": "macos", - "linux": "linux", - "windows": "windows" -} -compilerId_map = { - "gnu": "gnu", - "intel": "intel" -} -# Build the target output directory name or choose the default -supportedBaselines = ["macos-gnu", "linux-intel", "linux-gnu", "windows-intel"] -targetSystem = systemName_map.get(systemName.lower(), "") -targetCompiler = compilerId_map.get(compilerId.lower(), "") -outputType = os.path.join(targetSystem+"-"+targetCompiler) -if outputType not in supportedBaselines: - outputType = supportedBaselines[0] -print("-- Using gold standard files with machine-compiler type {}".format(outputType)) - -### Build the filesystem navigation variables for running openfast on 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", "openfast") -inputsDirectory = os.path.join(moduleDirectory, caseName) -targetOutputDirectory = os.path.join(inputsDirectory, outputType) -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): - shutil.copytree(inputsDirectory, testBuildDirectory, ignore=ignoreBaselineItems) - -### Run openfast on the test case -if not noExec: - caseInputFile = os.path.join(testBuildDirectory, caseName + ".fst") - returnCode = openfastDrivers.runOpenfastCase(caseInputFile, executable) - if returnCode != 0: - rtl.exitWithError("") - -### Build the filesystem navigation variables for running the regression test -# testing on file 2. Gives each observer and sweep of frequency ranges -localOutFile = os.path.join(testBuildDirectory, caseName + "_2.out") -baselineOutFile = os.path.join(targetOutputDirectory, caseName + "_2.out") -rtl.validateFileOrExit(localOutFile) -rtl.validateFileOrExit(baselineOutFile) - -testData, testInfo, testPack = pass_fail.readFASTOut(localOutFile) -baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) -performance = pass_fail.calculateNorms(testData, baselineData) -normalizedNorm = performance[:, 1] - -# export all case summaries -results = list(zip(testInfo["attribute_names"], [*performance])) -results_max = performance.max(axis=0) -exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) - -# failing case -if not pass_fail.passRegressionTest(normalizedNorm, tolerance): - if plotError: - from errorPlotting import finalizePlotDirectory, plotOpenfastError - ixFailChannels = [i for i in range(len(testInfo["attribute_names"])) if normalizedNorm[i] > tolerance] - failChannels = [channel for i, channel in enumerate(testInfo["attribute_names"]) if i in ixFailChannels] - failResults = [res for i, res in enumerate(results) if i in ixFailChannels] - for channel in failChannels: - try: - plotOpenfastError(localOutFile, baselineOutFile, channel) - except: - error = sys.exc_info()[1] - print("Error generating plots: {}".format(error.msg)) - finalizePlotDirectory(localOutFile, failChannels, caseName) - sys.exit(1) - -# passing case -sys.exit(0) diff --git a/OpenFAST/reg_tests/executeOpenfastCppRegressionCase.py b/OpenFAST/reg_tests/executeOpenfastCppRegressionCase.py deleted file mode 100644 index e718fc624..000000000 --- a/OpenFAST/reg_tests/executeOpenfastCppRegressionCase.py +++ /dev/null @@ -1,173 +0,0 @@ -# -# 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. -# - -import os -import sys -basepath = os.path.sep.join(sys.argv[0].split(os.path.sep)[:-1]) if os.path.sep in sys.argv[0] else "." -sys.path.insert(0, os.path.sep.join([basepath, "lib"])) -import argparse -import shutil -import subprocess -import rtestlib as rtl -import openfastDrivers -import pass_fail -from errorPlotting import exportCaseSummary - -##### Helper functions -def ignoreBaselineItems(directory, contents): - itemFilter = ['linux-intel', 'linux-gnu', 'macos-gnu', 'windows-intel'] - caught = [] - for c in contents: - if c in itemFilter: - caught.append(c) - return tuple(caught) - -##### Main program - -### Store the python executable for future python calls -pythonCommand = sys.executable - -### Verify input arguments -parser = argparse.ArgumentParser(description="Executes OpenFAST and 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="OpenFAST", type=str, nargs=1, help="The path to the OpenFAST 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("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") -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 = os.path.abspath(args.executable[0]) -sourceDirectory = args.sourceDirectory[0] -buildDirectory = args.buildDirectory[0] -tolerance = args.tolerance[0] -systemName = args.systemName[0] -compilerId = args.compilerId[0] -plotError = args.plot -noExec = args.noExec -verbose = args.verbose - -# validate inputs -rtl.validateExeOrExit(executable) -rtl.validateDirOrExit(sourceDirectory) -if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) - -### Map the system and compiler configurations to a solution set -# Internal names -> Human readable names -systemName_map = { - "darwin": "macos", - "linux": "linux", - "windows": "windows" -} -compilerId_map = { - "gnu": "gnu", - "intel": "intel" -} -# Build the target output directory name or choose the default -supportedBaselines = ["macos-gnu", "linux-intel", "linux-gnu", "windows-intel"] -targetSystem = systemName_map.get(systemName.lower(), "") -targetCompiler = compilerId_map.get(compilerId.lower(), "") -outputType = os.path.join(targetSystem+"-"+targetCompiler) -if outputType not in supportedBaselines: - outputType = supportedBaselines[0] -print("-- Using gold standard files with machine-compiler type {}".format(outputType)) - -### Build the filesystem navigation variables for running openfast on the test case -rtest = os.path.join(sourceDirectory, "reg_tests", "r-test") -moduleDirectory = os.path.join(rtest, "glue-codes", "openfast-cpp") -openfast_gluecode_directory = os.path.join(rtest, "glue-codes", "openfast") -inputsDirectory = os.path.join(moduleDirectory, caseName) -targetOutputDirectory = os.path.join(openfast_gluecode_directory, caseName.replace('_cpp', ''), outputType) -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 -dst = os.path.join(buildDirectory, "5MW_Baseline") -src = os.path.join(openfast_gluecode_directory, "5MW_Baseline") -if not os.path.isdir(dst): - shutil.copytree(src, dst) -else: - names = os.listdir(src) - for name in names: - if name == "ServoData": - continue - srcname = os.path.join(src, name) - dstname = os.path.join(dst, name) - if os.path.isdir(srcname): - if not os.path.isdir(dstname): - shutil.copytree(srcname, dstname) - else: - shutil.copy2(srcname, dstname) - -if not os.path.isdir(testBuildDirectory): - shutil.copytree(inputsDirectory, testBuildDirectory, ignore=ignoreBaselineItems) - -### Run openfast on the test case -if not noExec: - cwd = os.getcwd() - os.chdir(testBuildDirectory) - caseInputFile = os.path.abspath("cDriver.yaml") - returnCode = openfastDrivers.runOpenfastCase(caseInputFile, executable) - if returnCode != 0: - rtl.exitWithError("") - os.chdir(cwd) - -### Build the filesystem navigation variables for running the regression test -localOutFile = os.path.join(testBuildDirectory, caseName + ".outb") -baselineOutFile = os.path.join(targetOutputDirectory, caseName.replace('_cpp', '') + ".outb") -rtl.validateFileOrExit(localOutFile) -rtl.validateFileOrExit(baselineOutFile) - -testData, testInfo, testPack = pass_fail.readFASTOut(localOutFile) -baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) -performance = pass_fail.calculateNorms(testData, baselineData) -normalizedNorm = performance[:, 1] - -# export all case summaries -results = list(zip(testInfo["attribute_names"], [*performance])) -results_max = performance.max(axis=0) -exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) - -# failing case -if not pass_fail.passRegressionTest(normalizedNorm, tolerance): - if plotError: - from errorPlotting import finalizePlotDirectory, plotOpenfastError - for channel in testInfo["attribute_names"]: - try: - plotOpenfastError(localOutFile, baselineOutFile, channel) - except: - error = sys.exc_info()[1] - print("Error generating plots: {}".format(error)) - finalizePlotDirectory(localOutFile, testInfo["attribute_names"], caseName) - - sys.exit(1) - -# passing case -sys.exit(0) diff --git a/OpenFAST/reg_tests/executeOpenfastLinearRegressionCase.py b/OpenFAST/reg_tests/executeOpenfastLinearRegressionCase.py deleted file mode 100644 index d23937bbf..000000000 --- a/OpenFAST/reg_tests/executeOpenfastLinearRegressionCase.py +++ /dev/null @@ -1,272 +0,0 @@ -# -# 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 OpenFAST and a regression test 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: `executeOpenfastLinearRegressionCase.py -h` -""" - -import os -import sys -basepath = os.path.sep.join(sys.argv[0].split(os.path.sep)[:-1]) if os.path.sep in sys.argv[0] else "." -sys.path.insert(0, os.path.sep.join([basepath, "lib"])) -import argparse -import shutil -import subprocess -import rtestlib as rtl -import openfastDrivers -import pass_fail -from errorPlotting import exportCaseSummary - -##### Helper functions -def ignoreBaselineItems(directory, contents): - itemFilter = ['linux-intel', 'linux-gnu', 'macos-gnu', 'windows-intel'] - caught = [] - for c in contents: - if c in itemFilter: - caught.append(c) - return tuple(caught) - -def file_line_count(filename): - file_handle = open(filename, 'r') - for i, _ in enumerate(file_handle): - pass - file_handle.close() - return i + 1 - -def isclose(a, b, rel_tol=1e-09, abs_tol=0.0): - return abs(a-b) <= max(rel_tol * max(abs(a), abs(b)), abs_tol) - -##### Main program - -### Store the python executable for future python calls -pythonCommand = sys.executable - -### Verify input arguments -parser = argparse.ArgumentParser(description="Executes OpenFAST and 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="OpenFAST", type=str, nargs=1, help="The path to the OpenFAST 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("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") -parser.add_argument("-p", "-plot", dest="plot", default=False, metavar="Plotting-Flag", type=bool, nargs="?", help="bool to include plots in failed cases") -parser.add_argument("-n", "-no-exec", dest="noExec", default=False, metavar="No-Execution", type=bool, nargs="?", help="bool to prevent execution of the test cases") -parser.add_argument("-v", "-verbose", dest="verbose", default=False, metavar="Verbose-Flag", type=bool, nargs="?", 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] -tolerance = args.tolerance[0] -systemName = args.systemName[0] -compilerId = args.compilerId[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) - -### Map the system and compiler configurations to a solution set -# Internal names -> Human readable names -systemName_map = { - "darwin": "macos", - "linux": "linux", - "windows": "windows" -} -compilerId_map = { - "gnu": "gnu", - "intel": "intel" -} -# Build the target output directory name or choose the default -supportedBaselines = ["macos-gnu", "linux-intel", "linux-gnu", "windows-intel"] -targetSystem = systemName_map.get(systemName.lower(), "") -targetCompiler = compilerId_map.get(compilerId.lower(), "") -outputType = os.path.join(targetSystem+"-"+targetCompiler) -if outputType not in supportedBaselines: - outputType = supportedBaselines[0] -print("-- Using gold standard files with machine-compiler type {}".format(outputType)) - -### Build the filesystem navigation variables for running openfast on 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", "openfast") -inputsDirectory = os.path.join(moduleDirectory, caseName) -targetOutputDirectory = os.path.join(inputsDirectory, outputType) -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 -for data in ["Ideal_Beam", "WP_Baseline"]: - dataDir = os.path.join(buildDirectory, data) - if not os.path.isdir(dataDir): - shutil.copytree(os.path.join(moduleDirectory, data), dataDir) - -# Special copy for the 5MW_Baseline folder because the Windows python-only workflow may have already created data in the subfolder ServoData -dst = os.path.join(buildDirectory, "5MW_Baseline") -src = os.path.join(moduleDirectory, "5MW_Baseline") -if not os.path.isdir(dst): - shutil.copytree(src, dst) -else: - names = os.listdir(src) - for name in names: - if name == "ServoData": - continue - srcname = os.path.join(src, name) - dstname = os.path.join(dst, name) - if os.path.isdir(srcname): - if not os.path.isdir(dstname): - shutil.copytree(srcname, dstname) - else: - shutil.copy2(srcname, dstname) - -if not os.path.isdir(testBuildDirectory): - shutil.copytree(inputsDirectory, testBuildDirectory, ignore=ignoreBaselineItems) - -### Run openfast on the test case -if not noExec: - caseInputFile = os.path.join(testBuildDirectory, caseName + ".fst") - returnCode = openfastDrivers.runOpenfastCase(caseInputFile, executable) - if returnCode != 0: - rtl.exitWithError("") - -### Get a list of all the files in the baseline directory -baselineOutFiles = os.listdir(targetOutputDirectory) -# Drop the log file, if its listed -if caseName + '.log' in baselineOutFiles: - baselineOutFiles.remove(caseName + '.log') - -# these should all exist in the local outputs directory -localFiles = os.listdir(testBuildDirectory) -localOutFiles = [f for f in localFiles if f in baselineOutFiles] -if len(localOutFiles) != len(baselineOutFiles): - print("Error in case {}: an expected local solution file does not exist.".format(caseName)) - sys.exit(1) - -### test for regression -for i, f in enumerate(localOutFiles): - local_file = os.path.join(testBuildDirectory, f) - baseline_file = os.path.join(targetOutputDirectory, f) - - # verify both files have the same number of lines - local_file_line_count = file_line_count(local_file) - baseline_file_line_count = file_line_count(baseline_file) - if local_file_line_count != baseline_file_line_count: - print("Error in case {}: local and baseline solutions have different line counts in".format(caseName)) - print("\t{}".format(local_file)) - print("\t{}".format(baseline_file)) - sys.exit(1) - - # open both files - local_handle = open(local_file, 'r') - baseline_handle = open(baseline_file, 'r') - - # parse the files - - # skip the first 6 lines since they are headers and may change without conseequence - for i in range(6): - baseline_handle.readline() - local_handle.readline() - - # the next 10 lines are simulation info; save what we need - for i in range(11): - b_line = baseline_handle.readline() - l_line = local_handle.readline() - if i == 5: - b_num_continuous_states = int(b_line.split()[-1]) - l_num_continuous_states = int(l_line.split()[-1]) - elif i == 8: - b_num_inputs = int(b_line.split()[-1]) - l_num_inputs = int(l_line.split()[-1]) - elif i == 9: - b_num_outputs = int(b_line.split()[-1]) - l_num_outputs = int(l_line.split()[-1]) - - # find the "Jacobian matrices:" line - for i in range(local_file_line_count): - b_line = baseline_handle.readline() - l_line = local_handle.readline() - if "Jacobian matrices:" in l_line: - break - - # skip 1 empty/header lines - for i in range(1): - baseline_handle.readline() - local_handle.readline() - - # read and compare Jacobian matrices - for i in range(local_file_line_count): - b_line = baseline_handle.readline() - l_line = local_handle.readline() - if ":" in l_line: - continue - if len(l_line) < 5: - break - b_elements = b_line.split() - l_elements = l_line.split() - for j, l_element in enumerate(l_elements): - l_float = float(l_element) - b_float = float(b_elements[j]) - if not isclose(l_float, b_float, tolerance, tolerance): - print(f"Failed in Jacobian matrix comparison: {l_float} and {b_float}") - sys.exit(1) - - # skip 2 empty/header lines - for i in range(2): - baseline_handle.readline() - local_handle.readline() - - # read and compare Linearized state matrices - for i in range(local_file_line_count): - b_line = baseline_handle.readline() - l_line = local_handle.readline() - if ":" in l_line: - continue - if len(l_line) < 5: - break - b_elements = b_line.split() - l_elements = l_line.split() - for j, l_element in enumerate(l_elements): - l_float = float(l_element) - b_float = float(b_elements[j]) - if not isclose(l_float, b_float, tolerance, tolerance): - print(f"Failed in state matrix comparison: {l_float} and {b_float}") - sys.exit(1) - - local_handle.close() - baseline_handle.close() - -# passing case -sys.exit(0) diff --git a/OpenFAST/reg_tests/executeOpenfastRegressionCase.py b/OpenFAST/reg_tests/executeOpenfastRegressionCase.py deleted file mode 100644 index 975ca0f87..000000000 --- a/OpenFAST/reg_tests/executeOpenfastRegressionCase.py +++ /dev/null @@ -1,186 +0,0 @@ -# -# 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 OpenFAST and a regression test 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: `executeOpenfastRegressionCase.py -h` -""" - -import os -import sys -basepath = os.path.sep.join(sys.argv[0].split(os.path.sep)[:-1]) if os.path.sep in sys.argv[0] else "." -sys.path.insert(0, os.path.sep.join([basepath, "lib"])) -import argparse -import shutil -import subprocess -import rtestlib as rtl -import openfastDrivers -import pass_fail -from errorPlotting import exportCaseSummary - -##### Helper functions -def ignoreBaselineItems(directory, contents): - itemFilter = ['linux-intel', 'linux-gnu', 'macos-gnu', 'windows-intel'] - caught = [] - for c in contents: - if c in itemFilter: - caught.append(c) - return tuple(caught) - -##### Main program - -### Store the python executable for future python calls -pythonCommand = sys.executable - -### Verify input arguments -parser = argparse.ArgumentParser(description="Executes OpenFAST and 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="OpenFAST", type=str, nargs=1, help="The path to the OpenFAST 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("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") -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] -tolerance = args.tolerance[0] -systemName = args.systemName[0] -compilerId = args.compilerId[0] -plotError = args.plot -noExec = args.noExec -verbose = args.verbose - -# validate inputs -rtl.validateExeOrExit(executable) -rtl.validateDirOrExit(sourceDirectory) -if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) - -### Map the system and compiler configurations to a solution set -# Internal names -> Human readable names -systemName_map = { - "darwin": "macos", - "linux": "linux", - "windows": "windows" -} -compilerId_map = { - "gnu": "gnu", - "intel": "intel" -} -# Build the target output directory name or choose the default -supportedBaselines = ["macos-gnu", "linux-intel", "linux-gnu", "windows-intel"] -targetSystem = systemName_map.get(systemName.lower(), "") -targetCompiler = compilerId_map.get(compilerId.lower(), "") -outputType = os.path.join(targetSystem+"-"+targetCompiler) -if outputType not in supportedBaselines: - outputType = supportedBaselines[0] -print("-- Using gold standard files with machine-compiler type {}".format(outputType)) - -### Build the filesystem navigation variables for running openfast on 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", "openfast") -inputsDirectory = os.path.join(moduleDirectory, caseName) -targetOutputDirectory = os.path.join(inputsDirectory, outputType) -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 -for data in ["AOC", "AWT27", "SWRT", "UAE_VI", "WP_Baseline"]: - dataDir = os.path.join(buildDirectory, data) - if not os.path.isdir(dataDir): - shutil.copytree(os.path.join(moduleDirectory, data), dataDir) - -# Special copy for the 5MW_Baseline folder because the Windows python-only workflow may have already created data in the subfolder ServoData -dst = os.path.join(buildDirectory, "5MW_Baseline") -src = os.path.join(moduleDirectory, "5MW_Baseline") -if not os.path.isdir(dst): - shutil.copytree(src, dst) -else: - names = os.listdir(src) - for name in names: - if name == "ServoData": - continue - srcname = os.path.join(src, name) - dstname = os.path.join(dst, name) - if os.path.isdir(srcname): - if not os.path.isdir(dstname): - shutil.copytree(srcname, dstname) - else: - shutil.copy2(srcname, dstname) - -if not os.path.isdir(testBuildDirectory): - shutil.copytree(inputsDirectory, testBuildDirectory, ignore=ignoreBaselineItems) - -### Run openfast on the test case -if not noExec: - caseInputFile = os.path.join(testBuildDirectory, caseName + ".fst") - returnCode = openfastDrivers.runOpenfastCase(caseInputFile, executable) - if returnCode != 0: - rtl.exitWithError("") - -### Build the filesystem navigation variables for running the regression test -localOutFile = os.path.join(testBuildDirectory, caseName + ".outb") -baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".outb") -rtl.validateFileOrExit(localOutFile) -rtl.validateFileOrExit(baselineOutFile) - -testData, testInfo, testPack = pass_fail.readFASTOut(localOutFile) -baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) -performance = pass_fail.calculateNorms(testData, baselineData) -normalizedNorm = performance[:, 1] - -# export all case summaries -results = list(zip(testInfo["attribute_names"], [*performance])) -results_max = performance.max(axis=0) -exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) - -# failing case -if not pass_fail.passRegressionTest(normalizedNorm, tolerance): - if plotError: - from errorPlotting import finalizePlotDirectory, plotOpenfastError - for channel in testInfo["attribute_names"]: - try: - plotOpenfastError(localOutFile, baselineOutFile, channel) - except: - error = sys.exc_info()[1] - print("Error generating plots: {}".format(error)) - finalizePlotDirectory(localOutFile, testInfo["attribute_names"], caseName) - - sys.exit(1) - -# passing case -sys.exit(0) diff --git a/OpenFAST/reg_tests/executePythonRegressionCase.py b/OpenFAST/reg_tests/executePythonRegressionCase.py deleted file mode 100644 index ef7fb8d5c..000000000 --- a/OpenFAST/reg_tests/executePythonRegressionCase.py +++ /dev/null @@ -1,194 +0,0 @@ -# -# 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 OpenFAST via the Python interface, and checks the results - in a regression test 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: `executePythonRegressionCase.py -h` -""" - -import os -import sys -basepath = os.path.sep.join(sys.argv[0].split(os.path.sep)[:-1]) if os.path.sep in sys.argv[0] else "." -sys.path.insert(0, os.path.sep.join([basepath, "lib"])) -sys.path.insert(0, os.path.sep.join([basepath, "..", "glue-codes", "python"])) -import platform -import argparse -import shutil -import subprocess -import rtestlib as rtl -import openfastDrivers -import pass_fail -from errorPlotting import exportCaseSummary -import openfast_library - -##### Helper functions -def ignoreBaselineItems(directory, contents): - itemFilter = ['linux-intel', 'linux-gnu', 'macos-gnu', 'windows-intel'] - caught = [] - for c in contents: - if c in itemFilter: - caught.append(c) - return tuple(caught) - -##### Main program - -### Store the python executable for future python calls -pythonCommand = sys.executable - -### Verify input arguments -parser = argparse.ArgumentParser(description="Executes OpenFAST and 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="NotUsed", type=str, nargs=1, help="Not used in this script, but kept for API compatibility.") -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("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") -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].replace("_py", "") -sourceDirectory = args.sourceDirectory[0] -buildDirectory = args.buildDirectory[0] -tolerance = args.tolerance[0] -systemName = args.systemName[0] -compilerId = args.compilerId[0] -plotError = args.plot -noExec = args.noExec -verbose = args.verbose - -# validate inputs -rtl.validateDirOrExit(sourceDirectory) -if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) - -### Map the system and compiler configurations to a solution set -# Internal names -> Human readable names -systemName_map = { - "darwin": "macos", - "linux": "linux", - "windows": "windows" -} -compilerId_map = { - "gnu": "gnu", - "intel": "intel" -} -# Build the target output directory name or choose the default -supportedBaselines = ["macos-gnu", "linux-intel", "linux-gnu", "windows-intel"] -targetSystem = systemName_map.get(systemName.lower(), "") -targetCompiler = compilerId_map.get(compilerId.lower(), "") -outputType = os.path.join(targetSystem+"-"+targetCompiler) -if outputType not in supportedBaselines: - outputType = supportedBaselines[0] -print("-- Using gold standard files with machine-compiler type {}".format(outputType)) - -### Build the filesystem navigation variables for running openfast on 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", "openfast") -inputsDirectory = os.path.join(moduleDirectory, caseName) -targetOutputDirectory = os.path.join(inputsDirectory, outputType) -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 -dst = os.path.join(buildDirectory, "5MW_Baseline") -src = os.path.join(moduleDirectory, "5MW_Baseline") -if not os.path.isdir(dst): - shutil.copytree(src, dst) -else: - names = os.listdir(src) - for name in names: - if name == "ServoData": - continue - srcname = os.path.join(src, name) - dstname = os.path.join(dst, name) - if os.path.isdir(srcname): - if not os.path.isdir(dstname): - shutil.copytree(srcname, dstname) - else: - shutil.copy2(srcname, dstname) - -if not os.path.isdir(testBuildDirectory): - shutil.copytree(inputsDirectory, testBuildDirectory, ignore=ignoreBaselineItems) - -### Run openfast on the test case -if not noExec: - caseInputFile = os.path.join(testBuildDirectory, caseName + ".fst") - openfastlib_path = os.path.join(buildDirectory, "..", "..", "..", "modules", "openfast-library", "libopenfastlib") - if platform.system() == 'Linux': - openfastlib_path += ".so" - elif platform.system() == 'Darwin': - openfastlib_path += ".dylib" - elif platform.system() == 'Windows': - openfastlib_path += ".dll" - else: - raise SystemError("Platform could not be determined: platform.system -> {}".format(platform.system())) - - openfastlib = openfast_library.FastLibAPI(openfastlib_path, caseInputFile) - openfastlib.fast_run() - if openfastlib.fatal_error: - sys.exit(1) - output_channel_names = openfastlib.output_channel_names - -### Build the filesystem navigation variables for running the regression test -baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".outb") -rtl.validateFileOrExit(baselineOutFile) - -testInfo = { - "attribute_names": output_channel_names -} -testData = openfastlib.output_values -baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) -performance = pass_fail.calculateNorms(testData, baselineData) -normalizedNorm = performance[:, 1] - -# export all case summaries -results = list(zip(testInfo["attribute_names"], [*performance])) -results_max = performance.max(axis=0) -exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) - -# failing case -if not pass_fail.passRegressionTest(normalizedNorm, tolerance): - if plotError: - from errorPlotting import finalizePlotDirectory, plotOpenfastError - for channel in testInfo["attribute_names"]: - try: - plotOpenfastError(localOutFile, baselineOutFile, channel) - except: - error = sys.exc_info()[1] - print("Error generating plots: {}".format(error)) - finalizePlotDirectory(localOutFile, testInfo["attribute_names"], caseName) - - sys.exit(1) - -# passing case -sys.exit(0) diff --git a/OpenFAST/reg_tests/executeSubdynRegressionCase.py b/OpenFAST/reg_tests/executeSubdynRegressionCase.py deleted file mode 100644 index 151049fa4..000000000 --- a/OpenFAST/reg_tests/executeSubdynRegressionCase.py +++ /dev/null @@ -1,141 +0,0 @@ -# -# 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 SubDyn and a regression test 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: `executeSubdynRegressionCase.py -h` -""" - -import os -import sys -basepath = os.path.sep.join(sys.argv[0].split(os.path.sep)[:-1]) if os.path.sep in sys.argv[0] else "." -sys.path.insert(0, os.path.sep.join([basepath, "lib"])) -import argparse -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 SubDyn and 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="SubDyn-Driver", type=str, nargs=1, help="The path to the SubDyn 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("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="Tolerance defining pass or failure in the regression test.") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="The current system\'s name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="The compiler\'s id: [Intel,GNU]") -parser.add_argument("-p", "-plot", dest="plot", default=False, metavar="Plotting-Flag", type=bool, nargs="?", help="bool to include matplotlib plots in failed cases") -parser.add_argument("-n", "-no-exec", dest="noExec", default=False, metavar="No-Execution", type=bool, nargs="?", help="bool to prevent execution of the test cases") -parser.add_argument("-v", "-verbose", dest="verbose", default=False, metavar="Verbose-Flag", type=bool, nargs="?", 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] -tolerance = args.tolerance[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) - -### 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", "subdyn") -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,caseName+".dvr")): - 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 SubDyn on the test case -if not noExec: - caseInputFile = os.path.join(testBuildDirectory, caseName+".dvr") - returnCode = openfastDrivers.runSubdynDriverCase(caseInputFile, executable) - if returnCode != 0: - rtl.exitWithError("") - -### Build the filesystem navigation variables for running the regression test -localOutFile = os.path.join(testBuildDirectory, caseName+".SD.out") -baselineOutFile = os.path.join(targetOutputDirectory, caseName+".SD.out") -rtl.validateFileOrExit(localOutFile) -rtl.validateFileOrExit(baselineOutFile) - -testData, testInfo, testPack = pass_fail.readFASTOut(localOutFile) -baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) -performance = pass_fail.calculateNorms(testData, baselineData) -normalizedNorm = performance[:, 1] - -# export all case summaries -results = list(zip(testInfo["attribute_names"], [*performance])) -results_max = performance.max(axis=0) -exportCaseSummary(testBuildDirectory, caseName, results, results_max, tolerance) - -# failing case -if not pass_fail.passRegressionTest(normalizedNorm, tolerance): - if plotError: - from errorPlotting import finalizePlotDirectory, plotOpenfastError - ixFailChannels = [i for i in range(len(testInfo["attribute_names"])) if normalizedNorm[i] > tolerance] - failChannels = [channel for i, channel in enumerate(testInfo["attribute_names"]) if i in ixFailChannels] - failResults = [res for i, res in enumerate(results) if i in ixFailChannels] - for channel in failChannels: - try: - plotOpenfastError(localOutFile, baselineOutFile, channel) - except: - error = sys.exc_info()[1] - print("Error generating plots: {}".format(error.msg)) - finalizePlotDirectory(localOutFile, failChannels, caseName) - sys.exit(1) - -# passing case -sys.exit(0) diff --git a/OpenFAST/reg_tests/lib/errorPlotting.py b/OpenFAST/reg_tests/lib/errorPlotting.py deleted file mode 100644 index 1778f3fe7..000000000 --- a/OpenFAST/reg_tests/lib/errorPlotting.py +++ /dev/null @@ -1,289 +0,0 @@ - -# -# 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 library provides tools for plotting the output channels over time of a - given solution attribute for two OpenFAST solutions, with the second solution - assumed to be the baseline for comparison. There are functions for solution - file I/O, plot creation, and html creation for navigating the plots. -""" - -import os -import sys -import shutil - -import numpy as np - -import rtestlib as rtl -from fast_io import load_output - -def _validateAndExpandInputs(argv): - rtl.validateInputOrExit(argv, 3, "solution1 solution2 attribute") - testSolution = argv[0] - baselineSolution = argv[1] - attribute = argv[2] - rtl.validateFileOrExit(testSolution) - rtl.validateFileOrExit(baselineSolution) - return (testSolution, baselineSolution, attribute) - -def _parseSolution(solution): - try: - data, info, _ = load_output(solution) - return (data, info) - except Exception as e: - rtl.exitWithError("Error: {}".format(e)) - -def _plotError(xseries, y1series, y2series, xlabel, title1, title2): - from bokeh.embed import components - from bokeh.layouts import gridplot - from bokeh.plotting import figure - from bokeh.models.tools import HoverTool, BoxZoomTool - - p1 = figure(title=title1) - p1.title.align = 'center' - p1.grid.grid_line_alpha=0.3 - p1.xaxis.axis_label = 'Time (s)' - p1.line(xseries, y2series, color='green', line_width=3, legend_label='Baseline') - p1.line(xseries, y1series, color='red', line_width=1, legend_label='Local') - p1.add_tools(HoverTool(tooltips=[('Time','@x'), ('Value', '@y')],mode='vline')) - - p2 = figure(title=title2, x_range=p1.x_range) - p2.title.align = 'center' - p2.grid.grid_line_alpha = 0 - p2.xaxis.axis_label = 'Time (s)' - p2.line(xseries, abs(y2series - y1series), color='blue') - p2.add_tools(HoverTool(tooltips=[('Time','@x'), ('Error', '@y')], mode='vline')) - - grid = gridplot([[p1, p2]], plot_width=650, plot_height=375, sizing_mode="scale_both") - script, div = components(grid) - - return script, div - -def _replace_id_div(html_string, plot): - id_start = html_string.find('id=') + 4 - id_end = html_string[id_start:].find('"') + id_start - html_string = plot.join((html_string[:id_start], html_string[id_end:])) - return html_string - -def _replace_id_script(html_string, plot): - id_start = html_string.find('var render_items') - id_start += html_string[id_start:].find('roots') - id_start += html_string[id_start:].find('":"') + 3 - id_end = html_string[id_start:].find('"') + id_start - html_string = plot.join((html_string[:id_start], html_string[id_end:])) - return html_string - -def _save_plot(script, div, path, attribute): - div_class = ' class="col-sm-12 col-md-6 col-lg-6"' - - file_name = "_script".join((attribute, ".txt")) - with open(os.path.join(path, file_name), 'w') as f: - script = _replace_id_script(script.replace('\n', '\n '), attribute) - f.write(script) - - file_name = "_div".join((attribute, ".txt")) - with open(os.path.join(path, file_name), 'w') as f: - div = _replace_id_div(div, attribute) - ix_insert = div.find('>') - div = div_class.join((div[:ix_insert], div[ix_insert:])) - style = 'style="margin:10 auto"' - div = div.replace("\n') + len('\n') - - for i, plot in enumerate(plot_list): - _path = os.path.join(plot_path, plot + '_div.txt') - with open(_path, 'r') as f: - div = f.read().strip().join((' ', '\n')) - html = ''.join((html, div)) - - html = ''.join((html, ' ' + '\n')) - html = ''.join((html, ' ' + '\n')) - html = ''.join((html, '' + '\n')) - html = ''.join((html, _htmlTail())) - - for i, plot in enumerate(plot_list): - _path = os.path.join(plot_path, f'{plot}_script.txt') - with open(_path, "r") as f: - _s = f.read() - if i == 0: - script = _s - else: - script = ''.join((script, _s)) - - shutil.rmtree(plot_path, ignore_errors=True) - - script = ''.join((script, '\n')) - html = script.join((html[:script_ix], html[script_ix:])) - with open(os.path.join(base_path, '.'.join((case, 'html'))), 'w') as f: - f.write(html) - -def exportResultsSummary(path, results): - with open(os.path.join(path, "regression_test_summary.html"), "w") as html: - - html.write( _htmlHead("Regression Test Summary") ) - - html.write('' + '\n') - html.write('

{}

'.format("Regression Test Summary") + '\n') - html.write('
' + '\n') - - # Test Case - Pass/Fail - Max Relative Norm - data = [('{0}'.format(r[0]), r[1]) for i,r in enumerate(results)] - table = _tableHead(['Test Case', 'Pass/Fail']) - body = ' ' + '\n' - for i, d in enumerate(data): - body += ' ' + '\n' - body += ' {}'.format(i+1) + '\n' - body += ' {0:s}'.format(d[0]) + '\n' - - fmt = '{0:s}' - if d[1] == "FAIL": - body += (' ' + fmt + '').format(d[1]) + '\n' - else: - body += (' ' + fmt + '').format(d[1]) + '\n' - - body += ' ' + '\n' - body += ' ' + '\n' - table += body - table += ' ' + '\n' - html.write(table) - - html.write('
' + '\n') - html.write('
' + '\n') - html.write('' + '\n') - html.write( _htmlTail() ) - html.close() - -def exportCaseSummary(path, case, results, results_max, tolerance): - with open(os.path.join(path, case+".html"), "w") as html: - html.write( _htmlHead(case + " Summary") ) - - html.write('\n') - html.write('

{}

\n'.format(case + " Summary")) - html.write('

Maximum values for each norm are highlighted and failing norms (norm >= {0}) are highlighted

\n'.format(tolerance)) - html.write('
\n') - - data = [ - ('{0}'.format(attribute), *norms) - for attribute, *norms in results - ] - cols = [ - 'Channel', 'Relative Max Norm', - 'Relative L2 Norm', 'Infinity Norm' - ] - table = _tableHead(cols) - - body = ' ' + '\n' - for i, d in enumerate(data): - body += ' ' + '\n' - body += ' {}'.format(i+1) + '\n' - body += ' {0:s}'.format(d[0]) + '\n' - - fmt = '{0:0.4e}' - for j, val in enumerate(d[1]): - if val == results_max[j]: - body += (' ' + fmt + '\n').format(val) - elif val > tolerance: - body += (' ' + fmt + '\n').format(val) - else: - body += (' ' + fmt + '\n').format(val) - - body += ' ' + '\n' - body += ' ' + '\n' - table += body - table += ' ' + '\n' - html.write(table) - - html.write('
' + '\n') - html.write('
' + '\n') - html.write('' + '\n') - html.write( _htmlTail() ) diff --git a/OpenFAST/reg_tests/lib/fast_io.py b/OpenFAST/reg_tests/lib/fast_io.py deleted file mode 100644 index 9a2b3d0fb..000000000 --- a/OpenFAST/reg_tests/lib/fast_io.py +++ /dev/null @@ -1,180 +0,0 @@ -# -# 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. -# - -''' -Created on 03/09/2015 -@author: MMPE -Copied from https://github.com/WISDEM/AeroelasticSE/tree/openmdao1/src/AeroelasticSE/old_files on 15 Aug 2016 by Ganesh Vijayakumar -''' -import os -import numpy as np -import struct - -def load_output(filename): - """ - Load a FAST binary or ascii output file - - Parameters - ---------- - filename : str - filename - - Returns - ------- - data: ndarray - data values - info: dict - info containing: - - name: filename - - description: description of dataset - - attribute_names: list of attribute names - - attribute_units: list of attribute units - """ - - assert os.path.isfile(filename), "File, %s, does not exists" % filename - with open(filename, 'r') as f: - if "outb" in filename: - return load_binary_output(filename) - elif "out" in filename: - try: - print(f.readline()) - except UnicodeDecodeError: - return load_binary_output(filename) - return load_ascii_output(filename) + (np.ones(1),) - -def load_ascii_output(filename): - with open(filename) as f: - info = {} - info['name'] = os.path.splitext(os.path.basename(filename))[0] - header = [f.readline() for _ in range(8)] - info['description'] = header[4].strip() - info['attribute_names'] = header[6].split() - info['attribute_units'] = [unit[1:-1] for unit in header[7].split()] #removing "()" - data = np.array([line.split() for line in f.readlines()], dtype=np.float) - if np.any(np.isnan(data)): - raise ValueError("NaN found in test data: {}".format(filename)) - if np.any(np.isinf(data)): - raise ValueError("Infinity found in test data: {}".format(filename)) - return data, info - -def load_binary_output(filename): - """ - Ported from ReadFASTbinary.m by Mads M Pedersen, DTU Wind - Info about ReadFASTbinary.m: - Author: Bonnie Jonkman, National Renewable Energy Laboratory - (c) 2012, National Renewable Energy Laboratory - Edited for FAST v7.02.00b-bjj 22-Oct-2012 - """ - - def fread(fid, n, type): - fmt, nbytes = {'uint8': ('B', 1), 'int16':('h', 2), 'int32':('i', 4), 'float32':('f', 4), 'float64':('d', 8)}[type] - return struct.unpack(fmt * n, fid.read(nbytes * n)) - - FileFmtID_WithTime = 1 # File identifiers used in FAST - FileFmtID_WithoutTime = 2 - FileFmtID_NoCompressWithoutTime = 3 - FileFmtID_ChanLen_In = 4 - - with open(filename, 'rb') as fid: - FileID = fread(fid, 1, 'int16')[0] # FAST output file format, INT(2) - - if FileID == FileFmtID_ChanLen_In: - LenName = fread(fid, 1, 'int16')[0] # Number of characters in channel names and units - else: - LenName = 10 # default number of characters per channel name - - - NumOutChans = fread(fid, 1, 'int32')[0] # The number of output channels, INT(4) - NT = fread(fid, 1, 'int32')[0] # The number of time steps, INT(4) - - if FileID == FileFmtID_WithTime: - TimeScl = fread(fid, 1, 'float64') # The time slopes for scaling, REAL(8) - TimeOff = fread(fid, 1, 'float64') # The time offsets for scaling, REAL(8) - else: - TimeOut1 = fread(fid, 1, 'float64') # The first time in the time series, REAL(8) - TimeIncr = fread(fid, 1, 'float64') # The time increment, REAL(8) - - if FileID != FileFmtID_NoCompressWithoutTime: - ColScl = fread(fid, NumOutChans, 'float32') # The channel slopes for scaling, REAL(4) - ColOff = fread(fid, NumOutChans, 'float32') # The channel offsets for scaling, REAL(4) - - LenDesc = fread(fid, 1, 'int32')[0] # The number of characters in the description string, INT(4) - DescStrASCII = fread(fid, LenDesc, 'uint8') # DescStr converted to ASCII - DescStr = "".join(map(chr, DescStrASCII)).strip() - - ChanName = [] # initialize the ChanName cell array - for iChan in range(NumOutChans + 1): - ChanNameASCII = fread(fid, LenName, 'uint8') # ChanName converted to numeric ASCII - ChanName.append("".join(map(chr, ChanNameASCII)).strip()) - - ChanUnit = [] # initialize the ChanUnit cell array - for iChan in range(NumOutChans + 1): - ChanUnitASCII = fread(fid, LenName, 'uint8') # ChanUnit converted to numeric ASCII - ChanUnit.append("".join(map(chr, ChanUnitASCII)).strip()[1:-1]) - - # get the channel time series - nPts = NT * NumOutChans # number of data points in the file - if FileID == FileFmtID_WithTime: - PackedTime = fread(fid, NT, 'int32') # read the time data - cnt = len(PackedTime) - if cnt < NT: - raise Exception('Could not read entire %s file: read %d of %d time values' % (filename, cnt, NT)) - - if FileID == FileFmtID_NoCompressWithoutTime: - PackedData = fread(fid, nPts, 'float64') # read the channel data - else: - PackedData = fread(fid, nPts, 'int16') # read the channel data - - cnt = len(PackedData) - if cnt < nPts: - raise Exception('Could not read entire %s file: read %d of %d values' % (filename, cnt, nPts)) - - if FileID == FileFmtID_NoCompressWithoutTime: - pack = np.array(PackedData).reshape(NT, NumOutChans) - data = pack - else: - # Scale the packed binary to real data - pack = np.array(PackedData).reshape(NT, NumOutChans) - data = (pack - ColOff) / ColScl - - if FileID == FileFmtID_WithTime: - time = (np.array(PackedTime) - TimeOff) / TimeScl; - else: - time = TimeOut1 + TimeIncr * np.arange(NT) - - data = np.concatenate([time.reshape(NT, 1), data], 1) - pack = np.concatenate([time.reshape(NT, 1), pack], 1) - - info = {'name': os.path.splitext(os.path.basename(filename))[0], - 'description': DescStr, - 'attribute_names': ChanName, - 'attribute_units': ChanUnit} - return data, info, pack - -if __name__=="__main__": - d,i = load_binary_output('Test18.T1.outb') - types = [] - for j in range(39): - types.append('f8') - print(type(i['attribute_names'])) - - print(np.dtype({'names':tuple(i['attribute_names']), 'formats': tuple(types) })) - print(type(d)) - print(np.array(d,dtype=np.dtype({'names':tuple(i['attribute_names']), 'formats': tuple(types) }))) - - print(i) - print(len(i['attribute_names'])) - print(np.shape(d)) diff --git a/OpenFAST/reg_tests/lib/openfastDrivers.py b/OpenFAST/reg_tests/lib/openfastDrivers.py deleted file mode 100644 index 9820f6671..000000000 --- a/OpenFAST/reg_tests/lib/openfastDrivers.py +++ /dev/null @@ -1,71 +0,0 @@ -# -# 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 library provides tools for executing cases with drivers contained in the - OpenFAST framework. Any new drivers should have a corresponding public driver - function called `def run[NewDriver]Case` in this library. -""" - -import argparse -import os -import sys -import shutil -import subprocess -import rtestlib as rtl - -def _runCase(executable, inputFile, logFile, stdout): - command = "{} {} > {}".format(executable, inputFile, logFile) - print(command) - return subprocess.call(command, stdout=stdout, shell=True) - -def _runGenericCase(inputFile, executable, verbose=False): - stdout = sys.stdout if verbose else open(os.devnull, 'w') - - rtl.validateFileOrExit(inputFile) - rtl.validateExeOrExit(executable) - - casebase = os.path.sep.join(inputFile.split(os.path.sep)[-1].split('.')[:-1]) - caseparent = os.path.sep.join(inputFile.split(os.path.sep)[:-1]) - logFile = caseparent + os.path.sep + casebase + '.log' - - returnCode = _runCase(executable, inputFile, logFile, stdout) - print("COMPLETE with code {}".format(returnCode), flush=True) - - return returnCode - -def runOpenfastCase(inputFile, executable, verbose=False): - return _runGenericCase(inputFile, executable, verbose) - -def runAerodynDriverCase(inputFile, executable, verbose=False): - caseDirectory = os.path.sep.join(inputFile.split(os.path.sep)[:-1]) - os.chdir(caseDirectory) - return _runGenericCase(inputFile, executable, verbose) - -def runBeamdynDriverCase(inputFile, executable, verbose=False): - caseDirectory = os.path.sep.join(inputFile.split(os.path.sep)[:-1]) - os.chdir(caseDirectory) - return _runGenericCase(inputFile, executable, verbose) - -def runHydrodynDriverCase(inputFile, executable, verbose=False): - caseDirectory = os.path.sep.join(inputFile.split(os.path.sep)[:-1]) - os.chdir(caseDirectory) - return _runGenericCase(inputFile, executable, verbose) - -def runSubdynDriverCase(inputFile, executable, verbose=False): - caseDirectory = os.path.sep.join(inputFile.split(os.path.sep)[:-1]) - os.chdir(caseDirectory) - return _runGenericCase(inputFile, executable, verbose) diff --git a/OpenFAST/reg_tests/lib/pass_fail.py b/OpenFAST/reg_tests/lib/pass_fail.py deleted file mode 100644 index 51daa17f4..000000000 --- a/OpenFAST/reg_tests/lib/pass_fail.py +++ /dev/null @@ -1,101 +0,0 @@ -# -# 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 library provides tools for comparing a test solution to a baseline solution - for any structured output file generated within the OpenFAST framework. -""" -import sys, os -import numpy as np -from numpy import linalg as LA -from fast_io import load_output -import rtestlib as rtl - -def readFASTOut(fastoutput): - try: - return load_output(fastoutput) - except Exception as e: - rtl.exitWithError("Error: {}".format(e)) - -def passRegressionTest(norm, tolerance): - return True if max(norm) < tolerance else False - -def maxnorm(data, axis=0): - return LA.norm(data, np.inf, axis=axis) - -def l2norm(data, axis=0): - return LA.norm(data, 2, axis=axis) - -def calculate_relative_norm(testData, baselineData): - norm_diff = l2norm(testData - baselineData) - norm_baseline = l2norm(baselineData) - - # replace any 0s with small number before for division - norm_baseline[norm_baseline == 0] = 1e-16 - - norm = norm_diff.copy() - ix_non_diff = (norm_baseline >= 1) - norm[ix_non_diff] = norm_diff[ix_non_diff] / norm_baseline[ix_non_diff] - return norm - -def calculate_max_norm_over_range(test_data, baseline_data): - channel_ranges = np.abs(baseline_data.max(axis=0) - baseline_data.min(axis=0)) - diff = abs(test_data - baseline_data) - - ix_non_diff = (channel_ranges >= 1) - norm = maxnorm(diff, axis=0) - norm[ix_non_diff] = maxnorm(diff[:, ix_non_diff] / channel_ranges[ix_non_diff]) - - return norm - -def calculate_max_norm(testData, baselineData): - return maxnorm(abs(testData - baselineData)) - -def calculateNorms(test_data, baseline_data): - relative_norm = calculate_max_norm_over_range(test_data, baseline_data) - max_norm = calculate_max_norm(test_data, baseline_data) - relative_l2_norm = calculate_relative_norm(test_data, baseline_data) - results = np.hstack(( - relative_norm.reshape(-1, 1), relative_l2_norm.reshape(-1, 1), - max_norm.reshape(-1, 1) - )) - return results - -if __name__=="__main__": - - rtl.validateInputOrExit(sys.argv, 4, "{} test_solution baseline_solution tolerance".format(sys.argv[0])) - - testSolution = sys.argv[1] - baselineSolution = sys.argv[2] - tolerance = sys.argv[3] - - try: - tolerance = float(tolerance) - except ValueError: - rtl.exitWithError("Error: invalid tolerance given, {}".format(tolerance)) - - rtl.validateFileOrExit(testSolution) - rtl.validateFileOrExit(baselineSolution) - - testData, testInfo, testPack = readFASTOut(testSolution) - baselineData, baselineInfo, basePack = readFASTOut(baselineSolution) - - normalizedNorm, maxNorm = pass_fail.calculateNorms(testData, baselineData, tolerance) - if passRegressionTest(normalizedNorm, tolerance): - sys.exit(0) - else: - dict1, info1, pack1 = readFASTOut(testSolution) - sys.exit(1) diff --git a/OpenFAST/reg_tests/lib/rtestlib.py b/OpenFAST/reg_tests/lib/rtestlib.py deleted file mode 100644 index f797318f8..000000000 --- a/OpenFAST/reg_tests/lib/rtestlib.py +++ /dev/null @@ -1,57 +0,0 @@ -# -# 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 library contains utility functions for the custom python programs making - up the regression test system. -""" - -import sys -import os -from stat import ST_MODE - -def exitWithError(error, code=1): - print(error) - sys.exit(code) - -def validInput(argv, nArgsExpected): - valid = True if len(argv) == nArgsExpected else False - return valid - -def validateInputOrExit(argv, nArgsExpected, usage): - if len(argv) != nArgsExpected: - exitWithError( - "Error: {} arguments given, expected {}\n".format(len(argv), nArgsExpected) + - "Usage: {}".format(usage) - ) - -def validateFileOrExit(path): - if not os.path.isfile(path): - exitWithError("Error: file does not exist at {}".format(path)) - -def validateDirOrExit(path): - if not os.path.isdir(path): - exitWithError("Error: directory does not exist at {}".format(path)) - -def validateDirOrMkdir(path): - if not os.path.exists(path): - os.makedirs(path) - -def validateExeOrExit(path): - validateFileOrExit(path) - permissionsMask = oct(os.stat(path)[ST_MODE])[-1:] - if not int(permissionsMask)%2 == 1: - exitWithError("Error: executable at {} does not have proper permissions.".format(path)) diff --git a/OpenFAST/reg_tests/manualRegressionTest.py b/OpenFAST/reg_tests/manualRegressionTest.py deleted file mode 100644 index f51b1e5a5..000000000 --- a/OpenFAST/reg_tests/manualRegressionTest.py +++ /dev/null @@ -1,96 +0,0 @@ -# -# 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 OpenFAST on the CertTest cases. It mimics the - regression test execution through CMake/CTest. All generated data goes into - `openfast/build/reg_tests`. - - Get usage with: `manualRegressionTest.py -h` -""" - -import os -import sys -basepath = os.path.sep.join(sys.argv[0].split(os.path.sep)[:-1]) if os.path.sep in sys.argv[0] else "." -sys.path.insert(0, os.path.sep.join([basepath, "lib"])) -import argparse -import subprocess - -def strFormat(string): - return "{:<" + str(len(string)) + "}" - -### Verify input arguments -parser = argparse.ArgumentParser(description="Executes OpenFAST and a regression test for a single test case.") -parser.add_argument("executable", metavar="OpenFAST", type=str, nargs=1, help="path to the OpenFAST executable") -parser.add_argument("systemName", metavar="System-Name", type=str, nargs=1, help="current system's name: [Darwin,Linux,Windows]") -parser.add_argument("compilerId", metavar="Compiler-Id", type=str, nargs=1, help="compiler's id: [Intel,GNU]") -parser.add_argument("tolerance", metavar="Test-Tolerance", type=float, nargs=1, help="tolerance defining pass or failure in the regression test") -parser.add_argument("-p", "-plot", dest="plot", default=False, metavar="Plotting-Flag", type=bool, nargs="?", help="bool to include plots in failed cases") -parser.add_argument("-n", "-no-exec", dest="noExec", default=False, metavar="No-Execution", type=bool, nargs="?", help="bool to prevent execution of the test cases") -parser.add_argument("-v", "-verbose", dest="verbose", default=False, metavar="Verbose-Flag", type=bool, nargs="?", help="bool to include verbose system output") -parser.add_argument("-case", dest="case", default="", metavar="Case-Name", type=str, nargs="?", help="single case name to execute") - -args = parser.parse_args() -openfast_executable = args.executable[0] -sourceDirectory = ".." -buildDirectory = os.path.join("..", "build", "reg_tests", "glue-codes", "openfast") -machine = args.systemName[0] -compiler = args.compilerId[0] -tolerance = args.tolerance[0] -plotError = args.plot if args.plot is False else True -plotFlag = "-p" if plotError else "" -noExec = args.noExec if args.noExec is False else True -noExecFlag = "-n" if noExec else "" -verbose = args.verbose if args.verbose is False else True -case = args.case - -outstd = sys.stdout if verbose else open(os.devnull, 'w') -pythonCommand = sys.executable - -if case != "": - caselist = [case] -else: - with open(os.path.join("r-test", "glue-codes", "openfast", "CaseList.md")) as listfile: - caselist = listfile.readlines() -# allow comments with '#' -casenames = [c.rstrip("\n\r").strip() for c in caselist if "#" not in c] -# allow empty lines -casenames = [c for c in casenames if len(c.strip()) > 0] - -results = [] -prefix, passString, failString = "executing", "PASS", "FAIL" -longestName = max(casenames, key=len) -for case in casenames: - print(strFormat(prefix).format(prefix), strFormat(longestName+" ").format(case), end="", flush=True) - if "linear" in case.lower(): - command = "\"{}\" executeOpenfastLinearRegressionCase.py {} {} {} {} {} {} {} {} {}".format(pythonCommand, case, openfast_executable, sourceDirectory, buildDirectory, tolerance, machine, compiler, plotFlag, noExecFlag) - else: - command = "\"{}\" executeOpenfastRegressionCase.py {} {} {} {} {} {} {} {} {}".format(pythonCommand, case, openfast_executable, sourceDirectory, buildDirectory, tolerance, machine, compiler, plotFlag, noExecFlag) - returnCode = subprocess.call(command, stdout=outstd, shell=True) - resultString = passString if returnCode == 0 else failString - results.append((case, resultString)) - print(resultString) - -from errorPlotting import exportResultsSummary -exportResultsSummary(buildDirectory, results) - -print("\nRegression test execution completed with these results:") -for r in results: - print(" ".join([strFormat(longestName).format(r[0]), r[1]])) - -nPasses = len( [r[1] for r in results if r[1] == passString] ) -print("Total PASSING tests - {}".format(nPasses)) -print("Total FAILING tests - {}".format(len(results) - nPasses)) diff --git a/OpenFAST/reg_tests/r-test b/OpenFAST/reg_tests/r-test deleted file mode 160000 index 48e6aeb67..000000000 --- a/OpenFAST/reg_tests/r-test +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 48e6aeb67e8f0b09de024d670acba686e36c245e diff --git a/OpenFAST/share/discon/CMakeLists.txt b/OpenFAST/share/discon/CMakeLists.txt deleted file mode 100644 index c6814bcbe..000000000 --- a/OpenFAST/share/discon/CMakeLists.txt +++ /dev/null @@ -1,100 +0,0 @@ -# -# 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 impClied. -# See the License for the specific language governing permissions and -# limitations under the License. -# - -# Helper macros for setting appropriate compiler flags - -# Customizations for GNU Fortran compiler -macro(set_gfortran) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -m64 -ffree-line-length-none -fdefault-real-8 -C") - - # debug flags - if(CMAKE_BUILD_TYPE MATCHES Debug) - set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -fcheck=all -pedantic -fbacktrace" ) - endif() -endmacro(set_gfortran) - -# Customizations for Intel Fortran Compiler -macro(set_ifort) - if(WIN32) - set_ifort_windows() - else() - set_ifort_posix() - endif() -endmacro(set_ifort) - -# Customizations for Intel Fortran Compiler on posix systems -macro(set_ifort_posix) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -m64 -fpp -real-size 64") - - # debug flags - if(CMAKE_BUILD_TYPE MATCHES Debug) - set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -g -check all -traceback" ) - endif() -endmacro(set_ifort_posix) - -# Customizations for Intel Fortran Compiler on Windows systems -macro(set_ifort_windows) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} /Qm64 /fpp /real-size:64 /libs:static") - - # debug flags - if(CMAKE_BUILD_TYPE MATCHES Debug) - set(CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} /Z7 /check:all /traceback" ) - endif() -endmacro(set_ifort_windows) - - -# CMake config -cmake_minimum_required(VERSION 2.8.12) -project(DISCON) -enable_language(Fortran) - -set(SOURCE_PATH "${CMAKE_CURRENT_LIST_DIR}/DISCON.F90") -file(TO_CMAKE_PATH ${SOURCE_PATH} SOURCE_PATH) - -# set the build type option -if (NOT CMAKE_BUILD_TYPE) - set(CMAKE_BUILD_TYPE "Release" CACHE STRING "Choose the build type: Debug Release" FORCE) -endif (NOT CMAKE_BUILD_TYPE) - -# set the build flags -if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") - set_gfortran() -elseif(${CMAKE_Fortran_COMPILER_ID} MATCHES "^Intel") - set_ifort() -endif() -set(CMAKE_SHARE_LINKER_FLAGS "-shared") - -if(APPLE OR UNIX) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DIMPLICIT_DLLEXPORT") -endif() - -# supress the mac runtime path warnings -if(APPLE) - set(CMAKE_MACOSX_RPATH 1) -endif() - -add_library(DISCON SHARED ${SOURCE_PATH}) -set_target_properties(DISCON PROPERTIES PREFIX "" SUFFIX ".dll") - -# if this project is built standlone -if (${CMAKE_CURRENT_LIST_DIR} STREQUAL ${CMAKE_SOURCE_DIR}) - set(INSTALL_DEST "${CMAKE_SOURCE_DIR}/..") -# otherwise -else() - set(INSTALL_DEST "${CMAKE_BINARY_DIR}/reg_tests/glue-codes/openfast/5MW_Baseline/ServoData") -endif() - -install(TARGETS DISCON DESTINATION ${INSTALL_DEST}) diff --git a/OpenFAST/share/discon/DISCON.F90 b/OpenFAST/share/discon/DISCON.F90 deleted file mode 100644 index c37070c7e..000000000 --- a/OpenFAST/share/discon/DISCON.F90 +++ /dev/null @@ -1,589 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2015-2016 National Renewable Energy Laboratory -! Copyright (C) 2016-2017 Envision Energy USA, LTD -! -! 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. -!********************************************************************************************************************************** -SUBROUTINE DISCON ( avrSWAP, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) BIND (C, NAME='DISCON') - - ! This Bladed-style DLL controller is used to implement a variable-speed - ! generator-torque controller and PI collective blade pitch controller for - ! the NREL Offshore 5MW baseline wind turbine. This routine was written by - ! J. Jonkman of NREL/NWTC for use in the IEA Annex XXIII OC3 studies. - - ! Modified by B. Jonkman to conform to ISO C Bindings (standard Fortran 2003) and - ! compile with either gfortran or Intel Visual Fortran (IVF) - ! DO NOT REMOVE or MODIFY LINES starting with "!DEC$" or "!GCC$" - ! !DEC$ specifies attributes for IVF and !GCC$ specifies attributes for gfortran - ! - ! Note that gfortran v5.x on Mac produces compiler errors with the DLLEXPORT attribute, - ! so I've added the compiler directive IMPLICIT_DLLEXPORT. - -USE, INTRINSIC :: ISO_C_Binding - -IMPLICIT NONE -#ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: DISCON -!GCC$ ATTRIBUTES DLLEXPORT :: DISCON -#endif - - ! Passed Variables: -!REAL(C_FLOAT), INTENT(IN ) :: from_SC (*) ! DATA from the supercontroller -!REAL(C_FLOAT), INTENT(INOUT) :: to_SC (*) ! DATA to the supercontroller - - -REAL(C_FLOAT), INTENT(INOUT) :: avrSWAP (*) ! The swap array, used to pass data to, and receive data from, the DLL controller. -INTEGER(C_INT), INTENT(INOUT) :: aviFAIL ! A flag used to indicate the success of this DLL call set as follows: 0 if the DLL call was successful, >0 if the DLL call was successful but cMessage should be issued as a warning messsage, <0 if the DLL call was unsuccessful or for any other reason the simulation is to be stopped at this point with cMessage as the error message. -CHARACTER(KIND=C_CHAR), INTENT(IN) :: accINFILE (NINT(avrSWAP(50))) ! The name of the parameter input file, 'DISCON.IN'. -CHARACTER(KIND=C_CHAR), INTENT(IN) :: avcOUTNAME(NINT(avrSWAP(51))) ! OUTNAME (Simulation RootName) -CHARACTER(KIND=C_CHAR), INTENT(INOUT) :: avcMSG (NINT(avrSWAP(49))) ! MESSAGE (Message from DLL to simulation code [ErrMsg]) The message which will be displayed by the calling program if aviFAIL <> 0. - - - ! Local Variables: - -REAL(4) :: Alpha ! Current coefficient in the recursive, single-pole, low-pass filter, (-). -REAL(4) :: BlPitch (3) ! Current values of the blade pitch angles, rad. -REAL(4) :: ElapTime ! Elapsed time since the last call to the controller, sec. -REAL(4), PARAMETER :: CornerFreq = 1.570796 ! Corner frequency (-3dB point) in the recursive, single-pole, low-pass filter, rad/s. -- chosen to be 1/4 the blade edgewise natural frequency ( 1/4 of approx. 1Hz = 0.25Hz = 1.570796rad/s) -REAL(4) :: GenSpeed ! Current HSS (generator) speed, rad/s. -REAL(4), SAVE :: GenSpeedF ! Filtered HSS (generator) speed, rad/s. -REAL(4) :: GenTrq ! Electrical generator torque, N-m. -REAL(4) :: GK ! Current value of the gain correction factor, used in the gain scheduling law of the pitch controller, (-). -REAL(4) :: HorWindV ! Horizontal hub-heigh wind speed, m/s. -REAL(4), SAVE :: IntSpdErr ! Current integral of speed error w.r.t. time, rad. -REAL(4), SAVE :: LastGenTrq ! Commanded electrical generator torque the last time the controller was called, N-m. -REAL(4), SAVE :: LastTime ! Last time this DLL was called, sec. -REAL(4), SAVE :: LastTimePC ! Last time the pitch controller was called, sec. -REAL(4), SAVE :: LastTimeVS ! Last time the torque controller was called, sec. -REAL(4), PARAMETER :: OnePlusEps = 1.0 + EPSILON(OnePlusEps) ! The number slighty greater than unity in single precision. -REAL(4), PARAMETER :: PC_DT = 0.000125 !JASON:THIS CHANGED FOR ITI BARGE: 0.0001 ! Communication interval for pitch controller, sec. -REAL(4), PARAMETER :: PC_KI = 0.008068634 ! Integral gain for pitch controller at rated pitch (zero), (-). -REAL(4), PARAMETER :: PC_KK = 0.1099965 ! Pitch angle where the the derivative of the aerodynamic power w.r.t. pitch has increased by a factor of two relative to the derivative at rated pitch (zero), rad. -REAL(4), PARAMETER :: PC_KP = 0.01882681 ! Proportional gain for pitch controller at rated pitch (zero), sec. -REAL(4), PARAMETER :: PC_MaxPit = 1.570796 ! Maximum pitch setting in pitch controller, rad. -REAL(4), PARAMETER :: PC_MaxRat = 0.1396263 ! Maximum pitch rate (in absolute value) in pitch controller, rad/s. -REAL(4), PARAMETER :: PC_MinPit = 0.0 ! Minimum pitch setting in pitch controller, rad. -REAL(4), PARAMETER :: PC_RefSpd = 122.9096 ! Desired (reference) HSS speed for pitch controller, rad/s. -REAL(4), SAVE :: PitCom (3) ! Commanded pitch of each blade the last time the controller was called, rad. -REAL(4) :: PitComI ! Integral term of command pitch, rad. -REAL(4) :: PitComP ! Proportional term of command pitch, rad. -REAL(4) :: PitComT ! Total command pitch based on the sum of the proportional and integral terms, rad. -REAL(4) :: PitRate (3) ! Pitch rates of each blade based on the current pitch angles and current pitch command, rad/s. -REAL(4), PARAMETER :: R2D = 57.295780 ! Factor to convert radians to degrees. -REAL(4), PARAMETER :: RPS2RPM = 9.5492966 ! Factor to convert radians per second to revolutions per minute. -REAL(4) :: SpdErr ! Current speed error, rad/s. -REAL(4) :: Time ! Current simulation time, sec. -REAL(4) :: TrqRate ! Torque rate based on the current and last torque commands, N-m/s. -REAL(4), PARAMETER :: VS_CtInSp = 70.16224 ! Transitional generator speed (HSS side) between regions 1 and 1 1/2, rad/s. -REAL(4), PARAMETER :: VS_DT = 0.000125 !JASON:THIS CHANGED FOR ITI BARGE: 0.0001 ! Communication interval for torque controller, sec. -REAL(4), PARAMETER :: VS_MaxRat = 15000.0 ! Maximum torque rate (in absolute value) in torque controller, N-m/s. -REAL(4), PARAMETER :: VS_MaxTq = 47402.91 ! Maximum generator torque in Region 3 (HSS side), N-m. -- chosen to be 10% above VS_RtTq = 43.09355kNm -REAL(4), PARAMETER :: VS_Rgn2K = 2.332287 ! Generator torque constant in Region 2 (HSS side), N-m/(rad/s)^2. -REAL(4), PARAMETER :: VS_Rgn2Sp = 91.21091 ! Transitional generator speed (HSS side) between regions 1 1/2 and 2, rad/s. -REAL(4), PARAMETER :: VS_Rgn3MP = 0.01745329 ! Minimum pitch angle at which the torque is computed as if we are in region 3 regardless of the generator speed, rad. -- chosen to be 1.0 degree above PC_MinPit -REAL(4), PARAMETER :: VS_RtGnSp = 121.6805 ! Rated generator speed (HSS side), rad/s. -- chosen to be 99% of PC_RefSpd -REAL(4), PARAMETER :: VS_RtPwr = 5296610.0 ! Rated generator generator power in Region 3, Watts. -- chosen to be 5MW divided by the electrical generator efficiency of 94.4% -REAL(4), SAVE :: VS_Slope15 ! Torque/speed slope of region 1 1/2 cut-in torque ramp , N-m/(rad/s). -REAL(4), SAVE :: VS_Slope25 ! Torque/speed slope of region 2 1/2 induction generator, N-m/(rad/s). -REAL(4), PARAMETER :: VS_SlPc = 10.0 ! Rated generator slip percentage in Region 2 1/2, %. -REAL(4), SAVE :: VS_SySp ! Synchronous speed of region 2 1/2 induction generator, rad/s. -REAL(4), SAVE :: VS_TrGnSp ! Transitional generator speed (HSS side) between regions 2 and 2 1/2, rad/s. - -INTEGER(4) :: I ! Generic index. -INTEGER(4) :: iStatus ! A status flag set by the simulation as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation. -INTEGER(4) :: K ! Loops through blades. -INTEGER(4) :: NumBl ! Number of blades, (-). -INTEGER(4), PARAMETER :: UnDb = 85 ! I/O unit for the debugging information -INTEGER(4), PARAMETER :: UnDb2 = 86 ! I/O unit for the debugging information -INTEGER(4), PARAMETER :: Un = 87 ! I/O unit for pack/unpack (checkpoint & restart) -INTEGER(4) :: ErrStat - -LOGICAL(1), PARAMETER :: PC_DbgOut = .FALSE. ! Flag to indicate whether to output debugging information - -CHARACTER( 1), PARAMETER :: Tab = CHAR( 9 ) ! The tab character. -CHARACTER( 25), PARAMETER :: FmtDat = "(F8.3,99('"//Tab//"',ES10.3E2,:))" ! The format of the debugging data - -CHARACTER(SIZE(accINFILE)-1) :: InFile ! a Fortran version of the input C string (not considered an array here) [subtract 1 for the C null-character] -CHARACTER(SIZE(avcOUTNAME)-1):: RootName ! a Fortran version of the input C string (not considered an array here) [subtract 1 for the C null-character] -CHARACTER(SIZE(avcMSG)-1) :: ErrMsg ! a Fortran version of the C string argument (not considered an array here) [subtract 1 for the C null-character] - - - ! Load variables from calling program (See Appendix A of Bladed User's Guide): - -iStatus = NINT( avrSWAP( 1) ) -NumBl = NINT( avrSWAP(61) ) - -!print *, 'from_sc: ', from_sc(1:4) -!to_sc(1) = 5.0; -!to_sc(2) = 2.0; - - -!BlPitch (1) = MIN( MAX( avrSWAP( 4), PC_MinPit ), PC_MaxPit ) ! assume that blade pitch can't exceed limits -!BlPitch (2) = MIN( MAX( avrSWAP(33), PC_MinPit ), PC_MaxPit ) ! assume that blade pitch can't exceed limits -!BlPitch (3) = MIN( MAX( avrSWAP(34), PC_MinPit ), PC_MaxPit ) ! assume that blade pitch can't exceed limits -BlPitch (1) = avrSWAP( 4) -BlPitch (2) = avrSWAP(33) -BlPitch (3) = avrSWAP(34) -GenSpeed = avrSWAP(20) -HorWindV = avrSWAP(27) -Time = avrSWAP( 2) - - ! Convert C character arrays to Fortran strings: - -RootName = TRANSFER( avcOUTNAME(1:LEN(RootName)), RootName ) -I = INDEX(RootName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... -IF ( I > 0 ) RootName = RootName(1:I) ! remove it - -InFile = TRANSFER( accINFILE(1:LEN(InFile)), InFile ) -I = INDEX(InFile,C_NULL_CHAR) - 1 ! if this has a c null character at the end... -IF ( I > 0 ) InFile = InFile(1:I) ! remove it - - - - ! Initialize aviFAIL to 0: - -aviFAIL = 0 - - - ! Read any External Controller Parameters specified in the User Interface - ! and initialize variables: - -IF ( iStatus == 0 ) THEN ! .TRUE. if we're on the first call to the DLL - - ! Inform users that we are using this user-defined routine: - - aviFAIL = 1 - ErrMsg = 'Running with torque and pitch control of the NREL offshore '// & - '5MW baseline wind turbine from DISCON.dll as written by J. '// & - 'Jonkman of NREL/NWTC for use in the IEA Annex XXIII OC3 ' // & - 'studies.' - - ! Determine some torque control parameters not specified directly: - - VS_SySp = VS_RtGnSp/( 1.0 + 0.01*VS_SlPc ) - VS_Slope15 = ( VS_Rgn2K*VS_Rgn2Sp*VS_Rgn2Sp )/( VS_Rgn2Sp - VS_CtInSp ) - VS_Slope25 = ( VS_RtPwr/VS_RtGnSp )/( VS_RtGnSp - VS_SySp ) - IF ( VS_Rgn2K == 0.0 ) THEN ! .TRUE. if the Region 2 torque is flat, and thus, the denominator in the ELSE condition is zero - VS_TrGnSp = VS_SySp - ELSE ! .TRUE. if the Region 2 torque is quadratic with speed - VS_TrGnSp = ( VS_Slope25 - SQRT( VS_Slope25*( VS_Slope25 - 4.0*VS_Rgn2K*VS_SySp ) ) )/( 2.0*VS_Rgn2K ) - ENDIF - - - ! Check validity of input parameters: - - IF ( CornerFreq <= 0.0 ) THEN - aviFAIL = -1 - ErrMsg = 'CornerFreq must be greater than zero.' - ENDIF - - IF ( VS_DT <= 0.0 ) THEN - aviFAIL = -1 - ErrMsg = 'VS_DT must be greater than zero.' - ENDIF - - IF ( VS_CtInSp < 0.0 ) THEN - aviFAIL = -1 - ErrMsg = 'VS_CtInSp must not be negative.' - ENDIF - - IF ( VS_Rgn2Sp <= VS_CtInSp ) THEN - aviFAIL = -1 - ErrMsg = 'VS_Rgn2Sp must be greater than VS_CtInSp.' - ENDIF - - IF ( VS_TrGnSp < VS_Rgn2Sp ) THEN - aviFAIL = -1 - ErrMsg = 'VS_TrGnSp must not be less than VS_Rgn2Sp.' - ENDIF - - IF ( VS_SlPc <= 0.0 ) THEN - aviFAIL = -1 - ErrMsg = 'VS_SlPc must be greater than zero.' - ENDIF - - IF ( VS_MaxRat <= 0.0 ) THEN - aviFAIL = -1 - ErrMsg = 'VS_MaxRat must be greater than zero.' - ENDIF - - IF ( VS_RtPwr < 0.0 ) THEN - aviFAIL = -1 - ErrMsg = 'VS_RtPwr must not be negative.' - ENDIF - - IF ( VS_Rgn2K < 0.0 ) THEN - aviFAIL = -1 - ErrMsg = 'VS_Rgn2K must not be negative.' - ENDIF - - IF ( VS_Rgn2K*VS_RtGnSp*VS_RtGnSp > VS_RtPwr/VS_RtGnSp ) THEN - aviFAIL = -1 - ErrMsg = 'VS_Rgn2K*VS_RtGnSp^2 must not be greater than VS_RtPwr/VS_RtGnSp.' - ENDIF - - IF ( VS_MaxTq < VS_RtPwr/VS_RtGnSp ) THEN - aviFAIL = -1 - ErrMsg = 'VS_RtPwr/VS_RtGnSp must not be greater than VS_MaxTq.' - ENDIF - - IF ( PC_DT <= 0.0 ) THEN - aviFAIL = -1 - ErrMsg = 'PC_DT must be greater than zero.' - ENDIF - - IF ( PC_KI <= 0.0 ) THEN - aviFAIL = -1 - ErrMsg = 'PC_KI must be greater than zero.' - ENDIF - - IF ( PC_KK <= 0.0 ) THEN - aviFAIL = -1 - ErrMsg = 'PC_KK must be greater than zero.' - ENDIF - - IF ( PC_RefSpd <= 0.0 ) THEN - aviFAIL = -1 - ErrMsg = 'PC_RefSpd must be greater than zero.' - ENDIF - - IF ( PC_MaxRat <= 0.0 ) THEN - aviFAIL = -1 - ErrMsg = 'PC_MaxRat must be greater than zero.' - ENDIF - - IF ( PC_MinPit >= PC_MaxPit ) THEN - aviFAIL = -1 - ErrMsg = 'PC_MinPit must be less than PC_MaxPit.' - ENDIF - - - ! If we're debugging the pitch controller, open the debug file and write the - ! header: - - IF ( PC_DbgOut ) THEN - - OPEN ( UnDb, FILE=TRIM( RootName )//'.dbg', STATUS='REPLACE' ) - - WRITE (UnDb,'(/////)') - WRITE (UnDb,'(A)') 'Time '//Tab//'ElapTime'//Tab//'HorWindV'//Tab//'GenSpeed'//Tab//'GenSpeedF'//Tab//'RelSpdErr'//Tab// & - 'SpdErr '//Tab//'IntSpdErr'//Tab//'GK '//Tab//'PitComP'//Tab//'PitComI'//Tab//'PitComT'//Tab// & - 'PitRate1'//Tab//'PitRate2'//Tab//'PitRate3'//Tab//'PitCom1'//Tab//'PitCom2'//Tab//'PitCom3'//Tab// & - 'BlPitch1'//Tab//'BlPitch2'//Tab//'BlPitch3' - WRITE (UnDb,'(A)') '(sec)'//Tab//'(sec) '//Tab//'(m/sec) '//Tab//'(rpm) '//Tab//'(rpm) '//Tab//'(%) '//Tab// & - '(rad/s)'//Tab//'(rad) '//Tab//'(-)'//Tab//'(deg) '//Tab//'(deg) '//Tab//'(deg) '//Tab// & - '(deg/s) '//Tab//'(deg/s) '//Tab//'(deg/s) '//Tab//'(deg) '//Tab//'(deg) '//Tab//'(deg) '//Tab// & - '(deg) '//Tab//'(deg) '//Tab//'(deg) ' - - - OPEN ( UnDb2, FILE=TRIM( RootName )//'.dbg2', STATUS='REPLACE' ) - WRITE (UnDb2,'(/////)') - - WRITE (UnDb2,'(A,85("'//Tab//'AvrSWAP(",I2,")"))') 'Time ', (i,i=1,85) - WRITE (UnDb2,'(A,85("'//Tab//'(-)"))') '(s)' - - ENDIF - - - ! Initialize the SAVEd variables: - ! NOTE: LastGenTrq, though SAVEd, is initialized in the torque controller - ! below for simplicity, not here. - - GenSpeedF = GenSpeed ! This will ensure that generator speed filter will use the initial value of the generator speed on the first pass - PitCom = BlPitch ! This will ensure that the variable speed controller picks the correct control region and the pitch controller picks the correct gain on the first call - GK = 1.0/( 1.0 + PitCom(1)/PC_KK ) ! This will ensure that the pitch angle is unchanged if the initial SpdErr is zero - IntSpdErr = PitCom(1)/( GK*PC_KI ) ! This will ensure that the pitch angle is unchanged if the initial SpdErr is zero - - LastTime = Time ! This will ensure that generator speed filter will use the initial value of the generator speed on the first pass - LastTimePC = Time - PC_DT ! This will ensure that the pitch controller is called on the first pass - LastTimeVS = Time - VS_DT ! This will ensure that the torque controller is called on the first pass - - -ENDIF - - - - ! Main control calculations: - -IF ( ( iStatus >= 0 ) .AND. ( aviFAIL >= 0 ) ) THEN ! Only compute control calculations if no error has occured and we are not on the last time step - - - - ! Abort if the user has not requested a pitch angle actuator (See Appendix A - ! of Bladed User's Guide): - - IF ( NINT(avrSWAP(10)) /= 0 ) THEN ! .TRUE. if a pitch angle actuator hasn't been requested - aviFAIL = -1 - ErrMsg = 'Pitch angle actuator not requested.' - ENDIF - - - ! Set unused outputs to zero (See Appendix A of Bladed User's Guide): - - avrSWAP(36) = 0.0 ! Shaft brake status: 0=off - avrSWAP(41) = 0.0 ! Demanded yaw actuator torque - avrSWAP(46) = 0.0 ! Demanded pitch rate (Collective pitch) - avrSWAP(48) = 0.0 ! Demanded nacelle yaw rate - avrSWAP(65) = 0.0 ! Number of variables returned for logging - avrSWAP(72) = 0.0 ! Generator start-up resistance - avrSWAP(79) = 0.0 ! Request for loads: 0=none - avrSWAP(80) = 0.0 ! Variable slip current status - avrSWAP(81) = 0.0 ! Variable slip current demand - - -!======================================================================= - - - ! Filter the HSS (generator) speed measurement: - ! NOTE: This is a very simple recursive, single-pole, low-pass filter with - ! exponential smoothing. - - ! Update the coefficient in the recursive formula based on the elapsed time - ! since the last call to the controller: - - Alpha = EXP( ( LastTime - Time )*CornerFreq ) - - - ! Apply the filter: - - GenSpeedF = ( 1.0 - Alpha )*GenSpeed + Alpha*GenSpeedF - - -!======================================================================= - - - ! Variable-speed torque control: - - ! Compute the elapsed time since the last call to the controller: - - ElapTime = Time - LastTimeVS - - - ! Only perform the control calculations if the elapsed time is greater than - ! or equal to the communication interval of the torque controller: - ! NOTE: Time is scaled by OnePlusEps to ensure that the contoller is called - ! at every time step when VS_DT = DT, even in the presence of - ! numerical precision errors. - - IF ( ( Time*OnePlusEps - LastTimeVS ) >= VS_DT ) THEN - - - ! Compute the generator torque, which depends on which region we are in: - - IF ( ( GenSpeedF >= VS_RtGnSp ) .OR. ( PitCom(1) >= VS_Rgn3MP ) ) THEN ! We are in region 3 - power is constant - GenTrq = VS_RtPwr/GenSpeedF - ELSEIF ( GenSpeedF <= VS_CtInSp ) THEN ! We are in region 1 - torque is zero - GenTrq = 0.0 - ELSEIF ( GenSpeedF < VS_Rgn2Sp ) THEN ! We are in region 1 1/2 - linear ramp in torque from zero to optimal - GenTrq = VS_Slope15*( GenSpeedF - VS_CtInSp ) - ELSEIF ( GenSpeedF < VS_TrGnSp ) THEN ! We are in region 2 - optimal torque is proportional to the square of the generator speed - GenTrq = VS_Rgn2K*GenSpeedF*GenSpeedF - ELSE ! We are in region 2 1/2 - simple induction generator transition region - GenTrq = VS_Slope25*( GenSpeedF - VS_SySp ) - ENDIF - - - ! Saturate the commanded torque using the maximum torque limit: - - GenTrq = MIN( GenTrq , VS_MaxTq ) ! Saturate the command using the maximum torque limit - - - ! Saturate the commanded torque using the torque rate limit: - - IF ( iStatus == 0 ) LastGenTrq = GenTrq ! Initialize the value of LastGenTrq on the first pass only - TrqRate = ( GenTrq - LastGenTrq )/ElapTime ! Torque rate (unsaturated) - TrqRate = MIN( MAX( TrqRate, -VS_MaxRat ), VS_MaxRat ) ! Saturate the torque rate using its maximum absolute value - GenTrq = LastGenTrq + TrqRate*ElapTime ! Saturate the command using the torque rate limit - - - ! Reset the values of LastTimeVS and LastGenTrq to the current values: - - LastTimeVS = Time - LastGenTrq = GenTrq - - - ENDIF - - - ! Set the generator contactor status, avrSWAP(35), to main (high speed) - ! variable-speed generator, the torque override to yes, and command the - ! generator torque (See Appendix A of Bladed User's Guide): - - avrSWAP(35) = 1.0 ! Generator contactor status: 1=main (high speed) variable-speed generator - avrSWAP(56) = 0.0 ! Torque override: 0=yes - avrSWAP(47) = LastGenTrq ! Demanded generator torque - - -!======================================================================= - - - ! Pitch control: - - ! Compute the elapsed time since the last call to the controller: - - ElapTime = Time - LastTimePC - - - ! Only perform the control calculations if the elapsed time is greater than - ! or equal to the communication interval of the pitch controller: - ! NOTE: Time is scaled by OnePlusEps to ensure that the contoller is called - ! at every time step when PC_DT = DT, even in the presence of - ! numerical precision errors. - - IF ( ( Time*OnePlusEps - LastTimePC ) >= PC_DT ) THEN - - - ! Compute the gain scheduling correction factor based on the previously - ! commanded pitch angle for blade 1: - - GK = 1.0/( 1.0 + PitCom(1)/PC_KK ) - - - ! Compute the current speed error and its integral w.r.t. time; saturate the - ! integral term using the pitch angle limits: - - SpdErr = GenSpeedF - PC_RefSpd ! Current speed error - IntSpdErr = IntSpdErr + SpdErr*ElapTime ! Current integral of speed error w.r.t. time - IntSpdErr = MIN( MAX( IntSpdErr, PC_MinPit/( GK*PC_KI ) ), & - PC_MaxPit/( GK*PC_KI ) ) ! Saturate the integral term using the pitch angle limits, converted to integral speed error limits - - - ! Compute the pitch commands associated with the proportional and integral - ! gains: - - PitComP = GK*PC_KP* SpdErr ! Proportional term - PitComI = GK*PC_KI*IntSpdErr ! Integral term (saturated) - - - ! Superimpose the individual commands to get the total pitch command; - ! saturate the overall command using the pitch angle limits: - - PitComT = PitComP + PitComI ! Overall command (unsaturated) - PitComT = MIN( MAX( PitComT, PC_MinPit ), PC_MaxPit ) ! Saturate the overall command using the pitch angle limits - - - ! Saturate the overall commanded pitch using the pitch rate limit: - ! NOTE: Since the current pitch angle may be different for each blade - ! (depending on the type of actuator implemented in the structural - ! dynamics model), this pitch rate limit calculation and the - ! resulting overall pitch angle command may be different for each - ! blade. - - DO K = 1,NumBl ! Loop through all blades - - PitRate(K) = ( PitComT - BlPitch(K) )/ElapTime ! Pitch rate of blade K (unsaturated) - PitRate(K) = MIN( MAX( PitRate(K), -PC_MaxRat ), PC_MaxRat ) ! Saturate the pitch rate of blade K using its maximum absolute value - PitCom (K) = BlPitch(K) + PitRate(K)*ElapTime ! Saturate the overall command of blade K using the pitch rate limit - - PitCom(K) = MIN( MAX( PitCom(K), PC_MinPit ), PC_MaxPit ) ! Saturate the overall command using the pitch angle limits - - ENDDO ! K - all blades - - - ! Reset the value of LastTimePC to the current value: - - LastTimePC = Time - - - ! Output debugging information if requested: - - IF ( PC_DbgOut ) THEN - WRITE (UnDb,FmtDat) Time, ElapTime, HorWindV, GenSpeed*RPS2RPM, GenSpeedF*RPS2RPM, & - 100.0*SpdErr/PC_RefSpd, SpdErr, IntSpdErr, GK, PitComP*R2D, PitComI*R2D, & - PitComT*R2D, PitRate*R2D, PitCom*R2D, BlPitch*R2D - - END IF - - ENDIF - - - ! Set the pitch override to yes and command the pitch demanded from the last - ! call to the controller (See Appendix A of Bladed User's Guide): - - avrSWAP(55) = 0.0 ! Pitch override: 0=yes - - avrSWAP(42) = PitCom(1) ! Use the command angles of all blades if using individual pitch - avrSWAP(43) = PitCom(2) ! " - avrSWAP(44) = PitCom(3) ! " - - avrSWAP(45) = PitCom(1) ! Use the command angle of blade 1 if using collective pitch - - IF ( PC_DbgOut ) WRITE (UnDb2,FmtDat) Time, avrSWAP(1:85) - -!======================================================================= - - - ! Reset the value of LastTime to the current value: - - LastTime = Time - -ELSEIF ( iStatus == -8 ) THEN - ! pack - OPEN( Un, FILE=TRIM( InFile ), STATUS='UNKNOWN', FORM='UNFORMATTED' , ACCESS='STREAM', IOSTAT=ErrStat, ACTION='WRITE' ) - - IF ( ErrStat /= 0 ) THEN - ErrMsg = 'Cannot open file "'//TRIM( InFile )//'". Another program may have locked it for writing.' - aviFAIL = -1 - ELSE - - ! write all static variables to the checkpoint file (inverse of unpack): - WRITE( Un, IOSTAT=ErrStat ) GenSpeedF ! Filtered HSS (generator) speed, rad/s. - WRITE( Un, IOSTAT=ErrStat ) IntSpdErr ! Current integral of speed error w.r.t. time, rad. - WRITE( Un, IOSTAT=ErrStat ) LastGenTrq ! Commanded electrical generator torque the last time the controller was called, N-m. - WRITE( Un, IOSTAT=ErrStat ) LastTime ! Last time this DLL was called, sec. - WRITE( Un, IOSTAT=ErrStat ) LastTimePC ! Last time the pitch controller was called, sec. - WRITE( Un, IOSTAT=ErrStat ) LastTimeVS ! Last time the torque controller was called, sec. - WRITE( Un, IOSTAT=ErrStat ) PitCom ! Commanded pitch of each blade the last time the controller was called, rad. - WRITE( Un, IOSTAT=ErrStat ) VS_Slope15 ! Torque/speed slope of region 1 1/2 cut-in torque ramp , N-m/(rad/s). - WRITE( Un, IOSTAT=ErrStat ) VS_Slope25 ! Torque/speed slope of region 2 1/2 induction generator, N-m/(rad/s). - WRITE( Un, IOSTAT=ErrStat ) VS_SySp ! Synchronous speed of region 2 1/2 induction generator, rad/s. - WRITE( Un, IOSTAT=ErrStat ) VS_TrGnSp ! Transitional generator speed (HSS side) between regions 2 and 2 1/2, rad/s. - - CLOSE ( Un ) - - END IF - -ELSEIF( iStatus == -9 ) THEN - !unpack - OPEN( Un, FILE=TRIM( InFile ), STATUS='OLD', FORM='UNFORMATTED', ACCESS='STREAM', IOSTAT=ErrStat, ACTION='READ' ) - - IF ( ErrStat /= 0 ) THEN - aviFAIL = -1 - ErrMsg = ' Cannot open file "'//TRIM( InFile )//'" for reading. Another program may have locked.' - ELSE - - ! READ all static variables from the restart file (inverse of pack): - READ( Un, IOSTAT=ErrStat ) GenSpeedF ! Filtered HSS (generator) speed, rad/s. - READ( Un, IOSTAT=ErrStat ) IntSpdErr ! Current integral of speed error w.r.t. time, rad. - READ( Un, IOSTAT=ErrStat ) LastGenTrq ! Commanded electrical generator torque the last time the controller was called, N-m. - READ( Un, IOSTAT=ErrStat ) LastTime ! Last time this DLL was called, sec. - READ( Un, IOSTAT=ErrStat ) LastTimePC ! Last time the pitch controller was called, sec. - READ( Un, IOSTAT=ErrStat ) LastTimeVS ! Last time the torque controller was called, sec. - READ( Un, IOSTAT=ErrStat ) PitCom ! Commanded pitch of each blade the last time the controller was called, rad. - READ( Un, IOSTAT=ErrStat ) VS_Slope15 ! Torque/speed slope of region 1 1/2 cut-in torque ramp , N-m/(rad/s). - READ( Un, IOSTAT=ErrStat ) VS_Slope25 ! Torque/speed slope of region 2 1/2 induction generator, N-m/(rad/s). - READ( Un, IOSTAT=ErrStat ) VS_SySp ! Synchronous speed of region 2 1/2 induction generator, rad/s. - READ( Un, IOSTAT=ErrStat ) VS_TrGnSp ! Transitional generator speed (HSS side) between regions 2 and 2 1/2, rad/s. - - CLOSE ( Un ) - END IF - - -ENDIF - -avcMSG = TRANSFER( TRIM(ErrMsg)//C_NULL_CHAR, avcMSG, SIZE(avcMSG) ) - -RETURN -END SUBROUTINE DISCON -!======================================================================= diff --git a/OpenFAST/share/docker/openfast_dev/Dockerfile b/OpenFAST/share/docker/openfast_dev/Dockerfile deleted file mode 100644 index 5042c7bbb..000000000 --- a/OpenFAST/share/docker/openfast_dev/Dockerfile +++ /dev/null @@ -1,29 +0,0 @@ -# -# Copyright 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. -# - -FROM rafmudaf/openfast-ubuntu:v2.3.0 - -# Move into the openfast directory and update -WORKDIR /openfast -RUN git fetch && \ - git checkout -b dev origin/dev && \ - git submodule update - -# Move into the "build" directory, remove the old reg tests, and compile -WORKDIR /openfast/build -RUN rm -rf reg_tests && \ - cmake .. && \ - make -j4 install diff --git a/OpenFAST/share/docker/openfast_ubuntu/Dockerfile b/OpenFAST/share/docker/openfast_ubuntu/Dockerfile deleted file mode 100644 index 8470e5623..000000000 --- a/OpenFAST/share/docker/openfast_ubuntu/Dockerfile +++ /dev/null @@ -1,54 +0,0 @@ -# -# Copyright 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. -# - -FROM ubuntu:bionic - -# Install dependencies - -# For gfortran-8 -# RUN add-apt-repository ppa:ubuntu-toolchain-r/test -y -# apt-get install gfortran-8 - -ENV DEBIAN_FRONTEND=noninteractive TZ=America/Denver - -RUN apt update -qq && \ - apt install -y software-properties-common build-essential && \ - add-apt-repository ppa:git-core/ppa -y && \ - apt install -y python3-pip && \ - apt install -y cmake cmake-curses-gui && \ - apt install -y gcc gfortran make && \ - apt install -y libblas-dev liblapack-dev && \ - apt install -y git && \ - apt install -y nano - -RUN pip3 install numpy - -# Configure the environment -ENV FC=/usr/bin/gfortran - -# Clone the project -RUN git clone --recursive https://github.com/openfast/openfast.git openfast -WORKDIR /openfast - -# Build the project -RUN mkdir build -WORKDIR /openfast/build - -# NOTE: building with optimizations on (RELEASE or RELWITHDEBINFO), the virtual machine -# will require about 6GB of memoery. Otherwise, the gfortran compiler will exit with an -# "internal error" -RUN cmake .. -DBUILD_TESTING=ON -DDOUBLE_PRECISION=ON -DCMAKE_BUILD_TYPE=RELWITHDEBINFO -RUN make -j4 install diff --git a/OpenFAST/share/fast-build-cpp-spack.sh b/OpenFAST/share/fast-build-cpp-spack.sh deleted file mode 100755 index fd5ca9c8e..000000000 --- a/OpenFAST/share/fast-build-cpp-spack.sh +++ /dev/null @@ -1,41 +0,0 @@ -#!/bin/bash - -set -ex - -COMPILER=gcc -SPACK_ROOT= -SPACK_EXE=${SPACK_ROOT}/bin/spack -module purge -module load gcc/5.2.0 -module load python/2.7.8 -module use ${SPACK_ROOT}/share/spack/modules/$(${SPACK_EXE} arch) -module load $(${SPACK_EXE} module find cmake %${COMPILER}) -module load $(${SPACK_EXE} module find openmpi %${COMPILER}) -module load $(${SPACK_EXE} module find hdf5 %${COMPILER}) -module load $(${SPACK_EXE} module find zlib %${COMPILER}) -module load $(${SPACK_EXE} module find libxml2 %${COMPILER}) -module load $(${SPACK_EXE} module find xz %${COMPILER}) -module load $(${SPACK_EXE} module find binutils %${COMPILER}) -module list -which cmake - - -OPENFAST_DIR= -yaml_install_dir=`${SPACK_EXE} location -i yaml-cpp %${COMPILER}` -hdf5_install_dir=`${SPACK_EXE} location -i hdf5 %${COMPILER}` -zlib_install_dir=`${SPACK_EXE} location -i zlib %${COMPILER}` -libxml2_install_dir=`${SPACK_EXE} location -i libxml2 %${COMPILER}` -CC=gcc CXX=g++ FC=gfortran cmake \ - -DCMAKE_INSTALL_PREFIX=${OPENFAST_DIR}/install/ \ - -DCMAKE_BUILD_TYPE=DEBUG \ - -DBUILD_OPENFAST_CPP_API=ON \ - -DFPE_TRAP_ENABLED:BOOL=ON \ - -DYAML_ROOT:PATH=$yaml_install_dir \ - -DHDF5_USE_STATIC_LIBRARIES=ON \ - -DHDF5_ROOT:PATH=$hdf5_install_dir \ - -DLIBXML2_ROOT:PATH=$libxml2_install_dir \ - -DLIBXML2_USE_STATIC_LIBRARIES=ON \ - -DHDF5_ROOT:PATH=$hdf5_install_dir \ - $EXTRA_ARGS \ -../ &> log.cmake -make VERBOSE=1 &> log.make diff --git a/OpenFAST/share/fast-build-cpp.sh b/OpenFAST/share/fast-build-cpp.sh deleted file mode 100755 index 5477dac7e..000000000 --- a/OpenFAST/share/fast-build-cpp.sh +++ /dev/null @@ -1,17 +0,0 @@ -openfast_dir= -yaml_install_dir=$openfast_dir/install/ -hdf5_install_dir=$openfast_dir/install/ - -EXTRA_ARGS=$@ - -CC=mpicc CXX=mpic++ FC=gfortran cmake \ - -DCMAKE_INSTALL_PREFIX=$openfast_dir/install/ \ - -DCMAKE_BUILD_TYPE=RELEASE \ - -DBUILD_OPENFAST_CPP_API=ON \ - -DYAML_ROOT:PATH=$yaml_install_dir \ - -DHDF5_USE_STATIC_LIBRARIES=ON \ - -DHDF5_ROOT:PATH=$hdf5_install_dir \ - -DFPE_TRAP_ENABLED=OFF \ - $EXTRA_ARGS \ -../ &> log.cmake - diff --git a/OpenFAST/share/fast-build.sh b/OpenFAST/share/fast-build.sh deleted file mode 100755 index 64831a633..000000000 --- a/OpenFAST/share/fast-build.sh +++ /dev/null @@ -1,16 +0,0 @@ -openfast_dir= -yaml_install_dir=$openfast_dir/install/ -hdf5_install_dir=$openfast_dir/install/ - -EXTRA_ARGS=$@ - -CC=mpicc CXX=mpic++ FC=gfortran cmake \ - -DCMAKE_INSTALL_PREFIX=$openfast_dir/install/ \ - -DCMAKE_BUILD_TYPE=RELEASE \ - -DYAML_ROOT:PATH=$yaml_install_dir \ - -DHDF5_USE_STATIC_LIBRARIES=ON \ - -DHDF5_ROOT:PATH=$hdf5_install_dir \ - -DFPE_TRAP_ENABLED=OFF \ - $EXTRA_ARGS \ -../ &> log.cmake - diff --git a/OpenFAST/share/fast-install.sh b/OpenFAST/share/fast-install.sh deleted file mode 100755 index 14b20efce..000000000 --- a/OpenFAST/share/fast-install.sh +++ /dev/null @@ -1,118 +0,0 @@ -#!/bin/bash - -passFail() { - if [ $1 -eq 0 ] - then - echo "... PASSED" - else - echo "... FAILED" - fi -} - -prepInstall() { -#Prepare for installation - echo -n "Prepping install" - echo -n $PWD > /tmp/fastDir - openfast_dir=$(sed 's:/:\\/:g' /tmp/fastDir) - echo "export openfast_dir=${openfast_dir}" > .prepInstall - source .prepInstall - passFail $? -} - -compileLapack() { -#Registry - echo -n "Compiling Lapack" - [ -d modules/lapack ] || mkdir modules/lapack - cd modules/lapack - curl -k -o lapack-3.6.0.tgz http://www.netlib.org/lapack/lapack-3.6.0.tgz &> log.wget - tar -zxf lapack-3.6.0.tgz &> log.untar - [ -d build ] || mkdir build - cd build - make clean &> /dev/null - # if [ -f CMakeCache.txt] ; then - # rm CMakeCache.txt - # fi - cmake -DCMAKE_CXX_COMPILER=g++ -DCMAKE_C_COMPILER=gcc -DCMAKE_FORTRAN_COMPILER=gfortran -DCMAKE_INSTALL_PREFIX=../../../../install/ -DCMAKE_BUILD_TYPE=RELEASE -DBUILD_SHARED_LIBS=ON -DBUILD_DEPRECATED=ON -DLAPACKE=ON ../lapack-3.6.0 &> log.config - make -j 8 &> log.make - make install &> log.makeInstall - passFail $? - cd ${openfast_dir} -} - -compileYAMLcpp() { -#yaml-cpp - echo "Compiling yaml-cpp" - echo -n " Setting up build directory" - [ -d modules/yaml-cpp ] || mkdir modules/yaml-cpp - cd modules/yaml-cpp - git clone https://github.com/jbeder/yaml-cpp.git &> /dev/null - [ -d build ] || mkdir build - cd build - if [ -f CMakeCache.txt ] ; then - rm -rf CMakeCache.txt CMakeFiles/ - fi - passFail $? - echo -n " Configuring" - cmake ../yaml-cpp/ -DCMAKE_INSTALL_PREFIX=${openfast_dir}/install &> log.cmake - passFail $? - echo -n " Compiling" - make -j 8 &> log.make - passFail $? - echo -n " Installing" - make install &> log.makeInstall - passFail $? - cd ${openfast_dir} -} - -compileHDF5() { - echo "Compiling hdf5" - echo -n " Getting source" - [ -d modules/hdf5 ] || mkdir modules/hdf5 - cd modules/hdf5 - wget --no-check-certificate https://support.hdfgroup.org/ftp/HDF5/releases/hdf5-1.10/hdf5-1.10.1/src/hdf5-1.10.1.tar.bz2 &> log.wget - passFail $? - echo -n " Setting up build directory" - tar -jxf hdf5-1.10.1.tar.bz2 &> log.untar - cd hdf5-1.10.1 - passFail $? - echo -n " Configuring" - ./configure CC=mpicc FC=mpif90 CXX=mpicxx --enable-parallel --prefix=${openfast_dir}/install &> log.config - passFail $? - echo -n " Compiling" - make -j 8 &> log.make - passFail $? - echo -n " Installing" - make install &> log.makeInstall - passFail $? - cd ${openfast_dir} -} - -compileOpenFAST() { - echo "Compiling OpenFAST" - echo -n " Setting up config" - [ -d build ] || mkdir build - cd build/ - make clean &> /dev/null - # if [ -f CMakeCache.txt] ; then - # rm CMakeCache.txt - # fi - cp ${openfast_dir}/share/fast-build-cpp.sh . - passFail $? - echo -n " Configuring" - ./fast-build-cpp.sh - passFail $? - echo -n " Compiling" - make &> log.make - passFail $? - echo -n " Installing" - make install &> log.makeInstall - passFail $? - cd ${openfast_dir} -} - -prepInstall -compileYAMLcpp -compileHDF5 -compileOpenFAST - - diff --git a/OpenFAST/share/spack/package.py b/OpenFAST/share/spack/package.py deleted file mode 100644 index fa95189d5..000000000 --- a/OpenFAST/share/spack/package.py +++ /dev/null @@ -1,99 +0,0 @@ -############################################################################## -# Copyright (c) 2013-2016, Lawrence Livermore National Security, LLC. -# Produced at the Lawrence Livermore National Laboratory. -# -# This file is part of Spack. -# Created by Todd Gamblin, tgamblin@llnl.gov, All rights reserved. -# LLNL-CODE-647188 -# -# For details, see https://github.com/llnl/spack -# Please also see the LICENSE file for our notice and the LGPL. -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU Lesser General Public License (as -# published by the Free Software Foundation) version 2.1, February 1999. -# -# This program is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the IMPLIED WARRANTY OF -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the terms and -# conditions of the GNU Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -############################################################################## -from spack import * - - -class Openfast(CMakePackage): - """NREL OpenFAST - Wind Turbine Simulation Package""" - - homepage = "http://openfast.readthedocs.io/en/latest/" - url = "https://github.com/OpenFAST/openfast.git" - - version('develop', - git='https://github.com/OpenFAST/openfast.git', - branch='dev') - version('master', - git='https://github.com/OpenFAST/openfast.git', - branch='master') - - variant('shared', default=False, - description="Build shared libraries") - variant('double-precision', default=True, - description="Treat REAL as double precision") - variant('dll-interface', default=True, - description="Enable dynamic library loading interface") - variant('cxx', default=False, - description="Enable C++ bindings") - variant('debug', default=False, - description="Enable debugging symbols with RelWithDebInfo") - - # Dependencies for OpenFAST Fortran - depends_on('blas') - depends_on('lapack') - - # Additional dependencies when compiling C++ library - depends_on('mpi', when='+cxx') - depends_on('yaml-cpp', when='+cxx') - depends_on('hdf5+mpi+cxx', when='+cxx') - depends_on('zlib', when='+cxx') - depends_on('libxml2', when='+cxx') - - # Disable parallel builds because of OpenFOAM Types modules dependencies - parallel = False - - def build_type(self): - if '+debug' in self.spec: - return 'RelWithDebInfo' - else: - return 'Release' - - def cmake_args(self): - spec = self.spec - - options = [] - - options.extend([ - '-DBUILD_SHARED_LIBS:BOOL=%s' % ( - 'ON' if '+shared' in spec else 'OFF'), - '-DDOUBLE_PRECISION:BOOL=%s' % ( - 'ON' if '+double-precision' in spec else 'OFF'), - '-DUSE_DLL_INTERFACE:BOOL=%s' % ( - 'ON' if '+dll-interface' in spec else 'OFF'), - '-DBUILD_OPENFAST_CPP_API:BOOL=%s' % ( - 'ON' if '+cxx' in spec else 'OFF'), - ]) - - if '+cxx' in spec: - options.extend([ - '-DHDF5_ROOT:PATH=%s' % spec['hdf5'].prefix, - '-DYAML_ROOT:PATH=%s' % spec['yaml-cpp'].prefix, - ]) - - if not '+shared' in spec: - options.extend([ - '-DHDF5_USE_STATIC_LIBRARIES=ON', - ]) - - return options diff --git a/OpenFAST/share/template-module/ChangeLog.txt b/OpenFAST/share/template-module/ChangeLog.txt deleted file mode 100644 index 996c6b23c..000000000 --- a/OpenFAST/share/template-module/ChangeLog.txt +++ /dev/null @@ -1,38 +0,0 @@ -ModuleName: The Template for modules in the FAST modularization framework - - -v1.00.02 22-Oct-2012 - Shortened some local variable names in the module and driver code (Param = p, ContState = x, etc.) - -v1.00.03 13-Nov-2012 - Modified template to address changes in Registry-generated code - -v1.00.04, 25-Jan-2013 - Cleaned up some text, removed the references to PACK and and UNPACK, as they are generated by the Registry. - -v1.00.05, 28-Jan-2013 - Made InitOut%WriteOutputHdr, InitOut%WriteOutputUnt, and y%WriteOutput ALLOCATABLE arrays. - -v1.01.00, 1-Mar-2013 - I renamed variable "Time" to "t" in the template.f90 file. - I added input "n" to _UpdateStates() and _UpdateDiscState() routines. n will start at zero. - I added an additional output argument to _UpdateStates(): zGuess(t+Increment) - I renamed "z_residual" to "Z_residual" - I modified the "u" input argument to _UpdateStates() to be an array of "Inputs", and I added a "InputTimes" array to - indicate what times are associated with each input. - -v1.02.00, 26-Mar-2013 - I removed z_next from the _UpdateStates routine and changed the description of the z argument (it - is no longer a "guess" at time t). The input z is the value at time t and the output z is the value - at time t+Interval. - I replaced "equations" with "functions" in the comments. - -v1.02.01, 21-May-2013 - I modified the INTENT attribute on the Inputs(:) argument of the template. This modification is due to the use - of the ExtrapInterp routine, which may need to update record-keeping attributes in Meshes. - -v2.00.00, 13-Nov-2015 - I added a MiscVar type as a standard type to split OtherStates into actual logical (other) states and miscellaneous variables - for optimization. OtherStates will now be associated with time, and miscellaneous variables will be used for optimzation, - not associated with time. - I modified the template with Doxygen-style comments and error handling. diff --git a/OpenFAST/share/template-module/README.md b/OpenFAST/share/template-module/README.md deleted file mode 100644 index 426d0c425..000000000 --- a/OpenFAST/share/template-module/README.md +++ /dev/null @@ -1,3 +0,0 @@ -# OpenFAST Module Template - -This directory contains a template for modules within the OpenFAST Framework. diff --git a/OpenFAST/share/template-module/src/ModuleName.f90 b/OpenFAST/share/template-module/src/ModuleName.f90 deleted file mode 100644 index 7a8af084f..000000000 --- a/OpenFAST/share/template-module/src/ModuleName.f90 +++ /dev/null @@ -1,851 +0,0 @@ -!********************************************************************************************************************************** -!> ## ModuleName -!! The ModuleName and ModuleName_Types modules make up a template for creating user-defined calculations in the FAST Modularization -!! Framework. ModuleName_Types will be auto-generated by the FAST registry program, based on the variables specified in the -!! ModuleName_Registry.txt file. -!! -!! This template file contains comments in the style required for Doxygen, and it contains methods for handling errors. -!! -!! "ModuleName" should be replaced with the name of your module. Example: ElastoDyn \n -!! "ModName" (in ModName_*) should be replaced with the module name or an abbreviation of it. Example: ED -! .................................................................................................................................. -!! ## LICENSING -!! Copyright (C) 2012-2013, 2015-2016 National Renewable Energy Laboratory -!! -!! This file is part of ModuleName. -!! -!! 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. -!********************************************************************************************************************************** -MODULE ModuleName - - USE ModuleName_Types - USE NWTC_Library - - IMPLICIT NONE - - PRIVATE - - TYPE(ProgDesc), PARAMETER :: ModName_Ver = ProgDesc( 'ModuleName', 'v2.01.00', '7-Jul-2016' ) !< module date/version information - - - ! ..... Public Subroutines ................................................................................................... - - PUBLIC :: ModName_Init ! Initialization routine - PUBLIC :: ModName_End ! Ending routine (includes clean up) - - PUBLIC :: ModName_UpdateStates ! Loose coupling routine for solving for constraint states, integrating - ! continuous states, and updating discrete states - PUBLIC :: ModName_CalcOutput ! Routine for computing outputs - - PUBLIC :: ModName_CalcConstrStateResidual ! Tight coupling routine for returning the constraint state residual - PUBLIC :: ModName_CalcContStateDeriv ! Tight coupling routine for computing derivatives of continuous states - PUBLIC :: ModName_UpdateDiscState ! Tight coupling routine for updating discrete states - - PUBLIC :: ModName_JacobianPInput ! Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- - ! (Xd), and constraint-state (Z) functions all with respect to the inputs (u) - PUBLIC :: ModName_JacobianPContState ! Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- - ! (Xd), and constraint-state (Z) functions all with respect to the continuous - ! states (x) - PUBLIC :: ModName_JacobianPDiscState ! Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- - ! (Xd), and constraint-state (Z) functions all with respect to the discrete - ! states (xd) - PUBLIC :: ModName_JacobianPConstrState ! Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- - ! (Xd), and constraint-state (Z) functions all with respect to the constraint - ! states (z) - - PUBLIC :: ModName_GetOP ! Routine to get the operating-point values for linearization (from data structures to arrays) - -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 ModName_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(ModName_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine - TYPE(ModName_InputType), INTENT( OUT) :: u !< An initial guess for the input; input mesh must be defined - TYPE(ModName_ParameterType), INTENT( OUT) :: p !< Parameters - TYPE(ModName_ContinuousStateType), INTENT( OUT) :: x !< Initial continuous states - TYPE(ModName_DiscreteStateType), INTENT( OUT) :: xd !< Initial discrete states - TYPE(ModName_ConstraintStateType), INTENT( OUT) :: z !< Initial guess of the constraint states - TYPE(ModName_OtherStateType), INTENT( OUT) :: OtherState !< Initial other states (logical, etc) - TYPE(ModName_OutputType), INTENT( OUT) :: y !< Initial system outputs (outputs are not calculated; - !! only the output mesh is initialized) - TYPE(ModName_MiscVarType), INTENT( OUT) :: m !< Misc variables for optimization (not copied in glue code) - REAL(DbKi), INTENT(INOUT) :: Interval !< Coupling interval in seconds: the rate that - !! (1) ModName_UpdateStates() is called in loose coupling & - !! (2) ModName_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. - TYPE(ModName_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 - - INTEGER(IntKi) :: NumOuts ! number of outputs; would probably be in the parameter type - INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_Init' - - ! Initialize variables - ErrStat = ErrID_None - ErrMsg = "" - NumOuts = 2 - - - ! Initialize the NWTC Subroutine Library - call NWTC_Init( ) - - ! Display the module information - call DispNVD( ModName_Ver ) - - - ! Define parameters here: - p%DT = Interval - - - ! Define initial system states here: - x%DummyContState = 0.0_ReKi - xd%DummyDiscState = 0.0_ReKi - z%DummyConstrState = 0.0_ReKi - OtherState%DummyOtherState = 0.0_ReKi - - - ! Define optimization variables here: - m%DummyMiscVar = 0.0_ReKi - - - ! Define initial guess for the system inputs here: - u%DummyInput = 0.0_ReKi - - - ! Define system output initializations (set up mesh) here: - call AllocAry( y%WriteOutput, NumOuts, 'WriteOutput', ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! set return error status based on local (concatenate errors) - if (ErrStat >= AbortErrLev) return ! if there are local variables that need to be deallocated, do so before early return - - y%DummyOutput = 0 - y%WriteOutput = 0 - - - ! Define initialization-routine output here: - call AllocAry(InitOut%WriteOutputHdr,NumOuts,'WriteOutputHdr',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(InitOut%WriteOutputUnt,NumOuts,'WriteOutputUnt',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return ! if there are local variables that need to be deallocated, do so before early return - - InitOut%WriteOutputHdr = (/ 'Time ', 'Column2' /) - InitOut%WriteOutputUnt = (/ '(s)', '(-)' /) - - - ! If you want to choose your own rate instead of using what the glue code suggests, tell the glue code the rate at which - ! this module must be called here: - - !Interval = p%DT - - - if (InitInp%Linearize) then - - ! If the module does not implement the four Jacobian routines at the end of this template, or the module cannot - ! linearize with the features that are enabled, stop the simulation if InitInp%Linearize is true. - - CALL SetErrStat( ErrID_Fatal, 'ModuleName cannot perform linearization analysis.', ErrStat, ErrMsg, RoutineName) - - ! Otherwise, if the module does allow linearization, return the appropriate Jacobian row/column names and rotating-frame flags here: - ! Allocate and set these variables: InitOut%LinNames_y, InitOut%LinNames_x, InitOut%LinNames_xd, InitOut%LinNames_z, InitOut%LinNames_u - ! Allocate and set these variables: InitOut%RotFrame_y, InitOut%RotFrame_x, InitOut%RotFrame_xd, InitOut%RotFrame_z, InitOut%RotFrame_u - - end if - - -END SUBROUTINE ModName_Init -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is called at the end of the simulation. -SUBROUTINE ModName_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(ModName_InputType), INTENT(INOUT) :: u !< System inputs - TYPE(ModName_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(ModName_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states - TYPE(ModName_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states - TYPE(ModName_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states - TYPE(ModName_OtherStateType), INTENT(INOUT) :: OtherState !< Other states - TYPE(ModName_OutputType), INTENT(INOUT) :: y !< System outputs - TYPE(ModName_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) - 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 ! local error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_End' - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - - !! Place any last minute operations or calculations here: - - - !! Close files here (but because of checkpoint-restart capability, it is not recommended to have files open during the simulation): - - - !! Destroy the input data: - - call ModName_DestroyInput( u, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - !! Destroy the parameter data: - - call ModName_DestroyParam( p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - !! Destroy the state data: - - call ModName_DestroyContState( x, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call ModName_DestroyDiscState( xd, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call ModName_DestroyConstrState( z, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call ModName_DestroyOtherState( OtherState, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - !! Destroy the output data: - - call ModName_DestroyOutput( y, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - !! Destroy the misc data: - - call ModName_DestroyMisc( m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - -END SUBROUTINE ModName_End -!---------------------------------------------------------------------------------------------------------------------------------- -!> This is a loose coupling routine for solving constraint states, integrating continuous states, and updating discrete and other -!! states. Continuous, constraint, discrete, and other states are updated to values at t + Interval. -SUBROUTINE ModName_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval - TYPE(ModName_InputType), INTENT(INOUT) :: Inputs(:) !< Inputs at InputTimes (output from this routine only - !! because of record keeping in routines that copy meshes) - REAL(DbKi), INTENT(IN ) :: InputTimes(:) !< Times in seconds associated with Inputs - TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(ModName_ContinuousStateType), INTENT(INOUT) :: x !< Input: Continuous states at t; - !! Output: Continuous states at t + Interval - TYPE(ModName_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t; - !! Output: Discrete states at t + Interval - TYPE(ModName_ConstraintStateType), INTENT(INOUT) :: z !< Input: Constraint states at t; - !! Output: Constraint states at t + Interval - TYPE(ModName_OtherStateType), INTENT(INOUT) :: OtherState !< Other states: Other states at t; - !! Output: Other states at t + Interval - TYPE(ModName_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Local variables - - TYPE(ModName_ContinuousStateType) :: dxdt ! Continuous state derivatives at t - TYPE(ModName_DiscreteStateType) :: xd_t ! Discrete states at t (copy) - TYPE(ModName_ConstraintStateType) :: z_Residual ! Residual of the constraint state functions (Z) - TYPE(ModName_InputType) :: u ! Instantaneous inputs - - INTEGER(IntKi) :: ErrStat2 ! local error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_UpdateStates' - - - ! Initialize variables - - ErrStat = ErrID_None ! no error has occurred - ErrMsg = "" - - - ! This subroutine contains an example of how the states could be updated. Developers will - ! want to adjust the logic as necessary for their own situations. - - - - ! Get the inputs at time t, based on the array of values sent by the glue code: - - ! before calling ExtrapInterp routine, memory in u must be allocated; we can do that with a copy: - call ModName_CopyInput( Inputs(1), u, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() ! to avoid memory leaks, we have to destroy the local variables that may have allocatable arrays or meshes - return - end if - - call ModName_Input_ExtrapInterp( Inputs, InputTimes, u, t, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - return - end if - - - - ! Get first time derivatives of continuous states (dxdt): - - call ModName_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - return - end if - - - ! Update discrete states: - ! Note that xd [discrete state] is changed in ModName_UpdateDiscState() so xd will now contain values at t+Interval - ! We'll first make a copy that contains xd at time t, which will be used in computing the constraint states - call ModName_CopyDiscState( xd, xd_t, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - return - end if - - call ModName_UpdateDiscState( t, n, u, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - return - end if - - - ! Solve for the constraint states (z) here: - - ! Iterate until the value is within a given tolerance. - - ! DO - - call ModName_CalcConstrStateResidual( t, u, p, x, xd_t, z, OtherState, m, Z_Residual, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - return - end if - - ! z = - - ! END DO - - - - ! Integrate (update) continuous states (x) here: - - !x = function of dxdt and x - - - ! Destroy local variables before returning - call cleanup() - - -CONTAINS - SUBROUTINE cleanup() - ! note that this routine inherits all of the data in ModName_UpdateStates - - - CALL ModName_DestroyInput( u, ErrStat2, ErrMsg2) - CALL ModName_DestroyConstrState( Z_Residual, ErrStat2, ErrMsg2) - CALL ModName_DestroyContState( dxdt, ErrStat2, ErrMsg2) - CALL ModName_DestroyDiscState( xd_t, ErrStat2, ErrMsg2) - - END SUBROUTINE cleanup -END SUBROUTINE ModName_UpdateStates -!---------------------------------------------------------------------------------------------------------------------------------- -!> This is a routine for computing outputs, used in both loose and tight coupling. -SUBROUTINE ModName_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t - TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(ModName_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) - TYPE(ModName_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- - !! nectivity information does not have to be recalculated) - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - - ! Compute outputs here: - y%DummyOutput = 2.0_ReKi - - y%WriteOutput(1) = REAL(t,ReKi) - y%WriteOutput(2) = 1.0_ReKi - - -END SUBROUTINE ModName_CalcOutput -!---------------------------------------------------------------------------------------------------------------------------------- - - -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> This is a tight coupling routine for computing derivatives of continuous states. -SUBROUTINE ModName_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t - TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(ModName_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) - TYPE(ModName_ContinuousStateType), INTENT( OUT) :: dxdt !< Continuous state derivatives at t - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - - ! Compute the first time derivatives of the continuous states here: - - dxdt%DummyContState = 0.0_ReKi - -END SUBROUTINE ModName_CalcContStateDeriv -!---------------------------------------------------------------------------------------------------------------------------------- -!> This is a tight coupling routine for updating discrete states. -SUBROUTINE ModName_UpdateDiscState( t, n, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval - TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(ModName_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t; - !! Output: Discrete states at t + Interval - TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t - TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(ModName_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - - ! Update discrete states here: - - xd%DummyDiscState = 0.0_Reki - -END SUBROUTINE ModName_UpdateDiscState -!---------------------------------------------------------------------------------------------------------------------------------- -!> This is a tight coupling routine for solving for the residual of the constraint state functions. -SUBROUTINE ModName_CalcConstrStateResidual( t, u, p, x, xd, z, OtherState, m, Z_residual, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at t - TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t (possibly a guess) - TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(ModName_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) - TYPE(ModName_ConstraintStateType), INTENT( OUT) :: Z_residual !< Residual of the constraint state functions using - !! the input values described above - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - - ! Solve for the residual of the constraint state functions here: - - Z_residual%DummyConstrState = 0.0_ReKi - -END SUBROUTINE ModName_CalcConstrStateResidual -!---------------------------------------------------------------------------------------------------------------------------------- - - -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -! ###### The following four routines are Jacobian routines for linearization capabilities ####### -! If the module does not implement them, set ErrStat = ErrID_Fatal in ModName_Init() when InitInp%Linearize is .true. -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and DZ/du are returned. -SUBROUTINE ModName_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required); - !! Output fields are not used by this routine, but type is - !! available here so that mesh parameter information (i.e., - !! connectivity) does not have to be recalculated for dYdu. - TYPE(ModName_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 - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect - !! to the inputs (u) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with - !! respect to the inputs (u) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with - !! respect to the inputs (u) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with - !! respect to the inputs (u) [intent in to avoid deallocation] - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - - - IF ( PRESENT( dYdu ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: - - ! allocate and set dYdu - - END IF - - IF ( PRESENT( dXdu ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: - - ! allocate and set dXdu - - END IF - - IF ( PRESENT( dXddu ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the inputs (u) here: - - ! allocate and set dXddu - - END IF - - IF ( PRESENT( dZdu ) ) THEN - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the inputs (u) here: - - ! allocate and set dZdu - - END IF - - -END SUBROUTINE ModName_JacobianPInput -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and DZ/dx are returned. -SUBROUTINE ModName_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required); - !! Output fields are not used by this routine, but type is - !! available here so that mesh parameter information (i.e., - !! connectivity) does not have to be recalculated for dYdx. - TYPE(ModName_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 - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions - !! (Y) with respect to the continuous - !! states (x) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state - !! functions (X) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state - !! functions (Xd) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state - !! functions (Z) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - - - - IF ( PRESENT( dYdx ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: - - ! allocate and set dYdx - - END IF - - IF ( PRESENT( dXdx ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: - - ! allocate and set dXdx - - END IF - - IF ( PRESENT( dXddx ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the continuous states (x) here: - - ! allocate and set dXddx - - END IF - - IF ( PRESENT( dZdx ) ) THEN - - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the continuous states (x) here: - - ! allocate and set dZdx - - END IF - - -END SUBROUTINE ModName_JacobianPContState -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the discrete states (xd). The partial derivatives dY/dxd, dX/dxd, dXd/dxd, and DZ/dxd are returned. -SUBROUTINE ModName_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required); - !! Output fields are not used by this routine, but type is - !! available here so that mesh parameter information (i.e., - !! connectivity) does not have to be recalculated for dYdxd. - TYPE(ModName_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 - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdxd(:,:) !< Partial derivatives of output functions - !! (Y) with respect to the discrete - !! states (xd) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdxd(:,:) !< Partial derivatives of continuous state - !! functions (X) with respect to the - !! discrete states (xd) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddxd(:,:)!< Partial derivatives of discrete state - !! functions (Xd) with respect to the - !! discrete states (xd) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdxd(:,:) !< Partial derivatives of constraint state - !! functions (Z) with respect to the - !! discrete states (xd) [intent in to avoid deallocation] - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - - - IF ( PRESENT( dYdxd ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the discrete states (xd) here: - - ! allocate and set dYdxd - - END IF - - IF ( PRESENT( dXdxd ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the discrete states (xd) here: - - ! allocate and set dXdxd - - END IF - - IF ( PRESENT( dXddxd ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the discrete states (xd) here: - - ! allocate and set dXddxd - - END IF - - IF ( PRESENT( dZdxd ) ) THEN - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the discrete states (xd) here: - - ! allocate and set dZdxd - - END IF - - -END SUBROUTINE ModName_JacobianPDiscState -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the constraint states (z). The partial derivatives dY/dz, dX/dz, dXd/dz, and DZ/dz are returned. -SUBROUTINE ModName_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required); - !! Output fields are not used by this routine, but type is - !! available here so that mesh parameter information (i.e., - !! connectivity) does not have to be recalculated for dYdz. - TYPE(ModName_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 - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdz(:,:) !< Partial derivatives of output - !! functions (Y) with respect to the - !! constraint states (z) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdz(:,:) !< Partial derivatives of continuous - !! state functions (X) with respect to - !! the constraint states (z) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddz(:,:) !< Partial derivatives of discrete state - !! functions (Xd) with respect to the - !! constraint states (z) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdz(:,:) !< Partial derivatives of constraint - !! state functions (Z) with respect to - !! the constraint states (z) [intent in to avoid deallocation] - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - - IF ( PRESENT( dYdz ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z) here: - - ! allocate and set dYdz - - END IF - - IF ( PRESENT( dXdz ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the constraint states (z) here: - - ! allocate and set dXdz - - END IF - - IF ( PRESENT( dXddz ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the constraint states (z) here: - - ! allocate and set dXddz - - END IF - - IF ( PRESENT( dZdz ) ) THEN - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z) here: - - ! allocate and set dZdz - - END IF - - -END SUBROUTINE ModName_JacobianPConstrState -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE ModName_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output at operating point - TYPE(ModName_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 - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - - IF ( PRESENT( u_op ) ) THEN - - END IF - - IF ( PRESENT( y_op ) ) THEN - END IF - - IF ( PRESENT( x_op ) ) THEN - - END IF - - IF ( PRESENT( dx_op ) ) THEN - - END IF - - IF ( PRESENT( xd_op ) ) THEN - - END IF - - IF ( PRESENT( z_op ) ) THEN - - END IF - -END SUBROUTINE ModName_GetOP -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - -END MODULE ModuleName -!********************************************************************************************************************************** diff --git a/OpenFAST/share/template-module/src/ModuleName_Registry.txt b/OpenFAST/share/template-module/src/ModuleName_Registry.txt deleted file mode 100644 index 424928843..000000000 --- a/OpenFAST/share/template-module/src/ModuleName_Registry.txt +++ /dev/null @@ -1,78 +0,0 @@ -################################################################################################################################### -# Registry for ModuleName in the FAST Modularization Framework -# This Registry file is used to create MODULE ModuleName_Types, which contains all of the user-defined types needed in ModuleName. -# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. -# -# Entries are of the form -# keyword -# -# Use ^ as a shortcut for the value from the previous line. -# See NWTC Programmer's Handbook for further information on the format/contents of this file. -################################################################################################################################### - -# ...... Include files (definitions from NWTC Library) ............................................................................ -include Registry_NWTC_Library.txt - - -# ..... Initialization data ....................................................................................................... -# Define inputs that the initialization routine may need here: -# e.g., the name of the input file, the file root name, etc. -typedef ModuleName/ModName InitInputType CHARACTER(1024) InputFile - - - "Name of the input file; remove if there is no file" - -typedef ^ ^ LOGICAL Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - - -# Define outputs from the initialization routine here: -typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - -typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - -# if this module has implemented linearization, return the names of the rows/columns of the Jacobian matrices: -#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - -#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - -#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_xd {:} - - "Names of the discrete states used in linearization" - -#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_z {:} - - "Names of the constraint states used in linearization" - -#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - -#typedef ^ InitOutputType LOGICAL RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - -#typedef ^ InitOutputType LOGICAL RotFrame_x {:} - - "Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame" - -#typedef ^ InitOutputType LOGICAL RotFrame_xd {:} - - "Flag that tells FAST if the discrete states used in linearization are in the rotating frame" - -#typedef ^ InitOutputType LOGICAL RotFrame_z {:} - - "Flag that tells FAST if the constraint states used in linearization are in the rotating frame" - -#typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - - - -# ..... States .................................................................................................................... -# Define continuous (differentiable) states here: -typedef ^ ContinuousStateType ReKi DummyContState - - - "Remove this variable if you have continuous states" - - -# Define discrete (nondifferentiable) states here: -typedef ^ DiscreteStateType ReKi DummyDiscState - - - "Remove this variable if you have discrete states" - - -# Define constraint states here: -typedef ^ ConstraintStateType ReKi DummyConstrState - - - "Remove this variable if you have constraint states" - - -# Define any other states, including integer or logical states here: -typedef ^ OtherStateType IntKi DummyOtherState - - - "Remove this variable if you have other states" - - - -# ..... Misc/Optimization variables................................................................................................. -# 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 ReKi DummyMiscVar - - - "Remove this variable if you have misc/optimization variables" - - - -# ..... Parameters ................................................................................................................ -# Define parameters here: -# Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: -typedef ^ ParameterType DbKi DT - - - "Time step for cont. state integration & disc. state update" seconds - - -# ..... Inputs .................................................................................................................... -# Define inputs that are contained on the mesh here: -#typedef ^ InputType MeshType MeshedInput - - - "Meshed data" - -# Define inputs that are not on this mesh here: -typedef ^ InputType ReKi DummyInput - - - "Remove this variable if you have input data" - - - -# ..... Outputs ................................................................................................................... -# Define outputs that are contained on the mesh here: -#typedef ModuleName ModName_OutputType MeshType MeshedOutput - - - "Meshed data" - -# Define outputs that are not on this mesh here: -typedef ^ OutputType ReKi DummyOutput - - - "Remove this variable if you have output data" - -typedef ^ ^ ReKi WriteOutput {:} - - "Example of data to be written to an output file" "s,-" - diff --git a/OpenFAST/share/template-module/src/ModuleName_Types.f90 b/OpenFAST/share/template-module/src/ModuleName_Types.f90 deleted file mode 100644 index da54b58b1..000000000 --- a/OpenFAST/share/template-module/src/ModuleName_Types.f90 +++ /dev/null @@ -1,1916 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'ModuleName_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 (v3.01.01, 19-Apr-2016) -!********************************************************************************************************************************* -! ModuleName_Types -!................................................................................................................................. -! This file is part of ModuleName. -! -! 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 ModuleName. 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 ModuleName_Types -!--------------------------------------------------------------------------------------------------------------------------------- -USE NWTC_Library -IMPLICIT NONE -! ========= ModName_InitInputType ======= - TYPE, PUBLIC :: ModName_InitInputType - CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] - LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] - END TYPE ModName_InitInputType -! ======================= -! ========= ModName_InitOutputType ======= - TYPE, PUBLIC :: ModName_InitOutputType - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] - END TYPE ModName_InitOutputType -! ======================= -! ========= ModName_ContinuousStateType ======= - TYPE, PUBLIC :: ModName_ContinuousStateType - REAL(ReKi) :: DummyContState !< Remove this variable if you have continuous states [-] - END TYPE ModName_ContinuousStateType -! ======================= -! ========= ModName_DiscreteStateType ======= - TYPE, PUBLIC :: ModName_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] - END TYPE ModName_DiscreteStateType -! ======================= -! ========= ModName_ConstraintStateType ======= - TYPE, PUBLIC :: ModName_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] - END TYPE ModName_ConstraintStateType -! ======================= -! ========= ModName_OtherStateType ======= - TYPE, PUBLIC :: ModName_OtherStateType - INTEGER(IntKi) :: DummyOtherState !< Remove this variable if you have other states [-] - END TYPE ModName_OtherStateType -! ======================= -! ========= ModName_MiscVarType ======= - TYPE, PUBLIC :: ModName_MiscVarType - REAL(ReKi) :: DummyMiscVar !< Remove this variable if you have misc/optimization variables [-] - END TYPE ModName_MiscVarType -! ======================= -! ========= ModName_ParameterType ======= - TYPE, PUBLIC :: ModName_ParameterType - REAL(DbKi) :: DT !< Time step for cont. state integration & disc. state update [seconds] - END TYPE ModName_ParameterType -! ======================= -! ========= ModName_InputType ======= - TYPE, PUBLIC :: ModName_InputType - REAL(ReKi) :: DummyInput !< Remove this variable if you have input data [-] - END TYPE ModName_InputType -! ======================= -! ========= ModName_OutputType ======= - TYPE, PUBLIC :: ModName_OutputType - REAL(ReKi) :: DummyOutput !< Remove this variable if you have output data [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Example of data to be written to an output file [s,-] - END TYPE ModName_OutputType -! ======================= -CONTAINS - SUBROUTINE ModName_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ModName_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(ModName_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%Linearize = SrcInitInputData%Linearize - END SUBROUTINE ModName_CopyInitInput - - SUBROUTINE ModName_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(ModName_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_DestroyInitInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE ModName_DestroyInitInput - - SUBROUTINE ModName_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ModName_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1 ! Linearize - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ModName_PackInitInput - - SUBROUTINE ModName_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ModName_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ModName_UnPackInitInput - - SUBROUTINE ModName_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ModName_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(ModName_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - END SUBROUTINE ModName_CopyInitOutput - - SUBROUTINE ModName_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(ModName_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_DestroyInitOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - END SUBROUTINE ModName_DestroyInitOutput - - SUBROUTINE ModName_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ModName_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - END IF - END SUBROUTINE ModName_PackInitOutput - - SUBROUTINE ModName_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ModName_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - END IF - END SUBROUTINE ModName_UnPackInitOutput - - SUBROUTINE ModName_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ModName_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(ModName_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE ModName_CopyContState - - SUBROUTINE ModName_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(ModName_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_DestroyContState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE ModName_DestroyContState - - SUBROUTINE ModName_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ModName_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyContState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ModName_PackContState - - SUBROUTINE ModName_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ModName_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyContState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ModName_UnPackContState - - SUBROUTINE ModName_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ModName_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(ModName_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE ModName_CopyDiscState - - SUBROUTINE ModName_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(ModName_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_DestroyDiscState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE ModName_DestroyDiscState - - SUBROUTINE ModName_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ModName_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyDiscState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ModName_PackDiscState - - SUBROUTINE ModName_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ModName_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ModName_UnPackDiscState - - SUBROUTINE ModName_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ModName_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(ModName_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE ModName_CopyConstrState - - SUBROUTINE ModName_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(ModName_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_DestroyConstrState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE ModName_DestroyConstrState - - SUBROUTINE ModName_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ModName_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ModName_PackConstrState - - SUBROUTINE ModName_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ModName_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ModName_UnPackConstrState - - SUBROUTINE ModName_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ModName_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(ModName_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE ModName_CopyOtherState - - SUBROUTINE ModName_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(ModName_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_DestroyOtherState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE ModName_DestroyOtherState - - SUBROUTINE ModName_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ModName_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! DummyOtherState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ModName_PackOtherState - - SUBROUTINE ModName_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ModName_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ModName_UnPackOtherState - - SUBROUTINE ModName_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ModName_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(ModName_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar - END SUBROUTINE ModName_CopyMisc - - SUBROUTINE ModName_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(ModName_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_DestroyMisc' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE ModName_DestroyMisc - - SUBROUTINE ModName_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ModName_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyMiscVar - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ModName_PackMisc - - SUBROUTINE ModName_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ModName_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyMiscVar = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ModName_UnPackMisc - - SUBROUTINE ModName_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ModName_ParameterType), INTENT(IN) :: SrcParamData - TYPE(ModName_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - END SUBROUTINE ModName_CopyParam - - SUBROUTINE ModName_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(ModName_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_DestroyParam' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE ModName_DestroyParam - - SUBROUTINE ModName_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ModName_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE ModName_PackParam - - SUBROUTINE ModName_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ModName_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE ModName_UnPackParam - - SUBROUTINE ModName_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ModName_InputType), INTENT(IN) :: SrcInputData - TYPE(ModName_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputData%DummyInput = SrcInputData%DummyInput - END SUBROUTINE ModName_CopyInput - - SUBROUTINE ModName_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(ModName_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_DestroyInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE ModName_DestroyInput - - SUBROUTINE ModName_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ModName_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyInput - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyInput - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ModName_PackInput - - SUBROUTINE ModName_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ModName_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyInput = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ModName_UnPackInput - - SUBROUTINE ModName_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ModName_OutputType), INTENT(IN) :: SrcOutputData - TYPE(ModName_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOutputData%DummyOutput = SrcOutputData%DummyOutput -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - END SUBROUTINE ModName_CopyOutput - - SUBROUTINE ModName_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(ModName_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_DestroyOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE ModName_DestroyOutput - - SUBROUTINE ModName_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ModName_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyOutput - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOutput - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) - END IF - END SUBROUTINE ModName_PackOutput - - SUBROUTINE ModName_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ModName_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyOutput = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) - END IF - END SUBROUTINE ModName_UnPackOutput - - - SUBROUTINE ModName_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(ModName_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(ModName_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL ModName_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL ModName_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL ModName_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE ModName_Input_ExtrapInterp - - - SUBROUTINE ModName_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = u1, f(t2) = u2 -! -!.................................................................................................................................. - - TYPE(ModName_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(ModName_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(ModName_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - b0 = -(u1%DummyInput - u2%DummyInput)/t(2) - u_out%DummyInput = u1%DummyInput + b0 * t_out - END SUBROUTINE ModName_Input_ExtrapInterp1 - - - SUBROUTINE ModName_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 -! -!.................................................................................................................................. - - TYPE(ModName_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(ModName_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(ModName_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(ModName_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_Input_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - b0 = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%DummyInput = u1%DummyInput + b0 * t_out + c0 * t_out**2 - END SUBROUTINE ModName_Input_ExtrapInterp2 - - - SUBROUTINE ModName_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(ModName_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(ModName_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL ModName_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL ModName_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL ModName_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE ModName_Output_ExtrapInterp - - - SUBROUTINE ModName_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = y1, f(t2) = y2 -! -!.................................................................................................................................. - - TYPE(ModName_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(ModName_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(ModName_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - b0 = -(y1%DummyOutput - y2%DummyOutput)/t(2) - y_out%DummyOutput = y1%DummyOutput + b0 * t_out -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) -END IF ! check if allocated - END SUBROUTINE ModName_Output_ExtrapInterp1 - - - SUBROUTINE ModName_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 -! -!.................................................................................................................................. - - TYPE(ModName_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(ModName_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(ModName_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(ModName_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'ModName_Output_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - b0 = (t(3)**2*(y1%DummyOutput - y2%DummyOutput) + t(2)**2*(-y1%DummyOutput + y3%DummyOutput))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%DummyOutput + t(3)*y2%DummyOutput - t(2)*y3%DummyOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%DummyOutput = y1%DummyOutput + b0 * t_out + c0 * t_out**2 -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) -END IF ! check if allocated - END SUBROUTINE ModName_Output_ExtrapInterp2 - -END MODULE ModuleName_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/OpenFAST/share/template-module/src/drivers/ModName_Driver.f90 b/OpenFAST/share/template-module/src/drivers/ModName_Driver.f90 deleted file mode 100644 index 6e6bae299..000000000 --- a/OpenFAST/share/template-module/src/drivers/ModName_Driver.f90 +++ /dev/null @@ -1,128 +0,0 @@ -!********************************************************************************************************************************** -!> ## ModuleName_DriverCode: This code tests the template modules -!!.................................................................................................................................. -!! LICENSING -!! Copyright (C) 2012, 2015 National Renewable Energy Laboratory -!! -!! This file is part of ModuleName. -!! -!! 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. -!********************************************************************************************************************************** -PROGRAM ModName_Driver - - USE NWTC_Library - USE ModuleName - USE ModuleName_Types - - IMPLICIT NONE - - INTEGER(IntKi), PARAMETER :: NumInp = 1 !< Number of inputs sent to ModName_UpdateStates - - ! Program variables - - REAL(DbKi) :: Time !< Variable for storing time, in seconds - REAL(DbKi) :: TimeInterval !< Interval between time steps, in seconds - REAL(DbKi) :: InputTime(NumInp) !< Variable for storing time associated with inputs, in seconds - - TYPE(ModName_InitInputType) :: InitInData !< Input data for initialization - TYPE(ModName_InitOutputType) :: InitOutData !< Output data from initialization - - TYPE(ModName_ContinuousStateType) :: x !< Continuous states - TYPE(ModName_DiscreteStateType) :: xd !< Discrete states - TYPE(ModName_ConstraintStateType) :: z !< Constraint states - TYPE(ModName_ConstraintStateType) :: Z_residual !< Residual of the constraint state functions (Z) - TYPE(ModName_OtherStateType) :: OtherState !< Other states - TYPE(ModName_MiscVarType) :: misc !< Optimization variables - - TYPE(ModName_ParameterType) :: p !< Parameters - TYPE(ModName_InputType) :: u(NumInp) !< System inputs - TYPE(ModName_OutputType) :: y !< System outputs - - - - INTEGER(IntKi) :: n !< Loop counter (for time step) - INTEGER(IntKi) :: ErrStat !< Status of error message - CHARACTER(ErrMsgLen) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - - !............................................................................................................................... - ! Routines called in initialization - !............................................................................................................................... - - ! Populate the InitInData data structure here: - - InitInData%InputFile = 'MyInputFileName.inp' - - ! Set the driver's request for time interval here: - - TimeInterval = 0.25 ! Glue code's request for delta time (likely based on information from other modules) - - - ! Initialize the module - - CALL ModName_Init( InitInData, u(1), p, x, xd, z, OtherState, y, misc, TimeInterval, InitOutData, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - - ! Destroy initialization data - - CALL ModName_DestroyInitInput( InitInData, ErrStat, ErrMsg ) - CALL ModName_DestroyInitOutput( InitOutData, ErrStat, ErrMsg ) - - - !............................................................................................................................... - ! Routines called in loose coupling -- the glue code may implement this in various ways - !............................................................................................................................... - - - DO n = 0,2 - - Time = n*TimeInterval - InputTime(1) = Time - - ! Modify u (likely from the outputs of another module or a set of test conditions) here: - - - ! Calculate outputs at n - - CALL ModName_CalcOutput( Time, u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - - ! Get state variables at next step: INPUT at step n, OUTPUT at step n + 1 - - CALL ModName_UpdateStates( Time, n, u, InputTime, p, x, xd, z, OtherState, misc, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - - END DO - - - !............................................................................................................................... - ! Routine to terminate program execution - !............................................................................................................................... - CALL ModName_End( u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ) - - IF ( ErrStat /= ErrID_None ) THEN - CALL WrScr( ErrMsg ) - END IF - - -END PROGRAM ModName_Driver diff --git a/OpenFAST/share/vscode/launch.json b/OpenFAST/share/vscode/launch.json deleted file mode 100644 index 77824f2e2..000000000 --- a/OpenFAST/share/vscode/launch.json +++ /dev/null @@ -1,43 +0,0 @@ -{ - // Use IntelliSense to learn about possible attributes. - // Hover to view descriptions of existing attributes. - // For more information, visit: https://go.microsoft.com/fwlink/?linkid=830387 - "version": "0.2.0", - "configurations": [ - { - "name": "5MW_OC3Trpd_DLL_WSt_WavesReg", - "type": "gdb", - "request": "launch", - "printCalls": false, - "showDevDebugOutput": true, - "valuesFormatting": "prettyPrinters", - "gdbpath": "gdb", - "target": "${workspaceRoot}/build/glue-codes/openfast/openfast", - "cwd": "${workspaceRoot}/build/reg_tests/glue-codes/openfast/5MW_OC3Trpd_DLL_WSt_WavesReg/", - "arguments": "5MW_OC3Trpd_DLL_WSt_WavesReg.fst" - }, - { - "name": "bd_curved_beam", - "type": "gdb", - "request": "launch", - "printCalls": false, - "showDevDebugOutput": false, - "valuesFormatting": "prettyPrinters", - "gdbpath": "gdb-ia", - "target": "${workspaceRoot}/build/modules-local/beamdyn/beamdyn_driver", - "cwd": "${workspaceRoot}/build/reg_tests/modules-local/beamdyn/bd_curved_beam/", - "arguments": "${workspaceRoot}/build/reg_tests/modules-local/beamdyn/bd_curved_beam/bd_driver.inp" - }, - { - "name": "beamdyn_utest", - "type": "gdb", - "request": "launch", - "printCalls": false, - "showDevDebugOutput": false, - "valuesFormatting": "prettyPrinters", - "gdbpath": "gdb-ia", - "target": "${workspaceRoot}/build/unit_tests/beamdyn_utest", - "cwd": "${workspaceRoot}/build/unit_tests" - } - ] -} \ No newline at end of file diff --git a/OpenFAST/unit_tests/CMakeLists.txt b/OpenFAST/unit_tests/CMakeLists.txt deleted file mode 100644 index 4339b0c43..000000000 --- a/OpenFAST/unit_tests/CMakeLists.txt +++ /dev/null @@ -1,80 +0,0 @@ -# -# 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. -# - -# ----------------------------------------------------------- -# -- OpenFAST Unit Testing -# ----------------------------------------------------------- - -cmake_minimum_required(VERSION 2.8.12) -project(OpenFAST_UnitTest Fortran) - -include(CTest) - -# Set the python executable configuration option and default -if(NOT EXISTS ${PYTHON_EXECUTABLE}) - find_program(PYTHON_EXECUTABLE NAMES python3 python py) - if(NOT EXISTS ${PYTHON_EXECUTABLE}) - message(FATAL_ERROR "CMake cannot find a Python interpreter in your path. Python is required to run OpenFAST tests." ) - endif() -endif() - -### pfunit -include(ExternalProject) -set(ExternalProjectCMakeArgs - -DCMAKE_INSTALL_PREFIX=${PROJECT_BINARY_DIR}/pfunit - -DCMAKE_Fortran_COMPILER=${CMAKE_Fortran_COMPILER} - -DROBUST=OFF -) -set(PFUNIT_INSTALL ${PROJECT_BINARY_DIR}/pfunit) - -ExternalProject_Add(pfunit - SOURCE_DIR ${PROJECT_SOURCE_DIR}/pfunit - BINARY_DIR ${PROJECT_BINARY_DIR}/pfunit-build - STAMP_DIR ${PROJECT_BINARY_DIR}/pfunit-stamp - TMP_DIR ${PROJECT_BINARY_DIR}/pfunit-tmp - INSTALL_DIR ${PFUNIT_INSTALL} - CMAKE_ARGS ${ExternalProjectCMakeArgs} -) - -include_directories(${PROJECT_BINARY_DIR}/pfunit/mod) - -set(pfunit_directory ${PFUNIT_INSTALL}) -set(source_modulesdirectory ${PROJECT_SOURCE_DIR}/../modules) -set(build_testdirectory ${PROJECT_BINARY_DIR}/tests) - -include_directories( - ${PROJECT_SOURCE_DIR} - ${build_testdirectory} - ${pfunit_directory}/mod -) - -set_source_files_properties(${pfunit_directory}/include/driver.F90 PROPERTIES GENERATED 1) -if(APPLE OR UNIX OR CYGWIN OR MINGW) - set(pfunit_lib "/lib/libpfunit.a") -else() # Windows - set(pfunit_lib "/lib/pfunit.lib") -endif() - -### Add the unit tests here -add_subdirectory("beamdyn") -add_subdirectory("nwtc-library") -add_subdirectory("aerodyn") -add_subdirectory("inflowwind") - -add_custom_target( - unit_tests - DEPENDS beamdyn_utest nwtc_library_utest fvw_utest inflowwind_utest -) diff --git a/OpenFAST/unit_tests/README.md b/OpenFAST/unit_tests/README.md deleted file mode 100644 index 48cc58948..000000000 --- a/OpenFAST/unit_tests/README.md +++ /dev/null @@ -1,14 +0,0 @@ -# openfast/unit_tests - -This directory contains the unit test suite for the OpenFAST framework. Contained in this directory are -- [pFUnit](http://pfunit.sourceforge.net), an external framework for Fortran unit testing -- CMake configuration file -- A unit test template file - -The dependencies for unit testing are: -- Python 3.7+ -- pFUnit -- CMake - -### Usage -See [readthedocs](http://openfast.readthedocs.io/en/latest/source/user/testing/unit_test.html) for complete documentation on OpenFAST unit test usage and expansion. \ No newline at end of file diff --git a/OpenFAST/unit_tests/aerodyn/CMakeLists.txt b/OpenFAST/unit_tests/aerodyn/CMakeLists.txt deleted file mode 100644 index 4e0bf8685..000000000 --- a/OpenFAST/unit_tests/aerodyn/CMakeLists.txt +++ /dev/null @@ -1,61 +0,0 @@ -# -# 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. -# - -set_source_files_properties(${pfunit_directory}/include/driver.F90 PROPERTIES GENERATED 1) - -set(module_name "fvw") -set(module_directory "aerodyn") -set(module_library "fvwlib") - -file(MAKE_DIRECTORY ${build_testdirectory}/${module_directory}) -file(WRITE ${build_testdirectory}/${module_directory}/testSuites.inc "") - -include_directories( - ${PROJECT_SOURCE_DIR} - ${pfunit_directory}/mod - ${build_testdirectory}/${module_directory} -) - -set(testlist - test_FVW_testsuite -) -foreach(test ${testlist}) - set(test_dependency pfunit ${source_modulesdirectory}/${module_directory}/tests/${test}.F90) - add_custom_command( - OUTPUT ${build_testdirectory}/${module_directory}/${test}.F90 - COMMAND ${PYTHON_EXECUTABLE} ${pfunit_directory}/bin/pFUnitParser.py ${source_modulesdirectory}/${module_directory}/tests/${test}.F90 ${build_testdirectory}/${module_directory}/${test}.F90 - DEPENDS ${test_dependency} - ) - set(test_sources ${test_sources} ${build_testdirectory}/${module_directory}/${test}.F90) - file(APPEND ${build_testdirectory}/${module_directory}/testSuites.inc "ADD_TEST_SUITE(${test}_suite)\n") -endforeach() - -add_executable( - ${module_name}_utest - ${pfunit_directory}/include/driver.F90 - ${test_sources} -) - -target_link_libraries( - ${module_name}_utest - ${pfunit_directory}${pfunit_lib} - ${module_library} -) - -add_test( - ${module_name}_utest - ${PROJECT_BINARY_DIR}/${module_directory}/${module_name}_utest -) diff --git a/OpenFAST/unit_tests/beamdyn/CMakeLists.txt b/OpenFAST/unit_tests/beamdyn/CMakeLists.txt deleted file mode 100644 index 0ed60108f..000000000 --- a/OpenFAST/unit_tests/beamdyn/CMakeLists.txt +++ /dev/null @@ -1,80 +0,0 @@ -# -# 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. -# - -set_source_files_properties(${pfunit_directory}/include/driver.F90 PROPERTIES GENERATED 1) - -set(module_name "beamdyn") -set(module_directory "beamdyn") -set(module_library "beamdynlib") - -file(MAKE_DIRECTORY ${build_testdirectory}/${module_directory}) -file(WRITE ${build_testdirectory}/${module_directory}/testSuites.inc "") - -include_directories( - ${PROJECT_SOURCE_DIR} - ${pfunit_directory}/mod - ${build_testdirectory}/${module_directory} -) - -set(testlist - test_tools - test_BD_ComputeIniNodalCrv - test_BD_CrvCompose - test_BD_CheckRotMat - test_BD_CrvExtractCrv - test_BD_CrvMatrixR - test_BD_CrvMatrixH - test_ExtractRelativeRotation - test_BD_InputGlobalLocal - test_BD_DistrLoadCopy - test_BD_GravityForce - test_BD_QPData_mEta_rho - test_BD_GenerateGLL - test_BD_GaussPointWeight - test_BD_diffmtc - test_BD_InitShpDerJaco - test_BD_MemberEta - test_BD_QuadraturePointData - test_BD_TrapezoidalPointWeight - test_InitializeNodalLocations -) -foreach(test ${testlist}) - set(test_dependency pfunit ${source_modulesdirectory}/${module_directory}/tests/${test}.F90) - add_custom_command( - OUTPUT ${build_testdirectory}/${module_directory}/${test}.F90 - COMMAND ${PYTHON_EXECUTABLE} ${pfunit_directory}/bin/pFUnitParser.py ${source_modulesdirectory}/${module_directory}/tests/${test}.F90 ${build_testdirectory}/${module_directory}/${test}.F90 - DEPENDS ${test_dependency} - ) - set(test_sources ${test_sources} ${build_testdirectory}/${module_directory}/${test}.F90) - file(APPEND ${build_testdirectory}/${module_directory}/testSuites.inc "ADD_TEST_SUITE(${test}_suite)\n") -endforeach() - -add_executable( - ${module_name}_utest - ${pfunit_directory}/include/driver.F90 - ${test_sources} -) - -target_link_libraries( - ${module_name}_utest - ${pfunit_directory}${pfunit_lib} - ${module_library} -) - -add_test( - ${module_name}_utest - ${PROJECT_BINARY_DIR}/${module_directory}/${module_name}_utest -) diff --git a/OpenFAST/unit_tests/inflowwind/CMakeLists.txt b/OpenFAST/unit_tests/inflowwind/CMakeLists.txt deleted file mode 100644 index b1a41ef67..000000000 --- a/OpenFAST/unit_tests/inflowwind/CMakeLists.txt +++ /dev/null @@ -1,67 +0,0 @@ -# -# 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. -# - -set_source_files_properties(${pfunit_directory}/include/driver.F90 PROPERTIES GENERATED 1) - -set(module_name "inflowwind") -set(module_directory "inflowwind") -set(module_library "ifwlib") - -file(MAKE_DIRECTORY ${build_testdirectory}/${module_directory}) -file(WRITE ${build_testdirectory}/${module_directory}/testSuites.inc "") - -include_directories( - ${PROJECT_SOURCE_DIR} - ${pfunit_directory}/mod - ${build_testdirectory}/${module_directory} -) - -set(testlist - ifw_test_tools - test_steady_wind - test_turbsim_wind - test_bladed_wind - test_hawc_wind - test_outputs - test_uniform_wind -) -foreach(test ${testlist}) - set(test_dependency pfunit ${source_modulesdirectory}/${module_directory}/tests/${test}.F90) - add_custom_command( - OUTPUT ${build_testdirectory}/${module_directory}/${test}.F90 - COMMAND ${PYTHON_EXECUTABLE} ${pfunit_directory}/bin/pFUnitParser.py ${source_modulesdirectory}/${module_directory}/tests/${test}.F90 ${build_testdirectory}/${module_directory}/${test}.F90 - DEPENDS ${test_dependency} - ) - set(test_sources ${test_sources} ${build_testdirectory}/${module_directory}/${test}.F90) - file(APPEND ${build_testdirectory}/${module_directory}/testSuites.inc "ADD_TEST_SUITE(${test}_suite)\n") -endforeach() - -add_executable( - ${module_name}_utest - ${pfunit_directory}/include/driver.F90 - ${test_sources} -) - -target_link_libraries( - ${module_name}_utest - ${pfunit_directory}${pfunit_lib} - ${module_library} -) - -add_test( - ${module_name}_utest - ${PROJECT_BINARY_DIR}/${module_directory}/${module_name}_utest -) diff --git a/OpenFAST/unit_tests/nwtc-library/CMakeLists.txt b/OpenFAST/unit_tests/nwtc-library/CMakeLists.txt deleted file mode 100644 index a78dda84b..000000000 --- a/OpenFAST/unit_tests/nwtc-library/CMakeLists.txt +++ /dev/null @@ -1,66 +0,0 @@ -# -# 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. -# - -# Tell CMake not to look for this file to exist since its generated by pFUnit during compile -set_source_files_properties(${pfunit_directory}/include/driver.F90 PROPERTIES GENERATED 1) - -set(module_name "nwtc_library") -set(module_directory "nwtc-library") -set(module_library "nwtclibs") - -file(MAKE_DIRECTORY ${build_testdirectory}/${module_directory}) -file(WRITE ${build_testdirectory}/${module_directory}/testSuites.inc "") - -include_directories( - ${PROJECT_SOURCE_DIR} - ${pfunit_directory}/mod - ${build_testdirectory}/${module_directory} -) - -set(testlist - NWTC_Library_test_tools - test_NWTC_IO_CheckArgs - test_NWTC_IO_FileInfo - test_NWTC_RandomNumber -) -foreach(test ${testlist}) - set(test_dependency pfunit ${source_modulesdirectory}/${module_directory}/tests/${test}.F90) - add_custom_command( - OUTPUT ${build_testdirectory}/${module_directory}/${test}.F90 - COMMAND ${PYTHON_EXECUTABLE} ${pfunit_directory}/bin/pFUnitParser.py ${source_modulesdirectory}/${module_directory}/tests/${test}.F90 ${build_testdirectory}/${module_directory}/${test}.F90 - DEPENDS ${test_dependency} - ) - set(test_sources ${test_sources} ${build_testdirectory}/${module_directory}/${test}.F90) - file(APPEND ${build_testdirectory}/${module_directory}/testSuites.inc "ADD_TEST_SUITE(${test}_suite)\n") -endforeach() - -add_executable( - ${module_name}_utest - ${pfunit_directory}/include/driver.F90 - ${test_sources} -) - -target_link_libraries( - ${module_name}_utest - ${pfunit_directory}${pfunit_lib} - ${module_library} -) - -add_test( - ${module_name}_utest - ${PROJECT_BINARY_DIR}/${module_directory}/${module_name}_utest -) - diff --git a/OpenFAST/unit_tests/pfunit b/OpenFAST/unit_tests/pfunit deleted file mode 160000 index a192e8224..000000000 --- a/OpenFAST/unit_tests/pfunit +++ /dev/null @@ -1 +0,0 @@ -Subproject commit a192e82246b44e701446811a9792a530e4f250c7 diff --git a/OpenFAST/unit_tests/test_SUBROUTINE.F90 b/OpenFAST/unit_tests/test_SUBROUTINE.F90 deleted file mode 100644 index 01807ab05..000000000 --- a/OpenFAST/unit_tests/test_SUBROUTINE.F90 +++ /dev/null @@ -1,89 +0,0 @@ -module test_SUBROUTINE - - use pFUnit_mod - use NWTC_IO - ! use MODULE ! Import the module that will be tested here. - - implicit none - - real(ReKi) :: tolerance = 1e-14 - character(1024) :: testname - -contains - - ! Test branches - ! - branch 1 - ! - branch 2 - ! - branch 3 - - ! Note that this module is *not* conforming Fortran code. - ! This is passed through a Python preprocessor included with pFUnit which parses - ! pFUnit directives like `@test` and `@assertEqual` to generate proper Fortran code. - - @test - subroutine test_branch1() - - ! Describe this test. - ! What is the expected result from the tested subroutine? - ! Why is the expected result the result that is expected? - - real(ReKi) :: zero = 0.0 - real(ReKi) :: test_result - integer(IntKi) :: error_status - - testname = "Branch 1" - expected = 0.0 - - ! Assume SUBROUTINE( intent(in), intent(out), intent(out) ) - call SUBROUTINE(zero, test_result, error_status) - - @assertEqual(expected, test_result, tolerance, testname) - @assertEqual(0, error_status, tolerance, testname) - - end subroutine - - @test - subroutine test_branch2() - - ! Describe this test. - ! What is the expected result from the tested subroutine? - ! Why is the expected result the result that is expected? - - real(ReKi) :: pi = 3.14159 - real(ReKi) :: test_result - integer(IntKi) :: error_status - - testname = "Branch 2" - expected = 0.0 - - ! Assume SUBROUTINE( intent(in), intent(out), intent(out) ) - call SUBROUTINE(pi, test_result, error_status) - - @assertEqual(expected, test_result, tolerance, testname) - @assertEqual(0, error_status, tolerance, testname) - - end subroutine - - @test - subroutine test_branch3() - - ! Describe this test. - ! What is the expected result from the tested subroutine? - ! Why is the expected result the result that is expected? - - real(ReKi) :: pi_by_2 = 1.57079 - real(ReKi) :: test_result - integer(IntKi) :: error_status - - testname = "Branch 3" - expected = 99.9 - - ! Assume SUBROUTINE( intent(in), intent(out), intent(out) ) - call SUBROUTINE(pi_by_2, test_result, error_status) - - @assertEqual(expected, test_result, tolerance, testname) - @assertEqual(0, error_status, tolerance, testname) - - end subroutine - -end module diff --git a/OpenFAST/vs-build/AeroDyn/AeroDyn_Driver.sln b/OpenFAST/vs-build/AeroDyn/AeroDyn_Driver.sln deleted file mode 100644 index 032b12d2f..000000000 --- a/OpenFAST/vs-build/AeroDyn/AeroDyn_Driver.sln +++ /dev/null @@ -1,61 +0,0 @@ - -Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio 2013 -VisualStudioVersion = 12.0.40629.0 -MinimumVisualStudioVersion = 10.0.40219.1 -Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "AeroDyn_Driver", "AeroDyn_Driver.vfproj", "{97CEFEB9-1DCB-470E-A231-E1DA2F21A9CE}" - ProjectSection(ProjectDependencies) = postProject - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} = {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} - EndProjectSection -EndProject -Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "FAST_Registry", "..\Registry\FAST_Registry.vcxproj", "{DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}" -EndProject -Global - GlobalSection(SolutionConfigurationPlatforms) = preSolution - Debug_Double|Win32 = Debug_Double|Win32 - Debug_Double|x64 = Debug_Double|x64 - Debug|Win32 = Debug|Win32 - Debug|x64 = Debug|x64 - Release_Double|Win32 = Release_Double|Win32 - Release_Double|x64 = Release_Double|x64 - Release|Win32 = Release|Win32 - Release|x64 = Release|x64 - EndGlobalSection - GlobalSection(ProjectConfigurationPlatforms) = postSolution - {97CEFEB9-1DCB-470E-A231-E1DA2F21A9CE}.Debug_Double|Win32.ActiveCfg = Debug_Double|Win32 - {97CEFEB9-1DCB-470E-A231-E1DA2F21A9CE}.Debug_Double|Win32.Build.0 = Debug_Double|Win32 - {97CEFEB9-1DCB-470E-A231-E1DA2F21A9CE}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 - {97CEFEB9-1DCB-470E-A231-E1DA2F21A9CE}.Debug_Double|x64.Build.0 = Debug_Double|x64 - {97CEFEB9-1DCB-470E-A231-E1DA2F21A9CE}.Debug|Win32.ActiveCfg = Debug|Win32 - {97CEFEB9-1DCB-470E-A231-E1DA2F21A9CE}.Debug|Win32.Build.0 = Debug|Win32 - {97CEFEB9-1DCB-470E-A231-E1DA2F21A9CE}.Debug|x64.ActiveCfg = Debug|x64 - {97CEFEB9-1DCB-470E-A231-E1DA2F21A9CE}.Debug|x64.Build.0 = Debug|x64 - {97CEFEB9-1DCB-470E-A231-E1DA2F21A9CE}.Release_Double|Win32.ActiveCfg = Release_Double|Win32 - {97CEFEB9-1DCB-470E-A231-E1DA2F21A9CE}.Release_Double|Win32.Build.0 = Release_Double|Win32 - {97CEFEB9-1DCB-470E-A231-E1DA2F21A9CE}.Release_Double|x64.ActiveCfg = Release_Double|x64 - {97CEFEB9-1DCB-470E-A231-E1DA2F21A9CE}.Release_Double|x64.Build.0 = Release_Double|x64 - {97CEFEB9-1DCB-470E-A231-E1DA2F21A9CE}.Release|Win32.ActiveCfg = Release|Win32 - {97CEFEB9-1DCB-470E-A231-E1DA2F21A9CE}.Release|Win32.Build.0 = Release|Win32 - {97CEFEB9-1DCB-470E-A231-E1DA2F21A9CE}.Release|x64.ActiveCfg = Release|x64 - {97CEFEB9-1DCB-470E-A231-E1DA2F21A9CE}.Release|x64.Build.0 = Release|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.ActiveCfg = Release|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.Build.0 = Release|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.ActiveCfg = Release|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.Build.0 = Release|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|x64.Build.0 = Release|Win32 - EndGlobalSection - GlobalSection(SolutionProperties) = preSolution - HideSolutionNode = FALSE - EndGlobalSection -EndGlobal diff --git a/OpenFAST/vs-build/AeroDyn/AeroDyn_Driver.vfproj b/OpenFAST/vs-build/AeroDyn/AeroDyn_Driver.vfproj deleted file mode 100644 index 5926d2f2a..000000000 --- a/OpenFAST/vs-build/AeroDyn/AeroDyn_Driver.vfproj +++ /dev/null @@ -1,665 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/OpenFAST/vs-build/BeamDyn/BeamDyn-w-registry.sln b/OpenFAST/vs-build/BeamDyn/BeamDyn-w-registry.sln deleted file mode 100644 index 0261cbdc7..000000000 --- a/OpenFAST/vs-build/BeamDyn/BeamDyn-w-registry.sln +++ /dev/null @@ -1,64 +0,0 @@ - -Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio 15 -VisualStudioVersion = 15.0.28307.902 -MinimumVisualStudioVersion = 10.0.40219.1 -Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "BeamDyn", "BeamDyn.vfproj", "{815C302F-A93D-4C22-9329-7112345113C0}" - ProjectSection(ProjectDependencies) = postProject - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} = {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} - EndProjectSection -EndProject -Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "FAST_Registry", "..\Registry\FAST_Registry.vcxproj", "{DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}" -EndProject -Global - GlobalSection(SolutionConfigurationPlatforms) = preSolution - Debug_Double|Win32 = Debug_Double|Win32 - Debug_Double|x64 = Debug_Double|x64 - Debug|Win32 = Debug|Win32 - Debug|x64 = Debug|x64 - Release_Double|Win32 = Release_Double|Win32 - Release_Double|x64 = Release_Double|x64 - Release|Win32 = Release|Win32 - Release|x64 = Release|x64 - EndGlobalSection - GlobalSection(ProjectConfigurationPlatforms) = postSolution - {815C302F-A93D-4C22-9329-7112345113C0}.Debug_Double|Win32.ActiveCfg = Debug_Double|Win32 - {815C302F-A93D-4C22-9329-7112345113C0}.Debug_Double|Win32.Build.0 = Debug_Double|Win32 - {815C302F-A93D-4C22-9329-7112345113C0}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 - {815C302F-A93D-4C22-9329-7112345113C0}.Debug_Double|x64.Build.0 = Debug_Double|x64 - {815C302F-A93D-4C22-9329-7112345113C0}.Debug|Win32.ActiveCfg = Debug|Win32 - {815C302F-A93D-4C22-9329-7112345113C0}.Debug|Win32.Build.0 = Debug|Win32 - {815C302F-A93D-4C22-9329-7112345113C0}.Debug|x64.ActiveCfg = Debug|x64 - {815C302F-A93D-4C22-9329-7112345113C0}.Debug|x64.Build.0 = Debug|x64 - {815C302F-A93D-4C22-9329-7112345113C0}.Release_Double|Win32.ActiveCfg = Release_Double|Win32 - {815C302F-A93D-4C22-9329-7112345113C0}.Release_Double|Win32.Build.0 = Release_Double|Win32 - {815C302F-A93D-4C22-9329-7112345113C0}.Release_Double|x64.ActiveCfg = Release_Double|x64 - {815C302F-A93D-4C22-9329-7112345113C0}.Release_Double|x64.Build.0 = Release_Double|x64 - {815C302F-A93D-4C22-9329-7112345113C0}.Release|Win32.ActiveCfg = Release|Win32 - {815C302F-A93D-4C22-9329-7112345113C0}.Release|Win32.Build.0 = Release|Win32 - {815C302F-A93D-4C22-9329-7112345113C0}.Release|x64.ActiveCfg = Release|x64 - {815C302F-A93D-4C22-9329-7112345113C0}.Release|x64.Build.0 = Release|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|x64.Build.0 = Release|Win32 - EndGlobalSection - GlobalSection(SolutionProperties) = preSolution - HideSolutionNode = FALSE - EndGlobalSection - GlobalSection(ExtensibilityGlobals) = postSolution - SolutionGuid = {37F40376-E0A4-4BB3-A987-A3CF5A440217} - EndGlobalSection -EndGlobal diff --git a/OpenFAST/vs-build/BeamDyn/BeamDyn.vfproj b/OpenFAST/vs-build/BeamDyn/BeamDyn.vfproj deleted file mode 100644 index e476eb178..000000000 --- a/OpenFAST/vs-build/BeamDyn/BeamDyn.vfproj +++ /dev/null @@ -1,295 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/OpenFAST/vs-build/CreateGitVersion.bat b/OpenFAST/vs-build/CreateGitVersion.bat deleted file mode 100644 index 91647f8e9..000000000 --- a/OpenFAST/vs-build/CreateGitVersion.bat +++ /dev/null @@ -1,9 +0,0 @@ -@ECHO off -SET IncludeFile=..\gitVersionInfo.h - - %IncludeFile% -FOR /f %%a IN ('git describe --abbrev^=8 --always --tags --dirty') DO > %IncludeFile% -git describe --abbrev^=8 --always --tags --dirty > NUL -IF %ERRORLEVEL%==0 ( ECHO '>> %IncludeFile% ) else ( ECHO Unversioned from $Format:%H$ '>> %IncludeFile% ) - -EXIT /B 0 \ No newline at end of file diff --git a/OpenFAST/vs-build/Discon/Discon.sln b/OpenFAST/vs-build/Discon/Discon.sln deleted file mode 100644 index 494c965f9..000000000 --- a/OpenFAST/vs-build/Discon/Discon.sln +++ /dev/null @@ -1,61 +0,0 @@ - -Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio 15 -VisualStudioVersion = 15.0.27428.2043 -MinimumVisualStudioVersion = 10.0.40219.1 -Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "Discon", "Discon.vfproj", "{183CC593-AD4C-4A15-81C1-7D6D20A9A5ED}" -EndProject -Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "Discon_ITIBarge", "Discon_ITIBarge.vfproj", "{11A28263-1385-47DF-9122-30BF9C0DF013}" -EndProject -Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "Discon_OC3Hywind", "Discon_OC3Hywind.vfproj", "{3BA7CEDE-8D58-4D18-8A59-A4114FB70B9C}" -EndProject -Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "Discon_SC", "Discon_SC.vfproj", "{183CC593-AD4C-4A15-81C1-78624551A5ED}" -EndProject -Global - GlobalSection(SolutionConfigurationPlatforms) = preSolution - Debug|Win32 = Debug|Win32 - Debug|x64 = Debug|x64 - Release|Win32 = Release|Win32 - Release|x64 = Release|x64 - EndGlobalSection - GlobalSection(ProjectConfigurationPlatforms) = postSolution - {183CC593-AD4C-4A15-81C1-7D6D20A9A5ED}.Debug|Win32.ActiveCfg = Debug|Win32 - {183CC593-AD4C-4A15-81C1-7D6D20A9A5ED}.Debug|Win32.Build.0 = Debug|Win32 - {183CC593-AD4C-4A15-81C1-7D6D20A9A5ED}.Debug|x64.ActiveCfg = Debug|x64 - {183CC593-AD4C-4A15-81C1-7D6D20A9A5ED}.Debug|x64.Build.0 = Debug|x64 - {183CC593-AD4C-4A15-81C1-7D6D20A9A5ED}.Release|Win32.ActiveCfg = Release|Win32 - {183CC593-AD4C-4A15-81C1-7D6D20A9A5ED}.Release|Win32.Build.0 = Release|Win32 - {183CC593-AD4C-4A15-81C1-7D6D20A9A5ED}.Release|x64.ActiveCfg = Release|x64 - {183CC593-AD4C-4A15-81C1-7D6D20A9A5ED}.Release|x64.Build.0 = Release|x64 - {11A28263-1385-47DF-9122-30BF9C0DF013}.Debug|Win32.ActiveCfg = Debug|Win32 - {11A28263-1385-47DF-9122-30BF9C0DF013}.Debug|Win32.Build.0 = Debug|Win32 - {11A28263-1385-47DF-9122-30BF9C0DF013}.Debug|x64.ActiveCfg = Debug|x64 - {11A28263-1385-47DF-9122-30BF9C0DF013}.Debug|x64.Build.0 = Debug|x64 - {11A28263-1385-47DF-9122-30BF9C0DF013}.Release|Win32.ActiveCfg = Release|Win32 - {11A28263-1385-47DF-9122-30BF9C0DF013}.Release|Win32.Build.0 = Release|Win32 - {11A28263-1385-47DF-9122-30BF9C0DF013}.Release|x64.ActiveCfg = Release|x64 - {11A28263-1385-47DF-9122-30BF9C0DF013}.Release|x64.Build.0 = Release|x64 - {3BA7CEDE-8D58-4D18-8A59-A4114FB70B9C}.Debug|Win32.ActiveCfg = Debug|Win32 - {3BA7CEDE-8D58-4D18-8A59-A4114FB70B9C}.Debug|Win32.Build.0 = Debug|Win32 - {3BA7CEDE-8D58-4D18-8A59-A4114FB70B9C}.Debug|x64.ActiveCfg = Debug|x64 - {3BA7CEDE-8D58-4D18-8A59-A4114FB70B9C}.Debug|x64.Build.0 = Debug|x64 - {3BA7CEDE-8D58-4D18-8A59-A4114FB70B9C}.Release|Win32.ActiveCfg = Release|Win32 - {3BA7CEDE-8D58-4D18-8A59-A4114FB70B9C}.Release|Win32.Build.0 = Release|Win32 - {3BA7CEDE-8D58-4D18-8A59-A4114FB70B9C}.Release|x64.ActiveCfg = Release|x64 - {3BA7CEDE-8D58-4D18-8A59-A4114FB70B9C}.Release|x64.Build.0 = Release|x64 - {183CC593-AD4C-4A15-81C1-78624551A5ED}.Debug|Win32.ActiveCfg = Debug|Win32 - {183CC593-AD4C-4A15-81C1-78624551A5ED}.Debug|Win32.Build.0 = Debug|Win32 - {183CC593-AD4C-4A15-81C1-78624551A5ED}.Debug|x64.ActiveCfg = Debug|x64 - {183CC593-AD4C-4A15-81C1-78624551A5ED}.Debug|x64.Build.0 = Debug|x64 - {183CC593-AD4C-4A15-81C1-78624551A5ED}.Release|Win32.ActiveCfg = Release|Win32 - {183CC593-AD4C-4A15-81C1-78624551A5ED}.Release|Win32.Build.0 = Release|Win32 - {183CC593-AD4C-4A15-81C1-78624551A5ED}.Release|x64.ActiveCfg = Release|x64 - {183CC593-AD4C-4A15-81C1-78624551A5ED}.Release|x64.Build.0 = Release|x64 - EndGlobalSection - GlobalSection(SolutionProperties) = preSolution - HideSolutionNode = FALSE - EndGlobalSection - GlobalSection(ExtensibilityGlobals) = postSolution - SolutionGuid = {A4EE85D3-EA0C-4285-B446-0E8D70945A10} - EndGlobalSection -EndGlobal diff --git a/OpenFAST/vs-build/Discon/Discon.vfproj b/OpenFAST/vs-build/Discon/Discon.vfproj deleted file mode 100644 index 30d07a9dc..000000000 --- a/OpenFAST/vs-build/Discon/Discon.vfproj +++ /dev/null @@ -1,52 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/OpenFAST/vs-build/Discon/Discon_ITIBarge.vfproj b/OpenFAST/vs-build/Discon/Discon_ITIBarge.vfproj deleted file mode 100644 index d263c96c1..000000000 --- a/OpenFAST/vs-build/Discon/Discon_ITIBarge.vfproj +++ /dev/null @@ -1,52 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/OpenFAST/vs-build/Discon/Discon_OC3Hywind.vfproj b/OpenFAST/vs-build/Discon/Discon_OC3Hywind.vfproj deleted file mode 100644 index f821f3dcf..000000000 --- a/OpenFAST/vs-build/Discon/Discon_OC3Hywind.vfproj +++ /dev/null @@ -1,52 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/OpenFAST/vs-build/Discon/Discon_SC.vfproj b/OpenFAST/vs-build/Discon/Discon_SC.vfproj deleted file mode 100644 index c575e10d0..000000000 --- a/OpenFAST/vs-build/Discon/Discon_SC.vfproj +++ /dev/null @@ -1,52 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/OpenFAST/vs-build/FAST-farm/FAST-Farm.sln b/OpenFAST/vs-build/FAST-farm/FAST-Farm.sln deleted file mode 100644 index b7159f95f..000000000 --- a/OpenFAST/vs-build/FAST-farm/FAST-Farm.sln +++ /dev/null @@ -1,86 +0,0 @@ - -Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio 2013 -VisualStudioVersion = 12.0.40629.0 -MinimumVisualStudioVersion = 10.0.40219.1 -Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "FASTlib", "..\FASTlib\FASTlib.vfproj", "{1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}" - ProjectSection(ProjectDependencies) = postProject - {BF86702A-CB17-4050-8AE9-078CDC5910D3} = {BF86702A-CB17-4050-8AE9-078CDC5910D3} - EndProjectSection -EndProject -Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "MAP_dll", "..\MAPlib\MAP_dll.vcxproj", "{BF86702A-CB17-4050-8AE9-078CDC5910D3}" - ProjectSection(ProjectDependencies) = postProject - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} = {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} - EndProjectSection -EndProject -Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "FAST_Registry", "..\Registry\FAST_Registry.vcxproj", "{DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}" -EndProject -Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "FAST-Farm", "FAST-Farm.vfproj", "{F47C7C94-2A7F-4CBE-B834-1BC7DD3FE692}" - ProjectSection(ProjectDependencies) = postProject - {BF86702A-CB17-4050-8AE9-078CDC5910D3} = {BF86702A-CB17-4050-8AE9-078CDC5910D3} - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9} = {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9} - EndProjectSection -EndProject -Global - GlobalSection(SolutionConfigurationPlatforms) = preSolution - Debug|Win32 = Debug|Win32 - Debug|x64 = Debug|x64 - Release_OpenMP|Win32 = Release_OpenMP|Win32 - Release_OpenMP|x64 = Release_OpenMP|x64 - Release|Win32 = Release|Win32 - Release|x64 = Release|x64 - EndGlobalSection - GlobalSection(ProjectConfigurationPlatforms) = postSolution - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Debug|Win32.ActiveCfg = Debug|Win32 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Debug|Win32.Build.0 = Debug|Win32 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Debug|x64.ActiveCfg = Debug|x64 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Debug|x64.Build.0 = Debug|x64 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Release_OpenMP|Win32.ActiveCfg = Release_OpenMP|Win32 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Release_OpenMP|Win32.Build.0 = Release_OpenMP|Win32 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Release|Win32.ActiveCfg = Release|Win32 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Release|Win32.Build.0 = Release|Win32 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Release|x64.ActiveCfg = Release|x64 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Release|x64.Build.0 = Release|x64 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Debug|Win32.ActiveCfg = Debug|Win32 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Debug|Win32.Build.0 = Debug|Win32 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Debug|x64.ActiveCfg = Debug|x64 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Debug|x64.Build.0 = Debug|x64 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Release_OpenMP|Win32.ActiveCfg = Release|Win32 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Release_OpenMP|Win32.Build.0 = Release|Win32 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Release_OpenMP|x64.ActiveCfg = Release|x64 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Release_OpenMP|x64.Build.0 = Release|x64 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Release|Win32.ActiveCfg = Release|Win32 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Release|Win32.Build.0 = Release|Win32 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Release|x64.ActiveCfg = Release|x64 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Release|x64.Build.0 = Release|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_OpenMP|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_OpenMP|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_OpenMP|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_OpenMP|x64.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|x64.Build.0 = Release|Win32 - {F47C7C94-2A7F-4CBE-B834-1BC7DD3FE692}.Debug|Win32.ActiveCfg = Debug|Win32 - {F47C7C94-2A7F-4CBE-B834-1BC7DD3FE692}.Debug|Win32.Build.0 = Debug|Win32 - {F47C7C94-2A7F-4CBE-B834-1BC7DD3FE692}.Debug|x64.ActiveCfg = Debug|x64 - {F47C7C94-2A7F-4CBE-B834-1BC7DD3FE692}.Debug|x64.Build.0 = Debug|x64 - {F47C7C94-2A7F-4CBE-B834-1BC7DD3FE692}.Release_OpenMP|Win32.ActiveCfg = Release_OpenMP|Win32 - {F47C7C94-2A7F-4CBE-B834-1BC7DD3FE692}.Release_OpenMP|Win32.Build.0 = Release_OpenMP|Win32 - {F47C7C94-2A7F-4CBE-B834-1BC7DD3FE692}.Release_OpenMP|x64.ActiveCfg = Release_OpenMP|x64 - {F47C7C94-2A7F-4CBE-B834-1BC7DD3FE692}.Release_OpenMP|x64.Build.0 = Release_OpenMP|x64 - {F47C7C94-2A7F-4CBE-B834-1BC7DD3FE692}.Release|Win32.ActiveCfg = Release|Win32 - {F47C7C94-2A7F-4CBE-B834-1BC7DD3FE692}.Release|Win32.Build.0 = Release|Win32 - {F47C7C94-2A7F-4CBE-B834-1BC7DD3FE692}.Release|x64.ActiveCfg = Release|x64 - {F47C7C94-2A7F-4CBE-B834-1BC7DD3FE692}.Release|x64.Build.0 = Release|x64 - EndGlobalSection - GlobalSection(SolutionProperties) = preSolution - HideSolutionNode = FALSE - EndGlobalSection -EndGlobal diff --git a/OpenFAST/vs-build/FAST-farm/FAST-Farm.vfproj b/OpenFAST/vs-build/FAST-farm/FAST-Farm.vfproj deleted file mode 100644 index f3baaa575..000000000 --- a/OpenFAST/vs-build/FAST-farm/FAST-Farm.vfproj +++ /dev/null @@ -1,160 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/OpenFAST/vs-build/FAST/FAST.sln b/OpenFAST/vs-build/FAST/FAST.sln deleted file mode 100644 index ec3d69105..000000000 --- a/OpenFAST/vs-build/FAST/FAST.sln +++ /dev/null @@ -1,160 +0,0 @@ - -Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio 15 -VisualStudioVersion = 15.0.27428.2043 -MinimumVisualStudioVersion = 10.0.40219.1 -Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "FAST", "FAST.vfproj", "{18AE8067-CCC6-4479-A0DB-C4089EF9FE71}" - ProjectSection(ProjectDependencies) = postProject - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9} = {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9} - EndProjectSection -EndProject -Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "FASTlib", "..\FASTlib\FASTlib.vfproj", "{1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}" - ProjectSection(ProjectDependencies) = postProject - {BF86702A-CB17-4050-8AE9-078CDC5910D3} = {BF86702A-CB17-4050-8AE9-078CDC5910D3} - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} = {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} - EndProjectSection -EndProject -Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "MAP_dll", "..\MAPlib\MAP_dll.vcxproj", "{BF86702A-CB17-4050-8AE9-078CDC5910D3}" - ProjectSection(ProjectDependencies) = postProject - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} = {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} - EndProjectSection -EndProject -Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "FAST_Registry", "..\Registry\FAST_Registry.vcxproj", "{DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}" -EndProject -Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "OpenFAST-Simulink", "..\OpenFAST-Simulink\OpenFAST-Simulink.vfproj", "{C3C93CC0-EDD7-438F-988C-1F917FAEFA67}" - ProjectSection(ProjectDependencies) = postProject - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9} = {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9} - EndProjectSection -EndProject -Global - GlobalSection(SolutionConfigurationPlatforms) = preSolution - Debug_Double|Win32 = Debug_Double|Win32 - Debug_Double|x64 = Debug_Double|x64 - Debug_Matlab|Win32 = Debug_Matlab|Win32 - Debug_Matlab|x64 = Debug_Matlab|x64 - Debug|Win32 = Debug|Win32 - Debug|x64 = Debug|x64 - Release_Double|Win32 = Release_Double|Win32 - Release_Double|x64 = Release_Double|x64 - Release_Matlab|Win32 = Release_Matlab|Win32 - Release_Matlab|x64 = Release_Matlab|x64 - Release|Win32 = Release|Win32 - Release|x64 = Release|x64 - EndGlobalSection - GlobalSection(ProjectConfigurationPlatforms) = postSolution - {18AE8067-CCC6-4479-A0DB-C4089EF9FE71}.Debug_Double|Win32.ActiveCfg = Debug_Double|Win32 - {18AE8067-CCC6-4479-A0DB-C4089EF9FE71}.Debug_Double|Win32.Build.0 = Debug_Double|Win32 - {18AE8067-CCC6-4479-A0DB-C4089EF9FE71}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 - {18AE8067-CCC6-4479-A0DB-C4089EF9FE71}.Debug_Double|x64.Build.0 = Debug_Double|x64 - {18AE8067-CCC6-4479-A0DB-C4089EF9FE71}.Debug_Matlab|Win32.ActiveCfg = Debug|Win32 - {18AE8067-CCC6-4479-A0DB-C4089EF9FE71}.Debug_Matlab|x64.ActiveCfg = Debug|x64 - {18AE8067-CCC6-4479-A0DB-C4089EF9FE71}.Debug|Win32.ActiveCfg = Debug|Win32 - {18AE8067-CCC6-4479-A0DB-C4089EF9FE71}.Debug|Win32.Build.0 = Debug|Win32 - {18AE8067-CCC6-4479-A0DB-C4089EF9FE71}.Debug|x64.ActiveCfg = Debug|x64 - {18AE8067-CCC6-4479-A0DB-C4089EF9FE71}.Debug|x64.Build.0 = Debug|x64 - {18AE8067-CCC6-4479-A0DB-C4089EF9FE71}.Release_Double|Win32.ActiveCfg = Release_Double|Win32 - {18AE8067-CCC6-4479-A0DB-C4089EF9FE71}.Release_Double|Win32.Build.0 = Release_Double|Win32 - {18AE8067-CCC6-4479-A0DB-C4089EF9FE71}.Release_Double|x64.ActiveCfg = Release_Double|x64 - {18AE8067-CCC6-4479-A0DB-C4089EF9FE71}.Release_Double|x64.Build.0 = Release_Double|x64 - {18AE8067-CCC6-4479-A0DB-C4089EF9FE71}.Release_Matlab|Win32.ActiveCfg = Release|Win32 - {18AE8067-CCC6-4479-A0DB-C4089EF9FE71}.Release_Matlab|x64.ActiveCfg = Release|x64 - {18AE8067-CCC6-4479-A0DB-C4089EF9FE71}.Release|Win32.ActiveCfg = Release|Win32 - {18AE8067-CCC6-4479-A0DB-C4089EF9FE71}.Release|Win32.Build.0 = Release|Win32 - {18AE8067-CCC6-4479-A0DB-C4089EF9FE71}.Release|x64.ActiveCfg = Release|x64 - {18AE8067-CCC6-4479-A0DB-C4089EF9FE71}.Release|x64.Build.0 = Release|x64 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Debug_Double|Win32.ActiveCfg = Debug_Double|Win32 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Debug_Double|Win32.Build.0 = Debug_Double|Win32 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Debug_Double|x64.Build.0 = Debug_Double|x64 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Debug_Matlab|Win32.ActiveCfg = Debug_Matlab|Win32 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Debug_Matlab|Win32.Build.0 = Debug_Matlab|Win32 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Debug|Win32.ActiveCfg = Debug|Win32 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Debug|Win32.Build.0 = Debug|Win32 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Debug|x64.ActiveCfg = Debug|x64 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Debug|x64.Build.0 = Debug|x64 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Release_Double|Win32.ActiveCfg = Release_Double|Win32 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Release_Double|Win32.Build.0 = Release_Double|Win32 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Release_Double|x64.ActiveCfg = Release_Double|x64 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Release_Double|x64.Build.0 = Release_Double|x64 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Release_Matlab|Win32.ActiveCfg = Release_Matlab|Win32 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Release_Matlab|Win32.Build.0 = Release_Matlab|Win32 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Release|Win32.ActiveCfg = Release|Win32 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Release|Win32.Build.0 = Release|Win32 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Release|x64.ActiveCfg = Release|x64 - {1A440C5B-CBA6-47D9-9CC2-C1CBA8C00BF9}.Release|x64.Build.0 = Release|x64 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Debug_Double|Win32.ActiveCfg = Debug|Win32 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Debug_Double|Win32.Build.0 = Debug|Win32 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Debug_Double|x64.ActiveCfg = Debug|x64 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Debug_Double|x64.Build.0 = Debug|x64 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Debug_Matlab|Win32.ActiveCfg = Debug|Win32 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Debug_Matlab|Win32.Build.0 = Debug|Win32 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Debug_Matlab|x64.ActiveCfg = Debug|x64 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Debug_Matlab|x64.Build.0 = Debug|x64 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Debug|Win32.ActiveCfg = Debug|Win32 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Debug|Win32.Build.0 = Debug|Win32 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Debug|x64.ActiveCfg = Debug|x64 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Debug|x64.Build.0 = Debug|x64 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Release_Double|Win32.ActiveCfg = Release|Win32 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Release_Double|Win32.Build.0 = Release|Win32 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Release_Double|x64.ActiveCfg = Release|x64 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Release_Double|x64.Build.0 = Release|x64 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Release_Matlab|Win32.ActiveCfg = Release|Win32 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Release_Matlab|Win32.Build.0 = Release|Win32 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Release_Matlab|x64.ActiveCfg = Release|x64 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Release_Matlab|x64.Build.0 = Release|x64 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Release|Win32.ActiveCfg = Release|Win32 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Release|Win32.Build.0 = Release|Win32 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Release|x64.ActiveCfg = Release|x64 - {BF86702A-CB17-4050-8AE9-078CDC5910D3}.Release|x64.Build.0 = Release|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Matlab|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Matlab|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Matlab|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Matlab|x64.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Matlab|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Matlab|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Matlab|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Matlab|x64.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|x64.Build.0 = Release|Win32 - {C3C93CC0-EDD7-438F-988C-1F917FAEFA67}.Debug_Double|Win32.ActiveCfg = Debug_Matlab|Win32 - {C3C93CC0-EDD7-438F-988C-1F917FAEFA67}.Debug_Double|x64.ActiveCfg = Debug_Matlab|x64 - {C3C93CC0-EDD7-438F-988C-1F917FAEFA67}.Debug_Matlab|Win32.ActiveCfg = Debug_Matlab|Win32 - {C3C93CC0-EDD7-438F-988C-1F917FAEFA67}.Debug_Matlab|Win32.Build.0 = Debug_Matlab|Win32 - {C3C93CC0-EDD7-438F-988C-1F917FAEFA67}.Debug_Matlab|x64.ActiveCfg = Debug_Matlab|x64 - {C3C93CC0-EDD7-438F-988C-1F917FAEFA67}.Debug_Matlab|x64.Build.0 = Debug_Matlab|x64 - {C3C93CC0-EDD7-438F-988C-1F917FAEFA67}.Debug|Win32.ActiveCfg = Debug_Matlab|Win32 - {C3C93CC0-EDD7-438F-988C-1F917FAEFA67}.Debug|x64.ActiveCfg = Debug_Matlab|x64 - {C3C93CC0-EDD7-438F-988C-1F917FAEFA67}.Release_Double|Win32.ActiveCfg = Release_Matlab|Win32 - {C3C93CC0-EDD7-438F-988C-1F917FAEFA67}.Release_Double|x64.ActiveCfg = Release_Matlab|x64 - {C3C93CC0-EDD7-438F-988C-1F917FAEFA67}.Release_Matlab|Win32.ActiveCfg = Release_Matlab|Win32 - {C3C93CC0-EDD7-438F-988C-1F917FAEFA67}.Release_Matlab|Win32.Build.0 = Release_Matlab|Win32 - {C3C93CC0-EDD7-438F-988C-1F917FAEFA67}.Release_Matlab|x64.ActiveCfg = Release_Matlab|x64 - {C3C93CC0-EDD7-438F-988C-1F917FAEFA67}.Release_Matlab|x64.Build.0 = Release_Matlab|x64 - {C3C93CC0-EDD7-438F-988C-1F917FAEFA67}.Release|Win32.ActiveCfg = Release_Matlab|Win32 - {C3C93CC0-EDD7-438F-988C-1F917FAEFA67}.Release|x64.ActiveCfg = Release_Matlab|x64 - EndGlobalSection - GlobalSection(SolutionProperties) = preSolution - HideSolutionNode = FALSE - EndGlobalSection - GlobalSection(ExtensibilityGlobals) = postSolution - SolutionGuid = {60B1042F-6137-4E78-9A9D-75E796E6E22B} - EndGlobalSection -EndGlobal diff --git a/OpenFAST/vs-build/FAST/FAST.vfproj b/OpenFAST/vs-build/FAST/FAST.vfproj deleted file mode 100644 index b9c9ca2a9..000000000 --- a/OpenFAST/vs-build/FAST/FAST.vfproj +++ /dev/null @@ -1,92 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/OpenFAST/vs-build/FASTlib/FASTlib.vfproj b/OpenFAST/vs-build/FASTlib/FASTlib.vfproj deleted file mode 100644 index c78ea5f9d..000000000 --- a/OpenFAST/vs-build/FASTlib/FASTlib.vfproj +++ /dev/null @@ -1,2474 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/OpenFAST/vs-build/HydroDyn/HydroDynDriver.sln b/OpenFAST/vs-build/HydroDyn/HydroDynDriver.sln deleted file mode 100644 index cc5662783..000000000 --- a/OpenFAST/vs-build/HydroDyn/HydroDynDriver.sln +++ /dev/null @@ -1,37 +0,0 @@ - -Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio Version 16 -VisualStudioVersion = 16.0.30503.244 -MinimumVisualStudioVersion = 10.0.40219.1 -Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "HydroDynDriver", "HydroDynDriver.vfproj", "{815C302F-A93D-4C22-9329-717B085113C0}" -EndProject -Global - GlobalSection(SolutionConfigurationPlatforms) = preSolution - Debug_Double|Win32 = Debug_Double|Win32 - Debug_Double|x64 = Debug_Double|x64 - Debug|Win32 = Debug|Win32 - Debug|x64 = Debug|x64 - Release|Win32 = Release|Win32 - Release|x64 = Release|x64 - EndGlobalSection - GlobalSection(ProjectConfigurationPlatforms) = postSolution - {815C302F-A93D-4C22-9329-717B085113C0}.Debug_Double|Win32.ActiveCfg = Debug_Double|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Debug_Double|Win32.Build.0 = Debug_Double|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 - {815C302F-A93D-4C22-9329-717B085113C0}.Debug_Double|x64.Build.0 = Debug_Double|x64 - {815C302F-A93D-4C22-9329-717B085113C0}.Debug|Win32.ActiveCfg = Debug|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Debug|Win32.Build.0 = Debug|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Debug|x64.ActiveCfg = Debug|x64 - {815C302F-A93D-4C22-9329-717B085113C0}.Debug|x64.Build.0 = Debug|x64 - {815C302F-A93D-4C22-9329-717B085113C0}.Release|Win32.ActiveCfg = Release|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Release|Win32.Build.0 = Release|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Release|x64.ActiveCfg = Release|x64 - {815C302F-A93D-4C22-9329-717B085113C0}.Release|x64.Build.0 = Release|x64 - EndGlobalSection - GlobalSection(SolutionProperties) = preSolution - HideSolutionNode = FALSE - EndGlobalSection - GlobalSection(ExtensibilityGlobals) = postSolution - SolutionGuid = {D73C5D81-14CD-4C14-8B52-6885B380AE3E} - EndGlobalSection -EndGlobal diff --git a/OpenFAST/vs-build/HydroDyn/HydroDynDriver.vfproj b/OpenFAST/vs-build/HydroDyn/HydroDynDriver.vfproj deleted file mode 100644 index 124b48561..000000000 --- a/OpenFAST/vs-build/HydroDyn/HydroDynDriver.vfproj +++ /dev/null @@ -1,441 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/OpenFAST/vs-build/InflowWind/InflowWind_driver.sln b/OpenFAST/vs-build/InflowWind/InflowWind_driver.sln deleted file mode 100644 index bb6d88cdf..000000000 --- a/OpenFAST/vs-build/InflowWind/InflowWind_driver.sln +++ /dev/null @@ -1,61 +0,0 @@ - -Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio 2013 -VisualStudioVersion = 12.0.40629.0 -MinimumVisualStudioVersion = 10.0.40219.1 -Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "InflowWind_driver", "InflowWind_driver.vfproj", "{3BBE2741-5B28-47BC-9E7F-3E1D172838FB}" - ProjectSection(ProjectDependencies) = postProject - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} = {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} - EndProjectSection -EndProject -Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "FAST_Registry", "..\Registry\FAST_Registry.vcxproj", "{DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}" -EndProject -Global - GlobalSection(SolutionConfigurationPlatforms) = preSolution - Debug_Double|Win32 = Debug_Double|Win32 - Debug_Double|x64 = Debug_Double|x64 - Debug|Win32 = Debug|Win32 - Debug|x64 = Debug|x64 - Release_Double|Win32 = Release_Double|Win32 - Release_Double|x64 = Release_Double|x64 - Release|Win32 = Release|Win32 - Release|x64 = Release|x64 - EndGlobalSection - GlobalSection(ProjectConfigurationPlatforms) = postSolution - {3BBE2741-5B28-47BC-9E7F-3E1D172838FB}.Debug_Double|Win32.ActiveCfg = Debug_Double|Win32 - {3BBE2741-5B28-47BC-9E7F-3E1D172838FB}.Debug_Double|Win32.Build.0 = Debug_Double|Win32 - {3BBE2741-5B28-47BC-9E7F-3E1D172838FB}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 - {3BBE2741-5B28-47BC-9E7F-3E1D172838FB}.Debug_Double|x64.Build.0 = Debug_Double|x64 - {3BBE2741-5B28-47BC-9E7F-3E1D172838FB}.Debug|Win32.ActiveCfg = Debug|Win32 - {3BBE2741-5B28-47BC-9E7F-3E1D172838FB}.Debug|Win32.Build.0 = Debug|Win32 - {3BBE2741-5B28-47BC-9E7F-3E1D172838FB}.Debug|x64.ActiveCfg = Debug|x64 - {3BBE2741-5B28-47BC-9E7F-3E1D172838FB}.Debug|x64.Build.0 = Debug|x64 - {3BBE2741-5B28-47BC-9E7F-3E1D172838FB}.Release_Double|Win32.ActiveCfg = Release_Double|Win32 - {3BBE2741-5B28-47BC-9E7F-3E1D172838FB}.Release_Double|Win32.Build.0 = Release_Double|Win32 - {3BBE2741-5B28-47BC-9E7F-3E1D172838FB}.Release_Double|x64.ActiveCfg = Release_Double|x64 - {3BBE2741-5B28-47BC-9E7F-3E1D172838FB}.Release_Double|x64.Build.0 = Release_Double|x64 - {3BBE2741-5B28-47BC-9E7F-3E1D172838FB}.Release|Win32.ActiveCfg = Release|Win32 - {3BBE2741-5B28-47BC-9E7F-3E1D172838FB}.Release|Win32.Build.0 = Release|Win32 - {3BBE2741-5B28-47BC-9E7F-3E1D172838FB}.Release|x64.ActiveCfg = Release|x64 - {3BBE2741-5B28-47BC-9E7F-3E1D172838FB}.Release|x64.Build.0 = Release|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|x64.Build.0 = Release|Win32 - EndGlobalSection - GlobalSection(SolutionProperties) = preSolution - HideSolutionNode = FALSE - EndGlobalSection -EndGlobal diff --git a/OpenFAST/vs-build/InflowWind/InflowWind_driver.vfproj b/OpenFAST/vs-build/InflowWind/InflowWind_driver.vfproj deleted file mode 100644 index 90611f469..000000000 --- a/OpenFAST/vs-build/InflowWind/InflowWind_driver.vfproj +++ /dev/null @@ -1,357 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/OpenFAST/vs-build/MAPlib/MAP_dll.vcxproj b/OpenFAST/vs-build/MAPlib/MAP_dll.vcxproj deleted file mode 100644 index aaf82fd78..000000000 --- a/OpenFAST/vs-build/MAPlib/MAP_dll.vcxproj +++ /dev/null @@ -1,217 +0,0 @@ - - - - - Debug - Win32 - - - Debug - x64 - - - Release - Win32 - - - Release - x64 - - - - {BF86702A-CB17-4050-8AE9-078CDC5910D3} - Win32Proj - MAP_DLL - 8.1 - - - - DynamicLibrary - true - v140 - Unicode - - - DynamicLibrary - true - v140 - Unicode - - - DynamicLibrary - false - v140 - true - Unicode - - - DynamicLibrary - false - v140 - true - Unicode - - - - - - - - - - - - - - - - - - - true - ..\..\build\bin\ - MAP_$(PlatformName) - - - MAP_$(PlatformName) - true - ..\..\build\bin\ - - - false - ..\..\build\bin\ - MAP_$(PlatformName) - - - MAP_$(PlatformName) - false - ..\..\build\bin\ - - - - NotUsing - Level3 - Disabled - WIN32;_DEBUG;_WINDOWS;_USRDLL;CMINPACK_NO_DLL;%(PreprocessorDefinitions) - true - MultiThreadedDebug - ..\..\modules\map\src - - - Windows - true - - - - - NotUsing - Level3 - Disabled - WIN32;_DEBUG;_WINDOWS;_USRDLL;CMINPACK_NO_DLL;%(PreprocessorDefinitions) - true - MultiThreadedDebug - - - Windows - true - - - - - Level3 - NotUsing - MaxSpeed - true - true - WIN32;NDEBUG;_WINDOWS;_USRDLL;CMINPACK_NO_DLL;%(PreprocessorDefinitions) - true - MultiThreaded - - - Windows - true - true - - - - - Level3 - NotUsing - MaxSpeed - true - true - WIN32;NDEBUG;_WINDOWS;_USRDLL;CMINPACK_NO_DLL;%(PreprocessorDefinitions) - true - MultiThreaded - - - Windows - true - true - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - CALL ..\RunRegistry.bat MAP - ..\..\modules\map\src\MAP_Types.h - false - CALL ..\RunRegistry.bat MAP - ..\..\modules\map\src\MAP_Types.h - CALL ..\RunRegistry.bat MAP - ..\..\modules\map\src\MAP_Types.h - false - false - CALL ..\RunRegistry.bat MAP - ..\..\modules\map\src\MAP_Types.h - false - - - - - - \ No newline at end of file diff --git a/OpenFAST/vs-build/OpenFAST-Simulink/OpenFAST-Simulink.vfproj b/OpenFAST/vs-build/OpenFAST-Simulink/OpenFAST-Simulink.vfproj deleted file mode 100644 index de68e189f..000000000 --- a/OpenFAST/vs-build/OpenFAST-Simulink/OpenFAST-Simulink.vfproj +++ /dev/null @@ -1,62 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/OpenFAST/vs-build/ReadMe.md b/OpenFAST/vs-build/ReadMe.md deleted file mode 100644 index eafadb058..000000000 --- a/OpenFAST/vs-build/ReadMe.md +++ /dev/null @@ -1,25 +0,0 @@ -# Visual Studio builds for Windows -The following solution files are available for code development on Windows using the Intel Fortran compiler with Visual Studio. - -- [OpenFAST](FAST/FAST.sln) - This contains builds for both the command-line OpenFAST executable as well as the DLL for use with the OpenFAST-Simulink interface. -- [FAST.Farm](FAST-farm/FAST-Farm.sln) - This contains the build configurations for FAST.Farm. -- Module-level drivers: - - AeroDynamics: - - [AeroDyn driver](AeroDyn/AeroDyn_Driver.sln) - - [UnsteadyAero driver](UnsteadyAero/UnsteadyAero.sln) - - Structural: - - [BeamDyn driver](BeamDyn/BeamDyn-w-registry.sln) - - [SubDyn driver](SubDyn/SubDyn.sln) - - Wind/Wave conditions: - - [TurbSim](TurbSim/TurbSim.sln) Generates wind files - - [InflowWind driver](InflowWind/InflowWind_driver.sln) Reads and interpolates existing wind files - - [HydroDyn driver](HydroDyn/HydroDynDriver.sln) -- Other: - - [Discon](Discon/Discon.sln) - This solution file contains all 3 controllers used in the OpenFAST r-test (with the 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) - The Registry project is included in almost every other solution file, so this solution file is only for debugging changes to the OpenFAST Registry. diff --git a/OpenFAST/vs-build/Registry/FAST_Registry.sln b/OpenFAST/vs-build/Registry/FAST_Registry.sln deleted file mode 100644 index 689421c6c..000000000 --- a/OpenFAST/vs-build/Registry/FAST_Registry.sln +++ /dev/null @@ -1,25 +0,0 @@ - -Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio 15 -VisualStudioVersion = 15.0.27428.2043 -MinimumVisualStudioVersion = 10.0.40219.1 -Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "FAST_Registry", "FAST_Registry.vcxproj", "{DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}" -EndProject -Global - GlobalSection(SolutionConfigurationPlatforms) = preSolution - Debug|Win32 = Debug|Win32 - Release|Win32 = Release|Win32 - EndGlobalSection - GlobalSection(ProjectConfigurationPlatforms) = postSolution - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.ActiveCfg = Debug|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.Build.0 = Debug|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.Build.0 = Release|Win32 - EndGlobalSection - GlobalSection(SolutionProperties) = preSolution - HideSolutionNode = FALSE - EndGlobalSection - GlobalSection(ExtensibilityGlobals) = postSolution - SolutionGuid = {E46DCC9C-7BC9-40BA-8EF9-BDE0CD4C584B} - EndGlobalSection -EndGlobal diff --git a/OpenFAST/vs-build/Registry/FAST_Registry.vcxproj b/OpenFAST/vs-build/Registry/FAST_Registry.vcxproj deleted file mode 100644 index 40649f85f..000000000 --- a/OpenFAST/vs-build/Registry/FAST_Registry.vcxproj +++ /dev/null @@ -1,179 +0,0 @@ - - - - - Debug - Win32 - - - Debug - x64 - - - Release - Win32 - - - Release - x64 - - - - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} - Win32Proj - FAST_Registry_c - - - - Application - true - Unicode - v140 - - - Application - true - Unicode - v140 - - - Application - false - true - Unicode - v140 - - - Application - false - true - Unicode - v140 - - - - - - - - - - - - - - - - - - - true - Registry - ..\..\build\bin\ - - - true - Registry - ..\..\build\bin\ - $(Configuration)\ - - - false - ..\..\build\bin\ - Registry - false - - - Registry - false - false - ..\..\build\bin\ - $(Configuration)\ - - - - - - Level3 - Disabled - WIN32;_DEBUG;_CONSOLE;%(PreprocessorDefinitions) - 4996 - - - Console - true - - - - - - - Level3 - Disabled - WIN32;_DEBUG;_CONSOLE;%(PreprocessorDefinitions) - 4996 - - - Console - true - - - - - Level3 - - - MaxSpeed - true - true - WIN32;NDEBUG;_CONSOLE;%(PreprocessorDefinitions) - MultiThreaded - 4996 - - - Console - true - true - - - - - Level3 - - - MaxSpeed - true - true - WIN32;NDEBUG;_CONSOLE;%(PreprocessorDefinitions) - MultiThreaded - 4996 - - - Console - true - true - - - - - - - - - - - - - - - - - - - - - - - - - \ No newline at end of file diff --git a/OpenFAST/vs-build/RunRegistry.bat b/OpenFAST/vs-build/RunRegistry.bat deleted file mode 100644 index 3480ba526..000000000 --- a/OpenFAST/vs-build/RunRegistry.bat +++ /dev/null @@ -1,325 +0,0 @@ -@ECHO OFF - -set lines======================================================================= -echo %lines% -IF "%1"=="" ( -ECHO. -ECHO The calling syntax for this script is -ECHO RunRegistry ModuleName [FAST_Root_Loc] -ECHO. -GOTO Done -) - - -REM ---------------------------------------------------------------------------- -REM ------------------------- LOCAL PATHS -------------------------------------- -REM ---------------------------------------------------------------------------- -REM -- USERS MAY EDIT THESE PATHS TO POINT TO FOLDERS ON THEIR LOCAL MACHINES. - -REM -- NOTE: do not use quotation marks around the path names!!!! -------------- -REM ---------------------------------------------------------------------------- -REM ---------------------------------------------------------------------------- -SET Root_Loc=..\.. -IF not "%2"=="" SET Root_Loc=%2 - -SET Modules_Loc=%Root_Loc%\modules -SET Registry=..\..\build\bin\Registry.exe -SET FAST_Loc=%Modules_Loc%\openfast-library\src -SET ED_Loc=%Modules_Loc%\elastodyn\src -SET AD14_Loc=%Modules_Loc%\aerodyn14\src -SET IfW_Loc=%Modules_Loc%\inflowwind\src -SET HD_Loc=%Modules_Loc%\hydrodyn\src -SET SD_Loc=%Modules_Loc%\subdyn\src -SET MAP_Loc=%Modules_Loc%\map\src -SET FEAM_Loc=%Modules_Loc%\feamooring\src -SET IceF_Loc=%Modules_Loc%\icefloe\src\interfaces\FAST -SET IceD_Loc=%Modules_Loc%\icedyn\src -SET MD_Loc=%Modules_Loc%\moordyn\src -SET OpFM_Loc=%Modules_Loc%\openfoam\src -SET Orca_Loc=%Modules_Loc%\orcaflex-interface\src -SET NWTC_Lib_Loc=%Modules_Loc%\nwtc-library\src -SET ExtPtfm_Loc=%Modules_Loc%\extptfm\src -SET AD_Loc=%Modules_Loc%\aerodyn\src -SET SrvD_Loc=%Modules_Loc%\servodyn\src -SET BD_Loc=%Modules_Loc%\beamdyn\src -SET SC_Loc=%Modules_Loc%\supercontroller\src - -SET AWAE_Loc=%Modules_Loc%\awae\src -SET WD_Loc=%Modules_Loc%\wakedynamics\src -SET Farm_Loc=%Root_Loc%\glue-codes\fast-farm\src - -SET ALL_FAST_Includes=-I "%FAST_Loc%" -I "%NWTC_Lib_Loc%" -I "%ED_Loc%" -I "%SrvD_Loc%" -I "%AD14_Loc%" -I^ - "%AD_Loc%" -I "%BD_Loc%" -I "%SC_Loc%" -I^ - "%IfW_Loc%" -I "%SD_Loc%" -I "%HD_Loc%" -I "%MAP_Loc%" -I "%FEAM_Loc%" -I^ - "%IceF_Loc%" -I "%IceD_Loc%" -I "%MD_Loc%" -I "%OpFM_Loc%" -I "%Orca_Loc%" -I "%ExtPtfm_Loc%" - - -SET ModuleName=%1 - -GOTO %ModuleName% - -REM ---------------------------------------------------------------------------- -REM ---------------- RUN THE REGISTRY TO AUTO-GENERATE FILES ------------------- -REM ---------------------------------------------------------------------------- -:MAP -SET CURR_LOC=%MAP_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -ccode -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -%REGISTRY% "%CURR_LOC%\MAP_Fortran_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap -GOTO checkError - -:MAP_Fortran -SET CURR_LOC=%MAP_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap -GOTO checkError - -:FAST -SET CURR_LOC=%FAST_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\FAST_Registry.txt" %ALL_FAST_Includes% -noextrap -O "%Output_Loc%" -GOTO checkError - -:BeamDyn -SET CURR_LOC=%BD_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\Registry_BeamDyn.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" -GOTO checkError - -:SuperController -SET CURR_LOC=%SC_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\SuperController_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" -ccode -GOTO checkError - -:SCDataEx: -SET CURR_LOC=%SC_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\SC_DataEx_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" -ccode -noextrap -GOTO checkError - - -:ElastoDyn -SET CURR_LOC=%ED_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" -GOTO checkError - -:StrucCtrl -:ServoDyn -SET CURR_LOC=%SrvD_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -GOTO checkError - -:Lidar -:InflowWind -SET CURR_LOC=%IfW_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\%ModuleName%.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -GOTO checkError - -:IfW_TSFFWind -:IfW_HAWCWind -:IfW_BladedFFWind -:IfW_UserWind -:IfW_4Dext -:IfW_FFWind_Base -:IfW_UniformWind -SET CURR_LOC=%IfW_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\%ModuleName%.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -noextrap -O "%Output_Loc%" -GOTO checkError - -:OpenFOAM -SET CURR_LOC=%OpFM_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -ccode -O "%Output_Loc%" -GOTO checkError - -:AeroDyn -:BEMT -:DBEMT -SET CURR_LOC=%AD_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -GOTO checkError - -:AeroDyn_Driver -SET CURR_LOC=%AD_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\AeroDyn_Driver_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap -GOTO checkError - -:AFI -SET CURR_LOC=%AD_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\AirfoilInfo_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -noextrap -O "%Output_Loc%" -GOTO checkError - -:UA -SET CURR_LOC=%AD_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\UnsteadyAero_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -GOTO checkError - -:FVW -SET CURR_LOC=%AD_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\FVW_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -GOTO checkError - -:AA -SET CURR_LOC=%AD_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\AeroAcoustics_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -GOTO checkError - -:AeroDyn14 -SET CURR_LOC=%AD14_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\Registry-AD14.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -I "%IfW_Loc%" -O "%Output_Loc%" -GOTO checkError - -:DWM -SET CURR_LOC=%AD14_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\Registry-DWM.txt" -I "%NWTC_Lib_Loc%" -I "%IfW_Loc%" -O "%Output_Loc%" -GOTO checkError - -:HydroDyn -:Current -:Waves -:Waves2 -:SS_Excitation -:SS_Radiation -:Conv_Radiation -:WAMIT -:WAMIT2 -:Morison - -SET CURR_LOC=%HD_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\%ModuleName%.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -GOTO checkError - -:SubDyn -SET CURR_LOC=%SD_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" -GOTO checkError - -:FEAMooring -SET CURR_LOC=%FEAM_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\FEAM_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" -GOTO checkError - -:MoorDyn -SET CURR_LOC=%MD_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" -GOTO checkError - -:IceFloe -SET CURR_LOC=%IceF_Loc% -SET Output_Loc=%Modules_Loc%\icefloe\src\icefloe -%REGISTRY% "%CURR_LOC%\%ModuleName%_FASTRegistry.inp" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" -GOTO checkError - -:IceDyn -SET CURR_LOC=%IceD_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\Registry_%ModuleName%.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" -GOTO checkError - -:OrcaFlexInterface -SET CURR_LOC=%Orca_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\%ModuleName%.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" -GOTO checkError - -:ExtPtfm_MCKF -SET CURR_LOC=%ExtPtfm_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" -GOTO checkError - -:FarmDriver -SET CURR_LOC=%Farm_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\FAST_Farm_Registry.txt" -I %WD_Loc% -I %AWAE_Loc% -I %Farm_Loc% %ALL_FAST_INCLUDES% -noextrap -O "%Output_Loc%" -GOTO checkError - -:FASTWrapper -SET CURR_LOC=%Farm_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\FASTWrapper_Registry.txt" -I %NWTC_Lib_Loc% %ALL_FAST_INCLUDES% -noextrap -O "%Output_Loc%" -GOTO checkError - -:WakeDynamics -SET CURR_LOC=%WD_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\WakeDynamics_Registry.txt" -I %NWTC_Lib_Loc% -noextrap -O "%Output_Loc%" -GOTO checkError - -:AWAE -SET CURR_LOC=%AWAE_Loc% -SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\AWAE_Registry.txt" -I %NWTC_Lib_Loc% -I %IfW_Loc% -noextrap -O "%Output_Loc%" -GOTO checkError - -:Version -DEL "%Root_Loc%\VersionInfo.obj" "%Root_Loc%\versioninfo.mod" -GOTO end - -:checkError -ECHO. -IF %ERRORLEVEL% NEQ 0 ( -ECHO Error running FAST Registry for %ModuleName%. -) ELSE ( -ECHO Registry for %ModuleName% completed. -REM COPY /Y "%ModuleName%_Types.f90" "%CURR_LOC%" -rem IF /I "%ModuleName%"=="MAP" COPY /Y "%ModuleName%_Types.h" "%CURR_LOC%" -) - -:end -REM ---------------------------------------------------------------------------- -REM ------------------------- CLEAR MEMORY ------------------------------------- -REM ---------------------------------------------------------------------------- -ECHO.  - -SET ModuleName= -SET CURR_LOC= - -SET Root_Loc= - -SET Subs_Loc= -SET FAST_Loc= -SET Registry= - -SET ED_Loc= -SET BD_Loc= -SET AD14_Loc= -SET IfW_Loc= -SET HD_Loc= -SET SD_Loc= -SET MAP_Loc= -SET FEAM_Loc= -SET IceF_Loc= -SET IceD_Loc= -SET MD_Loc= -SET OpFM_Loc= -SET Orca_Loc= -SET NWTC_Lib_Loc= -SET ExtPtfm_Loc= -SET AD_Loc= -SET SrvD_Loc= - -SET MAP_Loc= -SET ALL_FAST_Includes= - -:Done -echo %lines% -set lines= - -:PathsOnly diff --git a/OpenFAST/vs-build/SC_DLL/SC_DLL.sln b/OpenFAST/vs-build/SC_DLL/SC_DLL.sln deleted file mode 100644 index 54daab58e..000000000 --- a/OpenFAST/vs-build/SC_DLL/SC_DLL.sln +++ /dev/null @@ -1,28 +0,0 @@ - -Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio 2013 -VisualStudioVersion = 12.0.40629.0 -MinimumVisualStudioVersion = 10.0.40219.1 -Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SC_DLL", "SC_DLL.vfproj", "{183CC593-AD4C-9643-81C1-7D6085A9A5ED}" -EndProject -Global - GlobalSection(SolutionConfigurationPlatforms) = preSolution - Debug|Win32 = Debug|Win32 - Debug|x64 = Debug|x64 - Release|Win32 = Release|Win32 - Release|x64 = Release|x64 - EndGlobalSection - GlobalSection(ProjectConfigurationPlatforms) = postSolution - {183CC593-AD4C-9643-81C1-7D6085A9A5ED}.Debug|Win32.ActiveCfg = Debug|Win32 - {183CC593-AD4C-9643-81C1-7D6085A9A5ED}.Debug|Win32.Build.0 = Debug|Win32 - {183CC593-AD4C-9643-81C1-7D6085A9A5ED}.Debug|x64.ActiveCfg = Debug|x64 - {183CC593-AD4C-9643-81C1-7D6085A9A5ED}.Debug|x64.Build.0 = Debug|x64 - {183CC593-AD4C-9643-81C1-7D6085A9A5ED}.Release|Win32.ActiveCfg = Release|Win32 - {183CC593-AD4C-9643-81C1-7D6085A9A5ED}.Release|Win32.Build.0 = Release|Win32 - {183CC593-AD4C-9643-81C1-7D6085A9A5ED}.Release|x64.ActiveCfg = Release|x64 - {183CC593-AD4C-9643-81C1-7D6085A9A5ED}.Release|x64.Build.0 = Release|x64 - EndGlobalSection - GlobalSection(SolutionProperties) = preSolution - HideSolutionNode = FALSE - EndGlobalSection -EndGlobal diff --git a/OpenFAST/vs-build/SC_DLL/SC_DLL.vfproj b/OpenFAST/vs-build/SC_DLL/SC_DLL.vfproj deleted file mode 100644 index efc219104..000000000 --- a/OpenFAST/vs-build/SC_DLL/SC_DLL.vfproj +++ /dev/null @@ -1,52 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/OpenFAST/vs-build/SubDyn/SubDyn.sln b/OpenFAST/vs-build/SubDyn/SubDyn.sln deleted file mode 100644 index d497e8bd4..000000000 --- a/OpenFAST/vs-build/SubDyn/SubDyn.sln +++ /dev/null @@ -1,53 +0,0 @@ - -Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio 14 -VisualStudioVersion = 14.0.25420.1 -MinimumVisualStudioVersion = 10.0.40219.1 -Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SubDyn", "SubDyn.vfproj", "{815C302F-A93D-4C22-9329-717B085113C0}" - ProjectSection(ProjectDependencies) = postProject - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} = {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} - EndProjectSection -EndProject -Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "FAST_Registry", "..\Registry\FAST_Registry.vcxproj", "{DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}" -EndProject -Global - GlobalSection(SolutionConfigurationPlatforms) = preSolution - Debug_Double|Win32 = Debug_Double|Win32 - Debug_Double|x64 = Debug_Double|x64 - Debug|Win32 = Debug|Win32 - Debug|x64 = Debug|x64 - Release_Double|Win32 = Release_Double|Win32 - Release_Double|x64 = Release_Double|x64 - Release|Win32 = Release|Win32 - Release|x64 = Release|x64 - EndGlobalSection - GlobalSection(ProjectConfigurationPlatforms) = postSolution - {815C302F-A93D-4C22-9329-717B085113C0}.Debug_Double|Win32.ActiveCfg = Debug_Double|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Debug_Double|Win32.Build.0 = Debug_Double|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 - {815C302F-A93D-4C22-9329-717B085113C0}.Debug_Double|x64.Build.0 = Debug_Double|x64 - {815C302F-A93D-4C22-9329-717B085113C0}.Debug|Win32.ActiveCfg = Debug|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Debug|Win32.Build.0 = Debug|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Debug|x64.ActiveCfg = Debug|x64 - {815C302F-A93D-4C22-9329-717B085113C0}.Debug|x64.Build.0 = Debug|x64 - {815C302F-A93D-4C22-9329-717B085113C0}.Release_Double|Win32.ActiveCfg = Release_Double|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Release_Double|Win32.Build.0 = Release_Double|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Release_Double|x64.ActiveCfg = Release_Double|x64 - {815C302F-A93D-4C22-9329-717B085113C0}.Release_Double|x64.Build.0 = Release_Double|x64 - {815C302F-A93D-4C22-9329-717B085113C0}.Release|Win32.ActiveCfg = Release|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Release|Win32.Build.0 = Release|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Release|x64.ActiveCfg = Release|x64 - {815C302F-A93D-4C22-9329-717B085113C0}.Release|x64.Build.0 = Release|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|x64.Build.0 = Release|Win32 - EndGlobalSection - GlobalSection(SolutionProperties) = preSolution - HideSolutionNode = FALSE - EndGlobalSection -EndGlobal diff --git a/OpenFAST/vs-build/SubDyn/SubDyn.vfproj b/OpenFAST/vs-build/SubDyn/SubDyn.vfproj deleted file mode 100644 index 06c25bbbf..000000000 --- a/OpenFAST/vs-build/SubDyn/SubDyn.vfproj +++ /dev/null @@ -1,186 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/OpenFAST/vs-build/TurbSim/TurbSim.vfproj b/OpenFAST/vs-build/TurbSim/TurbSim.vfproj deleted file mode 100644 index e11bffc34..000000000 --- a/OpenFAST/vs-build/TurbSim/TurbSim.vfproj +++ /dev/null @@ -1,80 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/OpenFAST/vs-build/UnsteadyAero/UnsteadyAero.sln b/OpenFAST/vs-build/UnsteadyAero/UnsteadyAero.sln deleted file mode 100644 index 4daa940c6..000000000 --- a/OpenFAST/vs-build/UnsteadyAero/UnsteadyAero.sln +++ /dev/null @@ -1,64 +0,0 @@ - -Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio 15 -VisualStudioVersion = 15.0.28307.902 -MinimumVisualStudioVersion = 10.0.40219.1 -Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "UnsteadyAero", "UnsteadyAero.vfproj", "{815C302F-A93D-4C22-9329-717B085113C0}" - ProjectSection(ProjectDependencies) = postProject - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} = {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} - EndProjectSection -EndProject -Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "FAST_Registry", "..\Registry\FAST_Registry.vcxproj", "{DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}" -EndProject -Global - GlobalSection(SolutionConfigurationPlatforms) = preSolution - Debug_Double|Win32 = Debug_Double|Win32 - Debug_Double|x64 = Debug_Double|x64 - Debug|Win32 = Debug|Win32 - Debug|x64 = Debug|x64 - Release_Double|Win32 = Release_Double|Win32 - Release_Double|x64 = Release_Double|x64 - Release|Win32 = Release|Win32 - Release|x64 = Release|x64 - EndGlobalSection - GlobalSection(ProjectConfigurationPlatforms) = postSolution - {815C302F-A93D-4C22-9329-717B085113C0}.Debug_Double|Win32.ActiveCfg = Debug_Double|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Debug_Double|Win32.Build.0 = Debug_Double|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 - {815C302F-A93D-4C22-9329-717B085113C0}.Debug_Double|x64.Build.0 = Debug_Double|x64 - {815C302F-A93D-4C22-9329-717B085113C0}.Debug|Win32.ActiveCfg = Debug|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Debug|Win32.Build.0 = Debug|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Debug|x64.ActiveCfg = Debug|x64 - {815C302F-A93D-4C22-9329-717B085113C0}.Debug|x64.Build.0 = Debug|x64 - {815C302F-A93D-4C22-9329-717B085113C0}.Release_Double|Win32.ActiveCfg = Release_Double|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Release_Double|Win32.Build.0 = Release_Double|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Release_Double|x64.ActiveCfg = Release_Double|x64 - {815C302F-A93D-4C22-9329-717B085113C0}.Release_Double|x64.Build.0 = Release_Double|x64 - {815C302F-A93D-4C22-9329-717B085113C0}.Release|Win32.ActiveCfg = Release|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Release|Win32.Build.0 = Release|Win32 - {815C302F-A93D-4C22-9329-717B085113C0}.Release|x64.ActiveCfg = Release|x64 - {815C302F-A93D-4C22-9329-717B085113C0}.Release|x64.Build.0 = Release|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.Build.0 = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|x64.ActiveCfg = Release|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|x64.Build.0 = Release|Win32 - EndGlobalSection - GlobalSection(SolutionProperties) = preSolution - HideSolutionNode = FALSE - EndGlobalSection - GlobalSection(ExtensibilityGlobals) = postSolution - SolutionGuid = {367EADB6-7C90-46F7-B3DD-31AFA0C0D727} - EndGlobalSection -EndGlobal diff --git a/OpenFAST/vs-build/UnsteadyAero/UnsteadyAero.vfproj b/OpenFAST/vs-build/UnsteadyAero/UnsteadyAero.vfproj deleted file mode 100644 index 77735ed5b..000000000 --- a/OpenFAST/vs-build/UnsteadyAero/UnsteadyAero.vfproj +++ /dev/null @@ -1,324 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -